156 lines
6.8 KiB
Racket
156 lines
6.8 KiB
Racket
#lang at-exp racket/base
|
|
(require racket/system
|
|
racket/file
|
|
racket/format
|
|
racket/runtime-path
|
|
ds-store
|
|
ds-store/alias
|
|
compiler/exe-dylib-path
|
|
setup/cross-system)
|
|
|
|
(provide installer-dmg
|
|
make-dmg)
|
|
|
|
(define hdiutil "/usr/bin/hdiutil")
|
|
(define codesign "/usr/bin/codesign")
|
|
|
|
(define-runtime-path bg-image "macosx-installer/racket-rising.png")
|
|
|
|
(define (system*/show . l)
|
|
(displayln (apply ~a #:separator " " l))
|
|
(flush-output)
|
|
(unless (apply system* l)
|
|
(error "failed")))
|
|
|
|
(define (make-dmg volname src-dir dmg bg readme sign-identity)
|
|
(define tmp-dmg (make-temporary-file "~a.dmg"))
|
|
(define work-dir
|
|
(let-values ([(base name dir?) (split-path src-dir)])
|
|
(build-path base "work")))
|
|
(when (file-exists? dmg) (delete-file dmg))
|
|
(delete-directory/files work-dir #:must-exist? #f)
|
|
(make-directory* work-dir)
|
|
(printf "Copying ~a\n" src-dir)
|
|
(define dest-dir (build-path work-dir volname))
|
|
(copy-directory/files src-dir dest-dir
|
|
#:preserve-links? #t
|
|
#:keep-modify-seconds? #t)
|
|
(when readme
|
|
(call-with-output-file*
|
|
(build-path work-dir volname "README.txt")
|
|
#:exists 'truncate
|
|
(lambda (o)
|
|
(display readme o))))
|
|
(when bg
|
|
(copy-file bg (build-path work-dir ".bg.png")))
|
|
(unless (string=? sign-identity "")
|
|
(sign-executables dest-dir sign-identity))
|
|
;; The following command should work fine, but it looks like hdiutil in 10.4
|
|
;; is miscalculating the needed size, making it too big in our case (and too
|
|
;; small with >8GB images). It seems that it works to first generate an
|
|
;; uncompressed image and then convert it to a compressed one.
|
|
;; hdiutil create -format UDZO -imagekey zlib-level=9 -ov \
|
|
;; -mode 555 -volname volname -srcfolder . dmg
|
|
;; So, first create an uncompressed image...
|
|
(parameterize ([current-directory work-dir])
|
|
(system*/show hdiutil
|
|
"create" "-format" "UDRW" "-ov"
|
|
"-mode" "755" "-volname" volname "-srcfolder" "."
|
|
tmp-dmg))
|
|
;; Then do the expected dmg layout...
|
|
(when bg
|
|
(dmg-layout tmp-dmg volname ".bg.png"))
|
|
;; And create the compressed image from the uncompressed image:
|
|
(system*/show hdiutil
|
|
"convert" "-format" "UDBZ" "-imagekey" "zlib-level=9" "-ov"
|
|
tmp-dmg "-o" dmg)
|
|
(delete-file tmp-dmg))
|
|
|
|
(define (sign-executables dest-dir sign-identity)
|
|
;; Sign any executable in "bin", top-level ".app", or either of those in "lib"
|
|
(define (check-bins dir)
|
|
(for ([f (in-list (directory-list dir #:build? #t))])
|
|
(when (and (file-exists? f)
|
|
(member 'execute (file-or-directory-permissions f))
|
|
(member (call-with-input-file
|
|
f
|
|
(lambda (i)
|
|
(define bstr (read-bytes 4 i))
|
|
(and (bytes? bstr)
|
|
(= 4 (bytes-length bstr))
|
|
(integer-bytes->integer bstr #f))))
|
|
'(#xFeedFace #xFeedFacf)))
|
|
(system*/show codesign "-s" sign-identity f))))
|
|
(define (check-apps dir)
|
|
(for ([f (in-list (directory-list dir #:build? #t))])
|
|
(when (and (directory-exists? f)
|
|
(regexp-match #rx#".app$" f))
|
|
(define name (let-values ([(base name dir?) (split-path f)])
|
|
(path-replace-suffix name #"")))
|
|
(define exe (build-path f "Contents" "MacOS" name))
|
|
(when (file-exists? exe)
|
|
;; Move a copy of the `Racket` framework into the ".app":
|
|
(when (regexp-match #rx"^@executable_path/[.][.]/[.][.]/[.][.]/lib/Racket.framework/"
|
|
(find-matching-library-path exe "Racket"))
|
|
(define so (build-path (build-path f "Contents" "MacOS" "Racket")))
|
|
(copy-file (build-path (build-path f 'up "lib" "Racket.framework" "Racket"))
|
|
so)
|
|
(system*/show codesign "-s" sign-identity so)
|
|
;; Update executable to point to the adjacent copy of "Racket"
|
|
(update-matching-library-path exe "Racket" "@executable_path/Racket"))
|
|
;; Sign ".app":
|
|
(system*/show codesign "-s" sign-identity f)))))
|
|
(check-bins (build-path dest-dir "bin"))
|
|
(check-bins (build-path dest-dir "lib"))
|
|
(check-apps dest-dir)
|
|
(check-apps (build-path dest-dir "lib")))
|
|
|
|
(define (dmg-layout dmg volname bg)
|
|
(define-values (mnt del?)
|
|
(let ([preferred (build-path "/Volumes/" volname)])
|
|
(if (not (directory-exists? preferred))
|
|
;; Use the preferred path so that the alias is as
|
|
;; clean as possible:
|
|
(values preferred #f)
|
|
;; fall back to using a temporary directory
|
|
(values (make-temporary-file "~a-mnt" 'directory) #t))))
|
|
(system*/show hdiutil
|
|
"attach" "-readwrite" "-noverify" "-noautoopen"
|
|
"-mountpoint" mnt dmg)
|
|
(define alias (path->alias-bytes (build-path mnt bg)
|
|
#:wrt mnt))
|
|
(make-file-or-directory-link "/Applications" (build-path mnt "Applications"))
|
|
(define (->path s) (string->path s))
|
|
(write-ds-store (build-path mnt ".DS_Store")
|
|
(list
|
|
(ds 'same 'BKGD 'blob
|
|
(bytes-append #"PctB"
|
|
(integer->integer-bytes (bytes-length alias) 4 #t #t)
|
|
(make-bytes 4 0)))
|
|
(ds 'same 'ICVO 'bool #t)
|
|
(ds 'same 'fwi0 'blob
|
|
;; Window location (size overridden below), sideview off:
|
|
(fwind 160 320 540 1000 'icnv #f))
|
|
(ds 'same 'fwsw 'long 135) ; window sideview width?
|
|
(ds 'same 'fwsh 'long 380) ; window sideview height?
|
|
(ds 'same 'icgo 'blob #"\0\0\0\0\0\0\0\4") ; ???
|
|
(ds 'same 'icvo 'blob
|
|
;; folder view options:
|
|
#"icv4\0\200nonebotm\0\0\0\0\0\0\0\0\0\4\0\0")
|
|
(ds 'same 'icvt 'shor 16) ; icon label size
|
|
(ds 'same 'pict 'blob alias)
|
|
(ds (->path ".bg.png") 'Iloc 'blob (iloc 900 180)) ; file is hidden, anway
|
|
(ds (->path "Applications") 'Iloc 'blob (iloc 500 180))
|
|
(ds (->path volname) 'Iloc 'blob (iloc 170 180))))
|
|
(system*/show hdiutil "detach" mnt)
|
|
(when del?
|
|
(delete-directory mnt)))
|
|
|
|
(define (installer-dmg human-name base-name dist-suffix readme sign-identity)
|
|
(define dmg-name (format "bundle/~a-~a~a.dmg"
|
|
base-name
|
|
(cross-system-library-subpath #f)
|
|
dist-suffix))
|
|
(make-dmg human-name "bundle/racket" dmg-name bg-image readme sign-identity)
|
|
dmg-name)
|