installer-dmg.rkt (6940B)
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 compiler/exe-dylib-path 9 setup/cross-system) 10 11 (provide installer-dmg 12 make-dmg) 13 14 (define hdiutil "/usr/bin/hdiutil") 15 (define codesign "/usr/bin/codesign") 16 17 (define-runtime-path bg-image "macosx-installer/racket-rising.png") 18 19 (define (system*/show . l) 20 (displayln (apply ~a #:separator " " l)) 21 (flush-output) 22 (unless (apply system* l) 23 (error "failed"))) 24 25 (define (make-dmg volname src-dir dmg bg readme sign-identity) 26 (define tmp-dmg (make-temporary-file "~a.dmg")) 27 (define work-dir 28 (let-values ([(base name dir?) (split-path src-dir)]) 29 (build-path base "work"))) 30 (when (file-exists? dmg) (delete-file dmg)) 31 (delete-directory/files work-dir #:must-exist? #f) 32 (make-directory* work-dir) 33 (printf "Copying ~a\n" src-dir) 34 (define dest-dir (build-path work-dir volname)) 35 (copy-directory/files src-dir dest-dir 36 #:preserve-links? #t 37 #:keep-modify-seconds? #t) 38 (when readme 39 (call-with-output-file* 40 (build-path work-dir volname "README.txt") 41 #:exists 'truncate 42 (lambda (o) 43 (display readme o)))) 44 (when bg 45 (copy-file bg (build-path work-dir ".bg.png"))) 46 (unless (string=? sign-identity "") 47 (sign-executables dest-dir sign-identity)) 48 ;; The following command should work fine, but it looks like hdiutil in 10.4 49 ;; is miscalculating the needed size, making it too big in our case (and too 50 ;; small with >8GB images). It seems that it works to first generate an 51 ;; uncompressed image and then convert it to a compressed one. 52 ;; hdiutil create -format UDZO -imagekey zlib-level=9 -ov \ 53 ;; -mode 555 -volname volname -srcfolder . dmg 54 ;; So, first create an uncompressed image... 55 (parameterize ([current-directory work-dir]) 56 (system*/show hdiutil 57 "create" "-format" "UDRW" "-ov" 58 "-mode" "755" "-volname" volname "-srcfolder" "." 59 tmp-dmg)) 60 ;; Then do the expected dmg layout... 61 (when bg 62 (dmg-layout tmp-dmg volname ".bg.png")) 63 ;; And create the compressed image from the uncompressed image: 64 (system*/show hdiutil 65 "convert" "-format" "UDBZ" "-imagekey" "zlib-level=9" "-ov" 66 tmp-dmg "-o" dmg) 67 (delete-file tmp-dmg)) 68 69 (define (sign-executables dest-dir sign-identity) 70 ;; Sign any executable in "bin", top-level ".app", or either of those in "lib" 71 (define (check-bins dir) 72 (for ([f (in-list (directory-list dir #:build? #t))]) 73 (when (and (file-exists? f) 74 (member 'execute (file-or-directory-permissions f)) 75 (member (call-with-input-file 76 f 77 (lambda (i) 78 (define bstr (read-bytes 4 i)) 79 (and (bytes? bstr) 80 (= 4 (bytes-length bstr)) 81 (integer-bytes->integer bstr #f)))) 82 '(#xFeedFace #xFeedFacf))) 83 (system*/show codesign "-s" sign-identity f)))) 84 (define (check-apps dir) 85 (for ([f (in-list (directory-list dir #:build? #t))]) 86 (when (and (directory-exists? f) 87 (regexp-match #rx#".app$" f)) 88 (define name (let-values ([(base name dir?) (split-path f)]) 89 (path-replace-suffix name #""))) 90 (define exe (build-path f "Contents" "MacOS" name)) 91 (when (file-exists? exe) 92 ;; Move a copy of the `Racket` framework into the ".app": 93 (when (regexp-match #rx"^@executable_path/[.][.]/[.][.]/[.][.]/lib/Racket.framework/" 94 (find-matching-library-path exe "Racket")) 95 (define so (build-path (build-path f "Contents" "MacOS" "Racket"))) 96 (copy-file (build-path (build-path f 'up "lib" "Racket.framework" "Racket")) 97 so) 98 (system*/show codesign "-s" sign-identity so) 99 ;; Update executable to point to the adjacent copy of "Racket" 100 (update-matching-library-path exe "Racket" "@executable_path/Racket")) 101 ;; Sign ".app": 102 (system*/show codesign "-s" sign-identity f))))) 103 (check-bins (build-path dest-dir "bin")) 104 (check-bins (build-path dest-dir "lib")) 105 (check-apps dest-dir) 106 (check-apps (build-path dest-dir "lib"))) 107 108 (define (dmg-layout dmg volname bg) 109 (define-values (mnt del?) 110 (let ([preferred (build-path "/Volumes/" volname)]) 111 (if (not (directory-exists? preferred)) 112 ;; Use the preferred path so that the alias is as 113 ;; clean as possible: 114 (values preferred #f) 115 ;; fall back to using a temporary directory 116 (values (make-temporary-file "~a-mnt" 'directory) #t)))) 117 (system*/show hdiutil 118 "attach" "-readwrite" "-noverify" "-noautoopen" 119 "-mountpoint" mnt dmg) 120 (define alias (path->alias-bytes (build-path mnt bg) 121 #:wrt mnt)) 122 (make-file-or-directory-link "/Applications" (build-path mnt "Applications")) 123 (define (->path s) (string->path s)) 124 (write-ds-store (build-path mnt ".DS_Store") 125 (list 126 (ds 'same 'BKGD 'blob 127 (bytes-append #"PctB" 128 (integer->integer-bytes (bytes-length alias) 4 #t #t) 129 (make-bytes 4 0))) 130 (ds 'same 'ICVO 'bool #t) 131 (ds 'same 'fwi0 'blob 132 ;; Window location (size overridden below), sideview off: 133 (fwind 160 320 540 1000 'icnv #f)) 134 (ds 'same 'fwsw 'long 135) ; window sideview width? 135 (ds 'same 'fwsh 'long 380) ; window sideview height? 136 (ds 'same 'icgo 'blob #"\0\0\0\0\0\0\0\4") ; ??? 137 (ds 'same 'icvo 'blob 138 ;; folder view options: 139 #"icv4\0\200nonebotm\0\0\0\0\0\0\0\0\0\4\0\0") 140 (ds 'same 'icvt 'shor 16) ; icon label size 141 (ds 'same 'pict 'blob alias) 142 (ds (->path ".bg.png") 'Iloc 'blob (iloc 900 180)) ; file is hidden, anway 143 (ds (->path "Applications") 'Iloc 'blob (iloc 500 180)) 144 (ds (->path volname) 'Iloc 'blob (iloc 170 180)))) 145 (system*/show hdiutil "detach" mnt) 146 (when del? 147 (delete-directory mnt))) 148 149 (define (installer-dmg human-name base-name dist-suffix readme sign-identity) 150 (define dmg-name (format "bundle/~a-~a~a.dmg" 151 base-name 152 (cross-system-library-subpath #f) 153 dist-suffix)) 154 (make-dmg human-name "bundle/racket" dmg-name bg-image readme sign-identity) 155 dmg-name)