basis/bootstrap/image/upload/upload.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! Copyright (C) 2015 Doug Coleman.
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 USING: bootstrap.image checksums checksums.openssl fry io
   5 io.directories io.encodings.ascii io.encodings.utf8 io.files
   6 io.files.temp io.files.unique io.launcher io.pathnames kernel
   7 make math.parser namespaces sequences splitting system ;
   8 IN: bootstrap.image.upload
   9
  10 SYMBOL: upload-images-destination
  11 SYMBOL: build-images-destination
  12
  13 : latest-destination ( -- dest )
  14     upload-images-destination get
  15     "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/latest/"
  16     or ;
  17
  18 : build-destination ( -- dest )
  19     build-images-destination get
  20     "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/build/"
  21     or ;
  22
  23 : checksums-path ( -- temp ) "checksums.txt" temp-file ;
  24
  25 : boot-image-names ( -- seq )
  26     image-names [ boot-image-name ] map ;
  27
  28 : compute-checksums ( -- )
  29     checksums-path ascii [
  30         boot-image-names [
  31             [ write bl ]
  32             [ openssl-md5 checksum-file hex-string print ]
  33             bi
  34         ] each
  35     ] with-file-writer ;
  36
  37 ! Windows scp doesn't like pathnames with colons, it treats them as hostnames.
  38 ! Workaround for uploading checksums.txt created with temp-file.
  39 ! e.g. C:\Users\\Doug\\AppData\\Local\\Temp/factorcode.org\\Factor/checksums.txt
  40 ! ssh: Could not resolve hostname c: no address associated with name
  41
  42 HOOK: scp-name os ( -- path )
  43 M: object scp-name "scp" ;
  44 M: windows scp-name "pscp" ;
  45
  46 : upload-images ( -- )
  47     [
  48         \ scp-name get-global scp-name or ,
  49         boot-image-names %
  50         checksums-path , latest-destination ,
  51     ] { } make try-process ;
  52
  53 : append-build ( path -- path' )
  54     vm-git-label "-" split1-last nip "." glue ;
  55
  56 : checksum-lines-append-build ( -- )
  57     "checksums.txt" utf8 [
  58         [ " " split1 [ append-build ] dip " " glue ] map
  59     ] change-file-lines ;
  60
  61 : with-build-images ( quot -- )
  62     '[
  63         ! Copy boot images
  64         boot-image-names current-temporary-directory get copy-files-into
  65         ! Copy checksums
  66         checksums-path current-temporary-directory get copy-file-into
  67         current-temporary-directory get [
  68             ! Rewrite checksum lines with build number
  69             checksum-lines-append-build
  70             ! Rename file to file.build-number
  71             current-directory get directory-files [ dup append-build move-file ] each
  72             ! Run the quot in the current-directory, which is the unique directory
  73             @
  74         ] with-directory
  75     ] cleanup-unique-directory ; inline
  76
  77 : upload-build-images ( -- )
  78     [
  79         [
  80             \ scp-name get-global scp-name or ,
  81             current-directory get directory-files %
  82             build-destination ,
  83         ] { } make try-process
  84     ] with-build-images ;
  85
  86 : upload-new-images ( -- )
  87     [
  88         make-images
  89         "Computing checksums..." print flush
  90         compute-checksums
  91         "Uploading images..." print flush
  92         upload-images
  93         "Uploading build images..." print flush
  94         upload-build-images
  95     ] with-resource-directory ;
  96
  97 MAIN: upload-new-images