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 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 unicode ;
   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     "sheeple@downloads.factorcode.org:downloads.factorcode.org/images/master/"
  16     or ;
  17
  18 : build-destination ( -- dest )
  19     build-images-destination get
  20     "sheeple@downloads.factorcode.org:downloads.factorcode.org/images/build/"
  21     or ;
  22
  23 : factor-git-branch ( -- name )
  24     image-path parent-directory [
  25         { "git" "rev-parse" "--abbrev-ref" "HEAD" }
  26         utf8 <process-reader> stream-contents
  27         [ blank? ] trim-tail
  28     ] with-directory ;
  29
  30 : git-branch-destination ( -- dest )
  31     build-images-destination get
  32     "sheeple@downloads.factorcode.org:downloads.factorcode.org/images/"
  33     or
  34     factor-git-branch "/" 3append ;
  35
  36 : checksums-path ( -- temp ) "checksums.txt" temp-file ;
  37
  38 : boot-image-names ( -- seq )
  39     image-names [ boot-image-name ] map ;
  40
  41 : compute-checksums ( -- )
  42     checksums-path ascii [
  43         boot-image-names [
  44             [ write bl ]
  45             [ openssl-md5 checksum-file bytes>hex-string print ]
  46             bi
  47         ] each
  48     ] with-file-writer ;
  49
  50 : scp-name ( -- path ) "scp" ;
  51
  52 : upload-images ( -- )
  53     [
  54         \ scp-name get-global scp-name or ,
  55         boot-image-names %
  56         checksums-path ,
  57         git-branch-destination [ print flush ] [ , ] bi
  58     ] { } make try-process ;
  59
  60 : append-build ( path -- path' )
  61     vm-git-id "." glue ;
  62
  63 : checksum-lines-append-build ( -- )
  64     "checksums.txt" utf8 [
  65         [ " " split1 [ append-build ] dip " " glue ] map
  66     ] change-file-lines ;
  67
  68 : with-build-images ( quot -- )
  69     [ boot-image-names [ absolute-path ] map ] dip
  70     '[
  71         [
  72             ! Copy boot images
  73             _ "." copy-files-into
  74             ! Copy checksums
  75             checksums-path "." copy-file-into
  76             ! Rewrite checksum lines with build number
  77             checksum-lines-append-build
  78             ! Rename file to file.build-number
  79             "." directory-files [ dup append-build move-file ] each
  80             ! Run the quot in the unique directory
  81             @
  82         ] cleanup-unique-directory
  83     ] with-temp-directory ; inline
  84
  85 : upload-build-images ( -- )
  86     [
  87         [
  88             \ scp-name get-global scp-name or ,
  89             "." directory-files %
  90             build-destination ,
  91         ] { } make try-process
  92     ] with-build-images ;
  93
  94 : create-remote-upload-directory ( -- )
  95     '[
  96         "ssh" ,
  97         "sheeple@downloads.factorcode.org" ,
  98         "mkdir -p downloads.factorcode.org/images/" factor-git-branch append ,
  99     ] { } make try-process ;
 100
 101 : upload-new-images ( -- )
 102     [
 103         make-images
 104         "Computing checksums..." print flush
 105         compute-checksums
 106         "Creating remote directory..." print flush
 107         create-remote-upload-directory
 108         "Uploading images..." print flush
 109         upload-images
 110         "Uploading build images..." print flush
 111         upload-build-images
 112     ] with-resource-directory ;
 113
 114 MAIN: upload-new-images