159 lines
7.0 KiB
Racket
159 lines
7.0 KiB
Racket
#lang at-exp racket/base
|
|
(require racket/system
|
|
racket/file
|
|
racket/format
|
|
racket/runtime-path
|
|
ds-store
|
|
ds-store/alias
|
|
xml
|
|
setup/cross-system)
|
|
|
|
(provide installer-pkg)
|
|
|
|
(define pkgbuild "/usr/bin/pkgbuild")
|
|
(define productbuild "/usr/bin/productbuild")
|
|
|
|
(define-runtime-path bg-image "macosx-installer/pkg-bg.png")
|
|
|
|
(define (system*/show . l)
|
|
(displayln (apply ~a #:separator " " l))
|
|
(flush-output)
|
|
(unless (apply system* l)
|
|
(error "failed")))
|
|
|
|
(define (gen-install-script install-dest)
|
|
(~a "#!/bin/sh\n"
|
|
"echo \"" (regexp-replace* #rx"[\"$]"
|
|
install-dest
|
|
"\"'\\0'\"")
|
|
"\"/bin > /etc/paths.d/racket\n"))
|
|
|
|
(define (make-pkg human-name src-dir pkg-name readme sign-identity)
|
|
(define install-dest (string-append "/Applications/" human-name))
|
|
(define id (string-append "org.racket-lang."
|
|
(regexp-replace* #rx" "
|
|
human-name
|
|
"-")))
|
|
|
|
(define (make-rel dir-name)
|
|
(let-values ([(base name dir?) (split-path src-dir)])
|
|
(build-path base dir-name)))
|
|
|
|
(define work-dir (make-rel "work"))
|
|
(delete-directory/files work-dir #:must-exist? #f)
|
|
(define scripts-dir (make-rel "scripts"))
|
|
(delete-directory/files scripts-dir #:must-exist? #f)
|
|
(define resources-dir (make-rel "resources"))
|
|
(delete-directory/files resources-dir #:must-exist? #f)
|
|
|
|
(printf "Creating ~a\n" scripts-dir)
|
|
(make-directory* scripts-dir)
|
|
(define postinstall (build-path scripts-dir "postinstall"))
|
|
(call-with-output-file*
|
|
postinstall
|
|
(lambda (o)
|
|
(write-string (gen-install-script install-dest) o)))
|
|
(file-or-directory-permissions postinstall #o770)
|
|
|
|
(printf "Creating ~a\n" resources-dir)
|
|
(make-directory* resources-dir)
|
|
(copy-file bg-image (build-path resources-dir "background.png"))
|
|
|
|
(printf "Copying ~a\n" src-dir)
|
|
(define dest-dir work-dir)
|
|
(copy-directory/files src-dir dest-dir
|
|
#:keep-modify-seconds? #t)
|
|
(when readme
|
|
(call-with-output-file*
|
|
(build-path dest-dir "README.txt")
|
|
#:exists 'truncate
|
|
(lambda (o)
|
|
(display readme o))))
|
|
(copy-file (build-path dest-dir "README.txt")
|
|
(build-path resources-dir "README.txt"))
|
|
|
|
(system*/show pkgbuild
|
|
"--root" dest-dir
|
|
"--install-location" install-dest
|
|
"--scripts" scripts-dir
|
|
"--identifier" id
|
|
"--version" (version)
|
|
(make-rel "racket.pkg"))
|
|
(define pkg-xml (make-rel "racket.xml"))
|
|
(system*/show productbuild
|
|
"--synthesize"
|
|
"--package" (make-rel "racket.pkg")
|
|
pkg-xml)
|
|
(define synthesized (call-with-input-file*
|
|
pkg-xml
|
|
read-xml))
|
|
(define updated
|
|
(struct-copy document synthesized
|
|
[element (let ([e (document-element synthesized)])
|
|
(struct-copy element e
|
|
[content
|
|
(list*
|
|
(element #f #f
|
|
'title
|
|
null
|
|
(list (pcdata #f #f human-name)))
|
|
(element #f #f
|
|
'readme
|
|
(list (attribute #f #f 'file "README.txt"))
|
|
null)
|
|
(element #f #f
|
|
'background
|
|
(list (attribute #f #f 'file "background.png")
|
|
(attribute #f #f 'alignment "topleft")
|
|
(attribute #f #f 'scaling "none"))
|
|
null)
|
|
(element #f #f
|
|
'installation-check
|
|
(list (attribute #f #f 'script "check_exists_already()"))
|
|
null)
|
|
(element #f #f
|
|
'script
|
|
null
|
|
(list
|
|
(cdata #f #f
|
|
@~a{
|
|
function check_exists_already () {
|
|
if (system.files.fileExistsAtPath(@|(~s install-dest)|)) {
|
|
my.result.type = "Fatal";
|
|
my.result.title = "Folder Exists Already";
|
|
my.result.message = ("Cannot install because a "
|
|
+ @|(~s (~s human-name))|
|
|
+ " folder"
|
|
+ " already exists in the Applications folder."
|
|
+ " Please remove it and try again.");
|
|
return false;
|
|
}
|
|
return true;
|
|
}})))
|
|
(element-content e))]))]))
|
|
(call-with-output-file*
|
|
pkg-xml
|
|
#:exists 'truncate
|
|
(lambda (o)
|
|
(write-xml updated o)))
|
|
(apply system*/show
|
|
productbuild
|
|
(append
|
|
(list "--distribution" pkg-xml
|
|
"--package-path" (make-rel 'same)
|
|
"--resources" resources-dir
|
|
"--identifier" id
|
|
"--version" (version))
|
|
(if (string=? sign-identity "")
|
|
null
|
|
(list "--sign" sign-identity))
|
|
(list pkg-name))))
|
|
|
|
(define (installer-pkg human-name base-name dist-suffix readme sign-identity)
|
|
(define pkg-name (format "bundle/~a-~a~a.pkg"
|
|
base-name
|
|
(cross-system-library-subpath #f)
|
|
dist-suffix))
|
|
(make-pkg human-name "bundle/racket" pkg-name readme sign-identity)
|
|
pkg-name)
|