suzanne.soy/distro-build
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Mac OS X installers: use "ds-store" package instead of scripting Finder

Browse Source 
The Mac OS X "installers" are just ".dmg" files with a particular
layout and background image, which are record in a ".DS_Store" file
in the disk image. We have been generating a ".DS_Store" file through
an AppleScript program and Finder, but that script has been fragile,
and the result depends on the version of Mac OS used to generate
the image (e.g., an imagine generated on 10.7 does not look right
on 10.5).

A new `ds-store' library can write ".DS_Store" files directly,
and it uses a format that is compatible with old Mac OS X versions.

original commit: b3390a7e2a89a1c54abc20d61571435bf7f9cf7b
This commit is contained in:
Matthew Flatt 2013-07-15 19:15:13 -06:00
parent c7c68fb5e7
commit ae4a03038e
2 changed files with 44 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/distro-build/info.rkt
View File

@ -5,4 +5,5 @@
(define deps '("base"
"at-exp-lib"
"web-server-lib"
"scribble-lib"))
"scribble-lib"
"ds-store-lib"))

104
pkgs/distro-build/installer-dmg.rkt
View File

@ -2,9 +2,12 @@
(require racket/system
racket/file
racket/format
racket/runtime-path)
racket/runtime-path
ds-store
ds-store/alias)
(provide installer-dmg)
(provide installer-dmg
make-dmg)
(define hdiutil "/usr/bin/hdiutil")
@ -27,7 +30,7 @@
(copy-directory/files src-dir (build-path work-dir volname)
#:keep-modify-seconds? #t)
(when bg
(copy-file bg (build-path work-dir "bg.png")))
(copy-file bg (build-path work-dir ".bg.png")))
;; 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
@ -42,7 +45,7 @@
tmp-dmg))
;; Then do the expected dmg layout...
(when bg
(dmg-layout tmp-dmg volname "bg.png"))
(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"
@ -50,68 +53,45 @@
(delete-file tmp-dmg))
(define (dmg-layout dmg volname bg)
(define mnt (make-temporary-file "~a-mnt" 'directory))
(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 mnt-name (let-values ([(base name dir?) (split-path mnt)]) (path->string name)))
;; See also https://github.com/andreyvit/yoursway-create-dmg
;; First, give Finder a chance to see the new disk:
(define script
@~a{
tell application "Finder"
-- look for a single disk with the mount point as its name
-- (maybe this works only on newer osx versions?)
set theDMGDisk to ""
repeat while theDMGDisk = ""
set myDisks to every disk
repeat with d in myDisks
if name of d = "@mnt-name"
if theDMGDisk = ""
set theDMGDisk to d
else
error "Too many attached DMGs found!"
end if
end if
end repeat
-- not found? maybe Finder wasn't ready
if theDMGDisk = "" then delay 1
end repeat
if theDMGDisk = "" then error "Attached DMG not found!"
-- found a single matching disk, continue
tell theDMGDisk
open
set current view of container window to icon view
set toolbar visible of container window to false
set statusbar visible of container window to false
set bounds of container window to {320, 160, 1000, 540}
set theViewOptions to the icon view options of container window
set arrangement of theViewOptions to not arranged
set icon size of theViewOptions to 128
set text size of theViewOptions to 16
set background picture of theViewOptions to file "@bg"
make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"}
set position of item "@volname" of container window to {170, 180}
set position of item "@bg" of container window to {900, 180}
set position of item "Applications" of container window to {500, 180}
set name of file "@bg" to ".@bg"
close
open
update without registering applications
delay 5
close
end tell
end tell
})
(printf "~a\n" script)
(parameterize ([current-input-port (open-input-string script)])
(system* "/usr/bin/osascript"))
(system*/show "/bin/sync")
(system*/show "/bin/sync")
(system*/show "/bin/sync")
(system*/show "/bin/sync")
(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)
(delete-directory mnt))
(when del?
(delete-directory mnt)))
(define (installer-dmg human-name base-name dist-suffix)
(define dmg-name (format "bundle/~a-~a~a.dmg"