95 lines
2.9 KiB
Racket
95 lines
2.9 KiB
Racket
|
|
(module bundle-dist racket/base
|
|
(require racket/file
|
|
(only-in racket/base lambda)
|
|
racket/path
|
|
racket/system
|
|
file/zip
|
|
file/tar)
|
|
|
|
(provide bundle-put-file-extension+style+filters
|
|
bundle-directory)
|
|
|
|
(define (bundle-file-suffix)
|
|
(case (system-type)
|
|
[(macosx) "dmg"]
|
|
[(windows) "zip"]
|
|
[(unix) "tgz"]))
|
|
|
|
(define (bundle-put-file-extension+style+filters)
|
|
(values (bundle-file-suffix)
|
|
null
|
|
(case (system-type)
|
|
[(windows) '(("Zip file" "*.zip"))]
|
|
[(macosx) '(("Disk image" "*.dmg"))]
|
|
[(unix) '(("Gzipped tar file" "*.tgz"))])))
|
|
|
|
(define (add-suffix name suffix)
|
|
(if (filename-extension name)
|
|
name
|
|
(path-replace-suffix name
|
|
(string->bytes/utf-8 (string-append "." suffix)))))
|
|
|
|
(define (with-prepared-directory dir for-exe? k)
|
|
;; If `dir' contains multiple files, create a new
|
|
;; directory that contains a copy of `dir'
|
|
(if (and for-exe?
|
|
(= 1 (length (directory-list dir))))
|
|
(k dir)
|
|
(let ([temp-dir (make-temporary-file "bundle-tmp-~a" 'directory)])
|
|
(dynamic-wind
|
|
void
|
|
(lambda ()
|
|
(let ([dest
|
|
(let-values ([(base name dir?) (split-path dir)])
|
|
(build-path temp-dir name))])
|
|
(make-directory dest)
|
|
(let loop ([src dir][dest dest])
|
|
(for-each (lambda (f)
|
|
(let ([src (build-path src f)]
|
|
[dest (build-path dest f)])
|
|
(cond
|
|
[(directory-exists? src)
|
|
(make-directory dest)
|
|
(loop src dest)]
|
|
[(file-exists? src)
|
|
(copy-file src dest)
|
|
(file-or-directory-modify-seconds
|
|
dest
|
|
(file-or-directory-modify-seconds src))])))
|
|
(directory-list src))))
|
|
(k temp-dir))
|
|
(lambda () (delete-directory/files temp-dir))))))
|
|
|
|
(define bundle-directory
|
|
(lambda (target dir [for-exe? #f])
|
|
(let ([target (add-suffix target (bundle-file-suffix))])
|
|
(case (system-type)
|
|
[(macosx)
|
|
(with-prepared-directory
|
|
dir for-exe?
|
|
(lambda (dir)
|
|
(let* ([cout (open-output-bytes)]
|
|
[cerr (open-output-bytes)]
|
|
[cin (open-input-bytes #"")]
|
|
[p (process*/ports
|
|
cout cin cerr
|
|
"/usr/bin/hdiutil"
|
|
"create" "-format" "UDZO"
|
|
"-imagekey" "zlib-level=9"
|
|
"-mode" "555"
|
|
"-volname" (path->string
|
|
(path-replace-suffix (file-name-from-path target) #""))
|
|
"-srcfolder" (path->string (cleanse-path (path->complete-path dir)))
|
|
(path->string (cleanse-path (path->complete-path target))))])
|
|
((list-ref p 4) 'wait)
|
|
(unless (eq? ((list-ref p 4) 'status) 'done-ok)
|
|
(error 'bundle-directory
|
|
"error bundling: ~a"
|
|
(regexp-replace #rx"[\r\n]*$" (get-output-string cerr) ""))))))]
|
|
[(windows unix)
|
|
(let-values ([(base name dir?) (split-path (path->complete-path dir))])
|
|
(parameterize ([current-directory base])
|
|
((if (eq? 'unix (system-type)) tar-gzip zip) target name)))]
|
|
[else (error 'bundle-directory "don't know how")])))))
|