93 lines
4.7 KiB
Scheme
93 lines
4.7 KiB
Scheme
(module plt-single-installer mzscheme
|
|
(require (lib "unitsig.ss")
|
|
(lib "etc.ss")
|
|
|
|
;; All the rest are to get the imports for setup@:
|
|
"option-sig.ss"
|
|
"setup-unit.ss"
|
|
"option-unit.ss"
|
|
(lib "launcher-sig.ss" "launcher")
|
|
(lib "launcher-unit.ss" "launcher")
|
|
(lib "dynext-sig.ss" "dynext")
|
|
(lib "dynext-unit.ss" "dynext")
|
|
(lib "sig.ss" "compiler")
|
|
(lib "option-unit.ss" "compiler")
|
|
(lib "compiler-unit.ss" "compiler"))
|
|
|
|
(provide run-single-installer install-planet-package clean-planet-package)
|
|
|
|
;; run-single-installer : string (-> string) -> void
|
|
;; runs the instealler on the given package
|
|
(define (run-single-installer file get-target-dir)
|
|
(run-single-installer/internal file get-target-dir #f #f))
|
|
|
|
;; install-planet-package : path path (list string string (listof string) nat nat) -> void
|
|
;; unpacks and installs the given planet package into the given path
|
|
(define (install-planet-package file directory spec)
|
|
(run-single-installer/internal file (lambda () directory) (cons directory spec) #f))
|
|
|
|
;; clean-planet-package : path (list string string (listof string) nat nat) -> void
|
|
;; cleans the given planet package
|
|
(define (clean-planet-package directory spec)
|
|
(run-single-installer/internal #f (lambda () directory) (cons directory spec) #t))
|
|
|
|
;; run-single-installer : string (-> string) (list path string string nat nat) -> void
|
|
;; creates a separate thread, runs the installer in that thread,
|
|
;; returns when the thread completes
|
|
(define (run-single-installer/internal file get-target-dir planet-spec clean?)
|
|
(let ([cust (make-custodian)])
|
|
(parameterize ([current-custodian cust]
|
|
[current-namespace (make-namespace)]
|
|
[exit-handler (lambda (v) (custodian-shutdown-all cust))])
|
|
(let ([thd
|
|
(thread
|
|
(lambda ()
|
|
(invoke-unit/sig
|
|
(compound-unit/sig
|
|
(import)
|
|
(link [launcher : launcher^ (launcher@ dcompile dlink)]
|
|
[dcompile : dynext:compile^ (dynext:compile@)]
|
|
[dlink : dynext:link^ (dynext:link@)]
|
|
[dfile : dynext:file^ (dynext:file@)]
|
|
[option : compiler:option^ (compiler:option@)]
|
|
[compiler : compiler^ (compiler@
|
|
option
|
|
dcompile
|
|
dlink
|
|
dfile)]
|
|
[soption : setup-option^ (setup:option@)]
|
|
[set-options : () ((unit/sig ()
|
|
(import setup-option^ compiler^)
|
|
;; >>>>>>>>>>>>>> <<<<<<<<<<<<<<<
|
|
;; Here's where we tell setup the archive file!
|
|
(unless clean?
|
|
(archives (list file)))
|
|
|
|
;; Here's where we make get a directory:
|
|
(current-target-directory-getter
|
|
get-target-dir)
|
|
|
|
(when planet-spec
|
|
(specific-planet-dirs (list planet-spec)))
|
|
|
|
(when clean?
|
|
(clean #t)
|
|
(make-zo #f)
|
|
(make-so #f)
|
|
(make-launchers #f)
|
|
(make-info-domain #t)
|
|
(call-install #f))
|
|
|
|
|
|
)
|
|
soption
|
|
compiler)]
|
|
[setup : () (setup@
|
|
soption
|
|
compiler
|
|
option
|
|
launcher)])
|
|
(export)))))])
|
|
(thread-wait thd)
|
|
(custodian-shutdown-all cust))))))
|