installer-pkg.rkt (7147B)
1 #lang at-exp racket/base 2 (require racket/system 3 racket/file 4 racket/format 5 racket/runtime-path 6 ds-store 7 ds-store/alias 8 xml 9 setup/cross-system) 10 11 (provide installer-pkg) 12 13 (define pkgbuild "/usr/bin/pkgbuild") 14 (define productbuild "/usr/bin/productbuild") 15 16 (define-runtime-path bg-image "macosx-installer/pkg-bg.png") 17 18 (define (system*/show . l) 19 (displayln (apply ~a #:separator " " l)) 20 (flush-output) 21 (unless (apply system* l) 22 (error "failed"))) 23 24 (define (gen-install-script install-dest) 25 (~a "#!/bin/sh\n" 26 "echo \"" (regexp-replace* #rx"[\"$]" 27 install-dest 28 "\"'\\0'\"") 29 "\"/bin > /etc/paths.d/racket\n")) 30 31 (define (make-pkg human-name src-dir pkg-name readme sign-identity) 32 (define install-dest (string-append "/Applications/" human-name)) 33 (define id (string-append "org.racket-lang." 34 (regexp-replace* #rx" " 35 human-name 36 "-"))) 37 38 (define (make-rel dir-name) 39 (let-values ([(base name dir?) (split-path src-dir)]) 40 (build-path base dir-name))) 41 42 (define work-dir (make-rel "work")) 43 (delete-directory/files work-dir #:must-exist? #f) 44 (define scripts-dir (make-rel "scripts")) 45 (delete-directory/files scripts-dir #:must-exist? #f) 46 (define resources-dir (make-rel "resources")) 47 (delete-directory/files resources-dir #:must-exist? #f) 48 49 (printf "Creating ~a\n" scripts-dir) 50 (make-directory* scripts-dir) 51 (define postinstall (build-path scripts-dir "postinstall")) 52 (call-with-output-file* 53 postinstall 54 (lambda (o) 55 (write-string (gen-install-script install-dest) o))) 56 (file-or-directory-permissions postinstall #o770) 57 58 (printf "Creating ~a\n" resources-dir) 59 (make-directory* resources-dir) 60 (copy-file bg-image (build-path resources-dir "background.png")) 61 62 (printf "Copying ~a\n" src-dir) 63 (define dest-dir work-dir) 64 (copy-directory/files src-dir dest-dir 65 #:keep-modify-seconds? #t) 66 (when readme 67 (call-with-output-file* 68 (build-path dest-dir "README.txt") 69 #:exists 'truncate 70 (lambda (o) 71 (display readme o)))) 72 (copy-file (build-path dest-dir "README.txt") 73 (build-path resources-dir "README.txt")) 74 75 (system*/show pkgbuild 76 "--root" dest-dir 77 "--install-location" install-dest 78 "--scripts" scripts-dir 79 "--identifier" id 80 "--version" (version) 81 (make-rel "racket.pkg")) 82 (define pkg-xml (make-rel "racket.xml")) 83 (system*/show productbuild 84 "--synthesize" 85 "--package" (make-rel "racket.pkg") 86 pkg-xml) 87 (define synthesized (call-with-input-file* 88 pkg-xml 89 read-xml)) 90 (define updated 91 (struct-copy document synthesized 92 [element (let ([e (document-element synthesized)]) 93 (struct-copy element e 94 [content 95 (list* 96 (element #f #f 97 'title 98 null 99 (list (pcdata #f #f human-name))) 100 (element #f #f 101 'readme 102 (list (attribute #f #f 'file "README.txt")) 103 null) 104 (element #f #f 105 'background 106 (list (attribute #f #f 'file "background.png") 107 (attribute #f #f 'alignment "topleft") 108 (attribute #f #f 'scaling "none")) 109 null) 110 (element #f #f 111 'installation-check 112 (list (attribute #f #f 'script "check_exists_already()")) 113 null) 114 (element #f #f 115 'script 116 null 117 (list 118 (cdata #f #f 119 @~a{ 120 function check_exists_already () { 121 if (system.files.fileExistsAtPath(@|(~s install-dest)|)) { 122 my.result.type = "Fatal"; 123 my.result.title = "Folder Exists Already"; 124 my.result.message = ("Cannot install because a " 125 + @|(~s (~s human-name))| 126 + " folder" 127 + " already exists in the Applications folder." 128 + " Please remove it and try again."); 129 return false; 130 } 131 return true; 132 }}))) 133 (element-content e))]))])) 134 (call-with-output-file* 135 pkg-xml 136 #:exists 'truncate 137 (lambda (o) 138 (write-xml updated o))) 139 (apply system*/show 140 productbuild 141 (append 142 (list "--distribution" pkg-xml 143 "--package-path" (make-rel 'same) 144 "--resources" resources-dir 145 "--identifier" id 146 "--version" (version)) 147 (if (string=? sign-identity "") 148 null 149 (list "--sign" sign-identity)) 150 (list pkg-name)))) 151 152 (define (installer-pkg human-name base-name dist-suffix readme sign-identity) 153 (define pkg-name (format "bundle/~a-~a~a.pkg" 154 base-name 155 (cross-system-library-subpath #f) 156 dist-suffix)) 157 (make-pkg human-name "bundle/racket" pkg-name readme sign-identity) 158 pkg-name)