installer.rkt (4339B)
1 #lang racket/base 2 (require racket/cmdline 3 "installer-sh.rkt" 4 "installer-dmg.rkt" 5 "installer-pkg.rkt" 6 "installer-exe.rkt" 7 "installer-tgz.rkt" 8 net/url 9 racket/file 10 racket/path 11 racket/port 12 net/base64 13 setup/cross-system 14 "display-time.rkt") 15 16 (module test racket/base) 17 18 (define release? #f) 19 (define source? #f) 20 (define versionless? #f) 21 (define tgz? #f) 22 (define mac-pkg? #f) 23 (define upload-to #f) 24 (define upload-desc "") 25 (define download-readme #f) 26 27 (define-values (short-human-name human-name base-name dir-name dist-suffix 28 sign-identity osslsigncode-args-base64) 29 (command-line 30 #:once-each 31 [("--release") "Create a release installer" 32 (set! release? #t)] 33 [("--source") "Create a source installer" 34 (set! source? #t)] 35 [("--versionless") "Avoid version number in names and paths" 36 (set! versionless? #t)] 37 [("--tgz") "Create a \".tgz\" archive instead of an installer" 38 (set! tgz? #t)] 39 [("--mac-pkg") "Create a \".pkg\" installer on Mac OS X" 40 (set! mac-pkg? #t)] 41 [("--upload") url "Upload installer" 42 (unless (string=? url "") 43 (set! upload-to url))] 44 [("--desc") desc "Description to accompany upload" 45 (set! upload-desc desc)] 46 [("--readme") readme "URL for README.txt to include" 47 (unless (string=? readme "") 48 (set! download-readme readme))] 49 #:args 50 (human-name base-name dir-name dist-suffix sign-identity osslsigncode-args-base64) 51 (values human-name 52 (format "~a v~a" human-name (version)) 53 (if versionless? 54 base-name 55 (format "~a-~a" base-name (version))) 56 (if (or (and release? (not source?)) 57 versionless?) 58 dir-name 59 (format "~a-~a" dir-name (version))) 60 (if (string=? dist-suffix "") 61 "" 62 (string-append "-" dist-suffix)) 63 sign-identity osslsigncode-args-base64))) 64 65 (display-time) 66 67 (define readme 68 (and download-readme 69 (let () 70 (printf "Downloading ~a\n" download-readme) 71 (define i (get-pure-port (string->url download-readme))) 72 (begin0 73 (port->string i) 74 (close-input-port i))))) 75 76 (define (unpack-base64-arguments str) 77 (define p (open-input-bytes (base64-decode (string->bytes/utf-8 str)))) 78 (define l (read p)) 79 (unless (and (list? l) 80 (andmap string? l) 81 (eof-object? (read p))) 82 (error 'unpack-base64-arguments 83 "encoded arguments didn't decode and `read` as a list of strings: ~e" str)) 84 l) 85 86 (define installer-file 87 (if (or source? tgz?) 88 (installer-tgz source? base-name dir-name dist-suffix readme) 89 (case (cross-system-type) 90 [(unix) 91 (installer-sh human-name base-name dir-name release? dist-suffix readme)] 92 [(macosx) 93 (if mac-pkg? 94 (installer-pkg (if (or release? versionless?) 95 short-human-name 96 human-name) 97 base-name dist-suffix readme sign-identity) 98 (installer-dmg (if versionless? 99 short-human-name 100 human-name) 101 base-name dist-suffix readme sign-identity))] 102 [(windows) 103 (define osslsigncode-args 104 (and (not (equal? osslsigncode-args-base64 "")) 105 (unpack-base64-arguments osslsigncode-args-base64))) 106 (installer-exe short-human-name base-name (or release? versionless?) 107 dist-suffix readme 108 osslsigncode-args)]))) 109 110 (call-with-output-file* 111 (build-path "bundle" "installer.txt") 112 #:exists 'truncate/replace 113 (lambda (o) 114 (fprintf o "~a\n" installer-file) 115 (fprintf o "~a\n" upload-desc))) 116 117 (when upload-to 118 (printf "Upload ~a to ~a\n" installer-file upload-to) 119 (define i 120 (put-pure-port 121 (string->url (format "~a~a" 122 upload-to 123 (path->string (file-name-from-path installer-file)))) 124 (file->bytes installer-file) 125 (list (string-append "Description: " upload-desc)))) 126 (unless (equal? (read i) #t) 127 (error "file upload failed"))) 128 129 (display-time)