add support for tethering to a config or addon dir

Add a hook to `raco setup` to make copies of installed executables,
where the copies start with the configuration or addon directory
of creation time, instead of the default installation or user-specific
path.

Although the same effect can be achived by setting environment
variables such as PLTADDONDIR, tethered executables can be easier
to work with and compose better with other programs.

See also #1206 for some discussion, although this change does
not exactly address the original idea there.
This commit is contained in:
Matthew Flatt 2016-04-12 17:14:06 -06:00
parent 91d6c69565
commit 6369e56709
17 changed files with 511 additions and 169 deletions

View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "6.5.0.1") (define version "6.5.0.2")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

View File

@ -1,6 +1,6 @@
#lang info #lang info
(define post-install-collection "installer.rkt") (define install-collection "installer.rkt")
(define raco-commands '(("docs" help/help "search and view documentation" 110))) (define raco-commands '(("docs" help/help "search and view documentation" 110)))
(define scribblings '(("help.scrbl"))) (define scribblings '(("help.scrbl")))

View File

@ -1,18 +1,36 @@
#lang scheme/base #lang scheme/base
(require launcher
setup/dirs)
;; Builds different kinds of executables for different platforms. ;; Builds different kinds of executables for different platforms.
;; The `plt-help' executable is for backward compatibity. ;; The `plt-help' executable is for backward compatibity.
;; The `Racket Documentation' executable is to help Windows and ;; The `Racket Documentation' executable is to help Windows and
;; Mac users who are completely lost and need something to click. ;; Mac users who are completely lost and need something to click.
(provide post-installer) (provide installer)
(require launcher)
(define (post-installer path collection user?) (define (installer path coll user? no-main?)
(unless no-main?
(do-installer path coll user? #f)
(when (and (not user?)
(find-config-tethered-console-bin-dir))
(do-installer path coll #f #t)))
(when (find-addon-tethered-console-bin-dir)
(do-installer path coll #t #t)))
(define (do-installer path collection user? tethered?)
(for ([mr? (case (system-type) (for ([mr? (case (system-type)
[(macosx) '(#t #f)] [(macosx) '(#t #f)]
[(windows) '(#t)] [(windows) '(#t)]
[else '(#f)])]) [else '(#f)])]
#:when (or (not tethered?)
(if mr?
(if user?
(find-addon-tethered-gui-bin-dir)
(find-config-tethered-gui-bin-dir))
(if user?
(find-addon-tethered-console-bin-dir)
(find-config-tethered-console-bin-dir)))))
(define-values (variants mk-launcher mk-path extras) (define-values (variants mk-launcher mk-path extras)
(if mr? (if mr?
(values available-mred-variants (values available-mred-variants
@ -26,10 +44,12 @@
'()))) '())))
(for ([variant (remove* '(script-3m script-cgc) (variants))]) (for ([variant (remove* '(script-3m script-cgc) (variants))])
(parameterize ([current-launcher-variant variant]) (parameterize ([current-launcher-variant variant])
(mk-launcher '("-l-" "help/help") (mk-launcher #:tether-mode (and tethered? (if user? 'addon 'config))
(mk-path (if mr? "Racket Documentation" "plt-help") #:user? user?) (append
'("-l-" "help/help"))
(mk-path (if mr? "Racket Documentation" "plt-help") #:user? user? #:tethered? tethered?)
`([exe-name . ,(if mr? "Racket Documentation" "plt-help")] `([exe-name . ,(if mr? "Racket Documentation" "plt-help")]
[relative? . ,(not user?)] [relative? . ,(not user?)]
[install-mode . ,(if user? 'user 'main)] [install-mode . ,(if user? 'user 'main)]
[start-menu? . #t] [start-menu? . ,(not user?)]
,@extras)))))) ,@extras))))))

View File

@ -3,7 +3,7 @@
(define collection 'multi) (define collection 'multi)
(define deps '("scheme-lib" (define deps '("scheme-lib"
"base" ["base" #:version "6.5.0.2"]
"net-lib" "net-lib"
"sandbox-lib" "sandbox-lib"
["scribble-lib" #:version "1.14"] ["scribble-lib" #:version "1.14"]

View File

@ -18,6 +18,10 @@ to configure other directories as described below. Use the
@racketmodname[setup/dirs] library (which combines information from @racketmodname[setup/dirs] library (which combines information from
the configuration files and other sources) to locate configured the configuration files and other sources) to locate configured
directories, instead of reading @filepath{config.rktd} directly. directories, instead of reading @filepath{config.rktd} directly.
A @filepath{config.rktd} file can also appear in the directory
@racket[(build-path (find-system-path 'addon-dir) "etc")], but it
controls only the results of @racket[find-addon-tethered-console-bin-dir] and
@racket[find-addon-tethered-gui-bin-dir].
The path of the @deftech{main collection directory} is built into the The path of the @deftech{main collection directory} is built into the
Racket executable, and it can be changed via the Racket executable, and it can be changed via the
@ -166,4 +170,12 @@ directory}:
binary identifies itself as CGC, then the suffix is binary identifies itself as CGC, then the suffix is
@racket["3m"], otherwise it is @racket[""].} @racket["3m"], otherwise it is @racket[""].}
@item{@indexed-racket['config-tethered-console-bin-dir] and
@indexed-racket['config-tethered-gui-bin-dir] --- a path for a
directory to hold extra copies of executables that are tied to the
configuration directory (as reported by @racket[find-config-dir])
that is active at the time the executables are created. See also
@racket[find-config-tethered-console-bin-dir] and
@racket[find-config-tethered-gui-bin-dir].}
] ]

View File

@ -15,7 +15,8 @@
compiler/embed-unit compiler/embed-unit
racket/runtime-path racket/runtime-path
launcher/launcher launcher/launcher
compiler/find-exe)) compiler/find-exe
setup/dirs))
@title{API for Creating Executables} @title{API for Creating Executables}
@ -474,6 +475,7 @@ A unit that imports nothing and exports @racket[compiler:embed^].}
@defmodule[compiler/find-exe] @defmodule[compiler/find-exe]
@defproc[(find-exe [#:cross? cross? any/c #f] @defproc[(find-exe [#:cross? cross? any/c #f]
[#:untetherd? untethered? any/c #f]
[gracket? any/c #f] [gracket? any/c #f]
[variant (or/c 'cgc '3m) (if cross? [variant (or/c 'cgc '3m) (if cross?
(cross-system-type 'gc) (cross-system-type 'gc)
@ -486,4 +488,10 @@ A unit that imports nothing and exports @racket[compiler:embed^].}
If @racket[cross?] is true, the executable is found for the target If @racket[cross?] is true, the executable is found for the target
platform in @seclink["cross-system"]{cross-installation mode}. platform in @seclink["cross-system"]{cross-installation mode}.
@history[#:changed "6.3" @elem{Added the @racket[#:cross?] argument.}]} If @racket[untethered?] is true, then the original executable is
found, instead of an executable that is tethered to a configuration
or addon directory via @racket[(find-addon-tethered-console-bin-dir)]
and related functions.
@history[#:changed "6.3" @elem{Added the @racket[#:cross?] argument.}
#:changed "6.2.0.5" @elem{Added the @racket[#:untethered?] argument.}]}

View File

@ -28,7 +28,8 @@ creating @tech{launchers}.
@defproc[(make-gracket-launcher [args (listof string?)] @defproc[(make-gracket-launcher [args (listof string?)]
[dest path-string?] [dest path-string?]
[aux (listof (cons/c symbol? any/c)) null]) [aux (listof (cons/c symbol? any/c)) null]
[#:tether-mode tether-mode (or/c 'addon 'config #f) 'addon])
void?]{ void?]{
Creates the launcher @racket[dest], which starts GRacket with the Creates the launcher @racket[dest], which starts GRacket with the
@ -69,9 +70,13 @@ the following additional associations apply to launchers:
base GRacket executable through a relative path.} base GRacket executable through a relative path.}
@item{@racket['install-mode] (Windows, Unix) --- either @item{@racket['install-mode] (Windows, Unix) --- either
@racket['user] or @racket['main], indicates that the launcher @racket['main], @racket['user], @racket['config-tethered], or
is being installed to a user-specific place or to an @racket['addon-tethered], indicates that the launcher
installation-wide place, which in turn determines where to is being installed to an
installation-wide place, a user-specific place, an installation-wide
place that embeds the configuration path, or a specific place that
embeds an addon-directory path;
the install mode, in turn, determines whether and where to
record @racket['start-menu], @racket['extension-registry], record @racket['start-menu], @racket['extension-registry],
and/or @racket['desktop] information.} and/or @racket['desktop] information.}
@ -146,7 +151,17 @@ arguments to the script. Instead of appending these arguments to the
end of @racket[args], they are spliced in after any X Windows flags end of @racket[args], they are spliced in after any X Windows flags
already listed in @racket[args]. The remaining arguments (i.e., already listed in @racket[args]. The remaining arguments (i.e.,
all script flags and arguments after the last X Windows flag or all script flags and arguments after the last X Windows flag or
argument) are then appended after the spliced @racket[args].} argument) are then appended after the spliced @racket[args].
The @racket[tether-mode] argument indicates how much to preserve the
current installation's tethering to a configuration directory and/or
addon directory based on @racket[(find-addon-tether-console-bin-dir)]
and @racket[(find-config-tether-console-bin-dir)]. The @racket['addon]
mode allows full tethering, the @racket['config] mode allows only
configuration-directory tethering, and the @racket[#f] mode disables
tethering.
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tether-mode] argument.}]}
@defproc[(make-racket-launcher [args (listof string?)] @defproc[(make-racket-launcher [args (listof string?)]
@ -251,27 +266,50 @@ arguments.}
@section{Launcher Path and Platform Conventions} @section{Launcher Path and Platform Conventions}
@defproc[(gracket-program-launcher-path [name string?] @defproc[(gracket-program-launcher-path [name string?]
[#:user? user? any/c #f]) [#:user? user? any/c #f]
[#:tethered? tethered? any/c #f])
path?]{ path?]{
Returns a pathname for an executable called something like @racket[name] Returns a pathname for an executable called something like @racket[name]
in the Racket installation (if @racket[user?] is @racket[#f]) or the in
user's Racket executable directory (if @racket[user?] is @racket[#t]).
@itemlist[
@item{the Racket installation --- when @racket[user?] is @racket[#f]
and @racket[tethered?] is @racket[#f];}
@item{the user's Racket executable directory --- when @racket[user?]
is @racket[#t] and @racket[tethered?] is @racket[#f];}
@item{an additional executable directory for executables tethered to a
particular configuration directory --- when @racket[user?] is
@racket[#f] and @racket[tethered?] is @racket[#t]; or}
@item{an additional executable directory for executables tethered to
a particular addon and configuration directory --- when
@racket[user?] is @racket[#t] and @racket[tethered?] is
@racket[#t].}
]
For Windows, the @filepath{.exe} For Windows, the @filepath{.exe}
suffix is automatically appended to @racket[name]. For Unix, suffix is automatically appended to @racket[name]. For Unix,
@racket[name] is changed to lowercase, whitespace is changed to @racket[name] is changed to lowercase, whitespace is changed to
@litchar{-}, and the path includes the @filepath{bin} subdirectory of @litchar{-}, and the path includes the @filepath{bin} subdirectory of
the Racket installation. For Mac OS X, the @filepath{.app} suffix the Racket installation. For Mac OS X, the @filepath{.app} suffix
is appended to @racket[name].} is appended to @racket[name].
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
@defproc[(racket-program-launcher-path [name string?] @defproc[(racket-program-launcher-path [name string?]
[#:user? user? any/c #f]) [#:user? user? any/c #f]
[#:tethered? tethered? any/c #f])
path?]{ path?]{
Returns the same path as @racket[(gracket-program-launcher-path name #:user? user?)] Returns the same path as @racket[(gracket-program-launcher-path name #:user? user? #:tethered tethered?)].
for Unix and Windows. For Mac OS X, the result is the same as for
Unix.} @history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
@defproc[(gracket-launcher-is-directory?) boolean?]{ @defproc[(gracket-launcher-is-directory?) boolean?]{
@ -335,7 +373,7 @@ Like @racket[gracket-launcher-get-file-extension+style+filters], but for
Racket launchers.} Racket launchers.}
@deftogether[( @deftogether[(
@defproc[(mred-program-launcher-path [name string?] [#:user? user? any/c #f]) path?] @defproc[(mred-program-launcher-path [name string?] [#:user? user? any/c #f] [#:tethered? tethered? any/c #f]) path?]
@defproc[(mred-launcher-is-directory?) boolean?] @defproc[(mred-launcher-is-directory?) boolean?]
@defproc[(mred-launcher-is-actually-directory?) boolean?] @defproc[(mred-launcher-is-actually-directory?) boolean?]
@defproc[(mred-launcher-add-suffix [path-string? path]) path?] @defproc[(mred-launcher-add-suffix [path-string? path]) path?]
@ -346,10 +384,12 @@ Racket launchers.}
)]{ )]{
Backward-compatible aliases for Backward-compatible aliases for
@racket[gracket-program-launcher-path], etc.} @racket[gracket-program-launcher-path], etc.
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
@deftogether[( @deftogether[(
@defproc[(mzscheme-program-launcher-path [name string?] [#:user? user? any/c #f]) path?] @defproc[(mzscheme-program-launcher-path [name string?] [#:user? user? any/c #f] [#:tethered? tethered? any/c #f]) path?]
@defproc[(mzscheme-launcher-is-directory?) boolean?] @defproc[(mzscheme-launcher-is-directory?) boolean?]
@defproc[(mzscheme-launcher-is-actually-directory?) boolean?] @defproc[(mzscheme-launcher-is-actually-directory?) boolean?]
@defproc[(mzscheme-launcher-add-suffix [path-string? path]) path?] @defproc[(mzscheme-launcher-add-suffix [path-string? path]) path?]
@ -360,7 +400,9 @@ Backward-compatible aliases for
)]{ )]{
Backward-compatible aliases for Backward-compatible aliases for
@racket[racket-program-launcher-path], etc.} @racket[racket-program-launcher-path], etc.
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
@defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c]) @defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c])

View File

@ -708,35 +708,52 @@ Optional @filepath{info.rkt} fields trigger additional actions by
specification is compared to @racket[(system-type)] specification is compared to @racket[(system-type)]
and @racket[(system-library-subpath #f)].} and @racket[(system-library-subpath #f)].}
@item{@indexed-racket[install-collection] : @racket[path-string?] --- A @item{@indexed-racket[install-collection] : @racket[path-string?] ---
library module relative to the collection that provides A library module relative to the collection that provides
@racket[installer]. The @racket[installer] procedure accepts one @racket[installer]. The @racket[installer] procedure must accept
to three arguments. The first argument is a directory path to the one, two, three, or four arguments:
parent of the Racket installation's @filepath{collects} directory; the
second argument, if accepted, is a path to the collection's own @itemlist[
directory; the third argument, if accepted, is a boolean indicating
@item{The first argument is a directory path to the parent of the
Racket installation's @filepath{collects} directory.}
@item{The second argument, if accepted, is a path to the
collection's own directory.}
@item{The third argument, if accepted, is a boolean indicating
whether the collection is installed as user-specific (@racket[#t]) whether the collection is installed as user-specific (@racket[#t])
or installation-wide (@racket[#f]). The procedure should perform collection-specific or installation-wide (@racket[#f]).}
installation work, and it should avoid unnecessary work in the case
that it is called multiple times for the same installation.} @item{The fourth argument, if accepted, is a boolean indicating
whether the collection is installed as installation-wide and should
nevertheless avoid modifying the installation; an
@racket[installer] procedure that does not accept this argument is
never called when the argument would be @racket[#t]. An installer
that does accept this argument is called with @racket[#t] to that
it can perform user-specific work, even though the collection is
installed installation-wide.}
]}
@item{@indexed-racket[pre-install-collection] : @racket[path-string?] --- @item{@indexed-racket[pre-install-collection] : @racket[path-string?] ---
Like @racket[install-collection], except that the corresponding Like @racket[install-collection], except that the corresponding
installer is called @emph{before} the normal @filepath{.zo} build, installer procedures are called @emph{before} the normal @filepath{.zo} build,
instead of after. The provided procedure should be named instead of after. The provided procedure is
@racket[pre-installer] in this case, so it can be provided by the @racket[pre-installer], so it can be provided by the
same file that provides an @racket[installer].} same file that provides an @racket[installer] procedure.}
@item{@indexed-racket[post-install-collection] : @racket[path-string?] --- @item{@indexed-racket[post-install-collection] : @racket[path-string?] ---
Like @racket[install-collection]. It is called right after the Like @racket[install-collection] for a procedure that is called right after the
@racket[install-collection] procedure is executed. The only @racket[install-collection] procedure is executed. The
difference between these is that the @DFlag{no-install} flag can be @DFlag{no-install} flag can be provided to @exec{raco setup}
used to disable the previous two installers, but not this one. It to disable @racket[install-collection] and @racket[pre-install-collection],
is therefore expected to perform operations that are always needed, but not @racket[post-install-collection]. The @racket[post-install-collection]
function is therefore expected to perform operations that are always needed,
even after an installation that contains pre-compiled files. The even after an installation that contains pre-compiled files. The
provided procedure should be named @racket[post-installer] in this provided procedure is @racket[post-installer], so it
case, so it can be provided by the same file that provides the can be provided by the same file that provides an
previous two.} @racket[installer] procedure.}
@item{@indexed-racket[assume-virtual-sources] : @racket[any/c] --- @item{@indexed-racket[assume-virtual-sources] : @racket[any/c] ---
A true value indicates that bytecode files without a corresponding A true value indicates that bytecode files without a corresponding
@ -1412,6 +1429,52 @@ function for installing a single @filepath{.plt} file.
absolute path names for executable and library references, absolute path names for executable and library references,
@racket[#f] otherwise.} @racket[#f] otherwise.}
@deftogether[(
@defproc[(find-addon-tethered-console-bin-dir) (or/c #f path?)]
@defproc[(find-addon-tethered-gui-bin-dir) (or/c #f path?)]
)]{
Returns a path to a user-specific directory to hold an extra copy of
each installed executable, where the extra copy is created by
@exec{raco setup} and tethered to a particular result for
@racket[(find-system-path 'addon-dir)] and
@racket[(find-config-dir)].
Unlike other directories, which are configured via
@filepath{config.rktd} in the @racket[(find-config-dir)] directory
(see @secref["config-file"]), these paths are configured via
@racket['addon-tethered-console-bin-dir] and
@racket['addon-tethered-gui-bin-dir] entries in
@filepath{config.rktd} in @racket[(build-path (find-system-path
'addon-dir) "etc")]. If no configuration is present, the result from
the corresponding function,
@racket[find-addon-tethered-console-bin-dir] or
@racket[find-addon-tethered-gui-bin-dir], is @racket[#f] instead of
a path.
The intent of this protocol is to support a kind of sandbox: an
installation that is more specific than user-specific, and where
copies of executables such as @exec{racket} serve as entry points
into the sandbox. Assuming that the addon directory is set to a
directory other than the user's default addon directory when
@exec{raco setup} creates the executable copies, then further
package build and setup operations through the entry points will be
confined to the sandbox and not affect a user's default environment.
@history[#:added "6.5.0.2"]}
@deftogether[(
@defproc[(find-config-tethered-console-bin-dir) (or/c #f path?)]
@defproc[(find-config-tethered-gui-bin-dir) (or/c #f path?)]
)]{
Similar to @racket[find-addon-tethered-console-bin-dir] and
@racket[find-addon-tethered-gui-bin-dir], but configured via
@filepath{config.rktd} in the @racket[(find-config-dir)] directory
(see @secref["config-file"]) and triggers executables that are
tethered only to a particular value of @racket[(find-config-dir)].
@history[#:added "6.5.0.2"]}
@; ------------------------------------------------------------------------ @; ------------------------------------------------------------------------
@section[#:tag "getinfo"]{API for Reading @filepath{info.rkt} Files} @section[#:tag "getinfo"]{API for Reading @filepath{info.rkt} Files}

View File

@ -1436,7 +1436,7 @@
cmdline)) . < . 80)) cmdline)) . < . 80))
(error 'create-embedding-executable "command line too long: ~e" cmdline)) (error 'create-embedding-executable "command line too long: ~e" cmdline))
(check-collects-path 'create-embedding-executable collects-path collects-path-bytes) (check-collects-path 'create-embedding-executable collects-path collects-path-bytes)
(let ([exe (find-exe #:cross? #t mred? variant)]) (let ([exe (find-exe #:cross? #t #:untethered? #t mred? variant)])
(when verbose? (when verbose?
(eprintf "Copying to ~s\n" dest)) (eprintf "Copying to ~s\n" dest))
(let-values ([(dest-exe orig-exe osx?) (let-values ([(dest-exe orig-exe osx?)

View File

@ -5,13 +5,20 @@
(provide find-exe) (provide find-exe)
(define (find-exe #:cross? [cross? #f] (define (find-exe #:cross? [cross? #f]
#:untethered? [untethered? #f]
[mred? #f] [mred? #f]
[variant (if cross? [variant (if cross?
(cross-system-type 'gc) (cross-system-type 'gc)
(system-type 'gc))]) (system-type 'gc))])
(let* ([base (if mred? (let* ([base (if mred?
(find-lib-dir) (or (and (not untethered?)
(find-console-bin-dir))] (find-addon-tethered-gui-bin-dir)
(find-config-tethered-gui-bin-dir))
(find-lib-dir))
(or (and (not untethered?)
(find-addon-tethered-console-bin-dir)
(find-config-tethered-console-bin-dir))
(find-console-bin-dir)))]
[fail [fail
(lambda () (lambda ()
(error 'find-exe (error 'find-exe

View File

@ -364,6 +364,9 @@
(format "~a~a.app/Contents/MacOS/~a~a" (format "~a~a.app/Contents/MacOS/~a~a"
(cdr m) (variant-suffix variant #t) (cdr m) (variant-suffix variant #t)
(cdr m) (variant-suffix variant #t))))] (cdr m) (variant-suffix variant #t))))]
[alt-exe-is-gracket? (and alt-exe
(let ([m (assq 'exe-is-gracket aux)])
(and m (cdr m))))]
[x-flags? (and (eq? kind 'mred) [x-flags? (and (eq? kind 'mred)
(eq? (cross-system-type) 'unix) (eq? (cross-system-type) 'unix)
(not (script-variant? variant)))] (not (script-variant? variant)))]
@ -373,6 +376,7 @@
flags))] flags))]
[post-flags (cond [post-flags (cond
[x-flags? (skip-x-flags flags)] [x-flags? (skip-x-flags flags)]
[alt-exe-is-gracket? flags]
[alt-exe null] [alt-exe null]
[else flags])] [else flags])]
[pre-flags (cond [pre-flags (cond
@ -389,9 +393,12 @@
"# This script was created by make-" "# This script was created by make-"
(symbol->string kind)"-launcher\n")] (symbol->string kind)"-launcher\n")]
[use-librktdir? (if alt-exe [use-librktdir? (if alt-exe
(let ([m (assq 'exe-is-gracket aux)]) alt-exe-is-gracket?
(and m (cdr m)))
(eq? kind 'mred))] (eq? kind 'mred))]
[addon? (let ([im (assoc 'install-mode aux)])
(and im (eq? (cdr im) 'addon-tethered)))]
[config? (let ([im (assoc 'install-mode aux)])
(and im (eq? (cdr im) 'config-tethered)))]
[dir-finder [dir-finder
(let ([bindir (if alt-exe (let ([bindir (if alt-exe
(let ([m (assq 'exe-is-gracket aux)]) (let ([m (assq 'exe-is-gracket aux)])
@ -399,8 +406,16 @@
(find-lib-dir) (find-lib-dir)
(let ([p (path-only dest)]) (let ([p (path-only dest)])
(if (eq? 'macosx (cross-system-type)) (if (eq? 'macosx (cross-system-type))
(let* ([cdir (find-console-bin-dir)] (let* ([cdir (or (and addon?
[gdir (find-gui-bin-dir)] (find-addon-tethered-console-bin-dir))
(and config?
(find-config-tethered-console-bin-dir))
(find-console-bin-dir))]
[gdir (or (and addon?
(find-addon-tethered-gui-bin-dir))
(and config?
(find-config-tethered-gui-bin-dir))
(find-gui-bin-dir))]
[rel (find-relative-path cdir gdir)]) [rel (find-relative-path cdir gdir)])
(cond (cond
[(relative-path? rel) [(relative-path? rel)
@ -729,15 +744,30 @@
[(macos) make-macos-launcher] [(macos) make-macos-launcher]
[(macosx) make-macosx-launcher])) [(macosx) make-macosx-launcher]))
(define (make-gracket-launcher flags dest [aux null]) (define (make-gracket-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
((get-maker) 'mred (current-launcher-variant) flags dest aux)) ((get-maker) 'mred (current-launcher-variant) (add-tether tether-mode flags) dest aux))
(define (make-mred-launcher flags dest [aux null]) (define (make-mred-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
((get-maker) 'mred (current-launcher-variant) (list* "-I" "scheme/gui/init" flags) dest aux)) (let ([flags (list* "-I" "scheme/gui/init" (add-tether tether-mode flags))])
((get-maker) 'mred (current-launcher-variant) flags dest aux)))
(define (make-racket-launcher flags dest [aux null]) (define (make-racket-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
((get-maker) 'mzscheme (current-launcher-variant) flags dest aux)) ((get-maker) 'mzscheme (current-launcher-variant) (add-tether tether-mode flags) dest aux))
(define (make-mzscheme-launcher flags dest [aux null]) (define (make-mzscheme-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
((get-maker) 'mzscheme (current-launcher-variant) (list* "-I" "scheme/init" flags) dest aux)) (let ([flags (list* "-I" "scheme/init" (add-tether tether-mode flags))])
((get-maker) 'mzscheme (current-launcher-variant) flags dest aux)))
(define (add-tether tether-mode flags)
(cond
[(not tether-mode) flags]
[(and (not (eq? tether-mode 'config))
(find-addon-tethered-console-bin-dir))
(list* "-G" (path->string (find-config-dir))
"-A" (path->string (find-system-path 'addon-dir))
flags)]
[(find-config-tethered-console-bin-dir)
(list* "-G" (path->string (find-config-dir))
flags)]
[else flags]))
(define (strip-suffix s) (define (strip-suffix s)
(path-replace-suffix s #"")) (path-replace-suffix s #""))
@ -894,7 +924,7 @@
(string-append (if mred? file (unix-sfx file mred?)) ".exe")] (string-append (if mred? file (unix-sfx file mred?)) ".exe")]
[else file])) [else file]))
(define (program-launcher-path name mred? user?) (define (program-launcher-path name mred? user? tethered?)
(let* ([variant (current-launcher-variant)] (let* ([variant (current-launcher-variant)]
[mac-script? (and (eq? (cross-system-type) 'macosx) [mac-script? (and (eq? (cross-system-type) 'macosx)
(script-variant? variant))]) (script-variant? variant))])
@ -902,11 +932,19 @@
(build-path (build-path
(if (or mac-script? (not mred?)) (if (or mac-script? (not mred?))
(if user? (if user?
(find-user-console-bin-dir) (or (and tethered?
(find-console-bin-dir)) (find-addon-tethered-console-bin-dir))
(find-user-console-bin-dir))
(or (and tethered?
(find-config-tethered-console-bin-dir))
(find-console-bin-dir)))
(if user? (if user?
(find-user-gui-bin-dir) (or (and tethered?
(find-gui-bin-dir))) (find-addon-tethered-gui-bin-dir))
(find-user-gui-bin-dir))
(or (and tethered?
(find-config-tethered-gui-bin-dir))
(find-gui-bin-dir))))
((if mac-script? unix-sfx sfx) name mred?)) ((if mac-script? unix-sfx sfx) name mred?))
variant variant
mred?)]) mred?)])
@ -915,23 +953,27 @@
(path-replace-suffix p #".app") (path-replace-suffix p #".app")
p)))) p))))
(define (gracket-program-launcher-path name #:user? [user? #f]) (define (gracket-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(program-launcher-path name #t user?)) (program-launcher-path name #t user? tethered?))
(define (mred-program-launcher-path name #:user? [user? #f]) (define (mred-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(gracket-program-launcher-path name #:user? user?)) (gracket-program-launcher-path name #:user? user? #:tethered? tethered?))
(define (racket-program-launcher-path name #:user? [user? #f]) (define (racket-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(case (cross-system-type) (case (cross-system-type)
[(macosx) [(macosx)
(add-file-suffix (build-path (if user? (add-file-suffix (build-path (if user?
(find-user-console-bin-dir) (or (and tethered?
(find-console-bin-dir)) (find-addon-tethered-console-bin-dir))
(find-user-console-bin-dir))
(or (and tethered?
(find-config-tethered-console-bin-dir))
(find-console-bin-dir)))
(unix-sfx name #f)) (unix-sfx name #f))
(current-launcher-variant) (current-launcher-variant)
#f)] #f)]
[else (program-launcher-path name #f user?)])) [else (program-launcher-path name #f user? tethered?)]))
(define (mzscheme-program-launcher-path name #:user? [user? #f]) (define (mzscheme-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(racket-program-launcher-path name #:user? user?)) (racket-program-launcher-path name #:user? user? #:tethered? tethered?))
(define (gracket-launcher-is-directory?) (define (gracket-launcher-is-directory?)
#f) #f)

View File

@ -8,3 +8,5 @@
("Porting from v1xxx to v2xxx" "MzScheme_200.txt"))))) ("Porting from v1xxx to v2xxx" "MzScheme_200.txt")))))
(define copy-man-pages '("racket.1")) (define copy-man-pages '("racket.1"))
(define install-collection "private/tethered-installer.rkt")

View File

@ -0,0 +1,30 @@
#lang racket/base
(require setup/dirs
racket/file
compiler/embed
launcher)
(provide installer)
(define (installer path coll user? no-main?)
(unless (or user? no-main?)
(do-installer #f (find-config-tethered-console-bin-dir)))
(do-installer #t (find-addon-tethered-console-bin-dir)))
(define (do-installer user? dir)
(when dir
(make-directory* dir)
(define variants (available-racket-variants))
(for ([v (in-list variants)])
(parameterize ([current-launcher-variant v])
(create-embedding-executable
(racket-program-launcher-path "Racket" #:user? user? #:tethered? #t)
#:variant v
#:cmdline (append
(list "-X" (path->string (find-collects-dir))
"-G" (path->string (find-config-dir)))
(if user?
(list "-A" (path->string (find-system-path 'addon-dir)))
null))
#:launcher? #t
#:aux `((relative? . #f)))))))

View File

@ -8,6 +8,8 @@
(provide (except-out (all-from-out "private/dirs.rkt") (provide (except-out (all-from-out "private/dirs.rkt")
config:dll-dir config:dll-dir
config:bin-dir config:bin-dir
config:config-tethered-console-bin-dir
config:config-tethered-gui-bin-dir
define-finder) define-finder)
find-dll-dir) find-dll-dir)
@ -30,6 +32,49 @@
[(windows macosx) 'same] [(windows macosx) 'same]
[(unix) "bin"])) [(unix) "bin"]))
(provide find-config-tethered-console-bin-dir
find-config-tethered-gui-bin-dir)
(define (find-config-tethered-console-bin-dir)
(force config:config-tethered-console-bin-dir))
(define (find-config-tethered-gui-bin-dir)
(force config:config-tethered-gui-bin-dir))
(provide find-addon-tethered-console-bin-dir
find-addon-tethered-gui-bin-dir)
(define addon-bin-table
(delay/sync
(let ()
(define f (build-path (find-system-path 'addon-dir)
"etc"
"config.rktd"))
(and (file-exists? f)
(call-with-input-file*
f
(lambda (in)
(call-with-default-reading-parameterization
(lambda ()
(read in)))))))))
(define (find-addon-bin-dir key)
(define t (force addon-bin-table))
(and (hash? t)
(let ([v (hash-ref t key #f)])
(and (path-string? v)
(simplify-path
(path->complete-path
v
(build-path (find-system-path 'addon-dir)
"etc")))))))
(define (find-addon-tethered-console-bin-dir)
(find-addon-bin-dir 'addon-tethered-console-bin-dir))
(define (find-addon-tethered-gui-bin-dir)
(find-addon-bin-dir 'addon-tethered-gui-bin-dir))
;; ---------------------------------------- ;; ----------------------------------------
;; DLLs ;; DLLs

View File

@ -58,6 +58,8 @@
(define-config config:include-dir 'include-dir to-path) (define-config config:include-dir 'include-dir to-path)
(define-config config:include-search-dirs 'include-search-dirs to-path) (define-config config:include-search-dirs 'include-search-dirs to-path)
(define-config config:bin-dir 'bin-dir to-path) (define-config config:bin-dir 'bin-dir to-path)
(define-config config:config-tethered-console-bin-dir 'config-tethered-console-bin-dir to-path)
(define-config config:config-tethered-gui-bin-dir 'config-tethered-gui-bin-dir to-path)
(define-config config:man-dir 'man-dir to-path) (define-config config:man-dir 'man-dir to-path)
(define-config config:links-file 'links-file to-path) (define-config config:links-file 'links-file to-path)
(define-config config:links-search-files 'links-search-files to-path) (define-config config:links-search-files 'links-search-files to-path)
@ -268,7 +270,9 @@
;; `setup/dirs` ;; `setup/dirs`
(provide config:bin-dir) (provide config:bin-dir
config:config-tethered-console-bin-dir
config:config-tethered-gui-bin-dir)
;; ---------------------------------------- ;; ----------------------------------------
;; DLLs ;; DLLs

View File

@ -319,7 +319,7 @@
(setup-printf "WARNING" "~a" (exn->string exn)) (setup-printf "WARNING" "~a" (exn->string exn))
v) v)
;; Maps a colletion name to a list of `cc's: ;; Maps a collection name to a list of `cc's:
(define collection-ccs-table (make-hash)) (define collection-ccs-table (make-hash))
;; collection-cc! : listof-path .... -> cc ;; collection-cc! : listof-path .... -> cc
@ -664,10 +664,7 @@
x-specific-planet-dirs))) x-specific-planet-dirs)))
null)) null))
(define top-level-plt-collects (define all-top-level-plt-collects
((if (avoid-main-installation)
(lambda (l) (filter (lambda (cc) (not (cc-main? cc))) l))
values)
(if no-specific-collections? (if no-specific-collections?
all-collections all-collections
(check-against-all (check-against-all
@ -690,7 +687,13 @@
(string-join sc "/"))) (string-join sc "/")))
ccs) ccs)
x-specific-collections) x-specific-collections)
(null? planet-collects))))) (null? planet-collects))))
(define top-level-plt-collects
(if (avoid-main-installation)
(filter (lambda (cc) (not (cc-main? cc)))
all-top-level-plt-collects)
all-top-level-plt-collects))
(define planet-dirs-to-compile (define planet-dirs-to-compile
(sort-collections (sort-collections
@ -700,11 +703,28 @@
(map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p)))) (map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p))))
subs))))) subs)))))
(define ccs-to-compile (define (combine-collections top-level-plt-collects)
(append (append
(sort-collections (lookup-collection-closure top-level-plt-collects)) (sort-collections (lookup-collection-closure top-level-plt-collects))
planet-dirs-to-compile)) planet-dirs-to-compile))
(define ccs-to-compile
(combine-collections top-level-plt-collects))
(define ccs-to-call-installers
(if (avoid-main-installation)
;; Although we mostly avoid the main installation, we'll
;; need to call main-installaiton launchers in case they
;; support being called to perform only user-specific
;; actions.
(combine-collections all-top-level-plt-collects)
ccs-to-compile))
(define ccs-to-make-launchers
(if (or (find-addon-tethered-console-bin-dir)
(find-addon-tethered-gui-bin-dir))
ccs-to-call-installers
ccs-to-compile))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Clean ;; ;; Clean ;;
@ -839,7 +859,7 @@
[(pre) "pre-"] [(pre) "pre-"]
[(general) ""] [(general) ""]
[(post) "post-"]))) [(post) "post-"])))
(for ([cc ccs-to-compile]) (for ([cc ccs-to-call-installers])
(let/ec k (let/ec k
(begin-record-error cc (case part (begin-record-error cc (case part
[(pre) "early install"] [(pre) "early install"]
@ -865,11 +885,18 @@
(error name-sym (error name-sym
"error loading installer: ~a" "error loading installer: ~a"
(exn->string exn)))]) (exn->string exn)))])
(define base-installer
(dynamic-require (build-path (cc-path cc) fn) (dynamic-require (build-path (cc-path cc) fn)
(case part (case part
[(pre) 'pre-installer] [(pre) 'pre-installer]
[(general) 'installer] [(general) 'installer]
[(post) 'post-installer])))) [(post) 'post-installer])))
(if (and (cc-main? cc)
(avoid-main-installation)
(not (procedure-arity-includes? base-installer 4)))
#f
base-installer)))
(when installer
(setup-printf (format "~ainstalling" (setup-printf (format "~ainstalling"
(case part (case part
[(pre) "pre-"] [(pre) "pre-"]
@ -879,12 +906,15 @@
(cc-name cc)) (cc-name cc))
(define dir (build-path main-collects-dir 'up)) (define dir (build-path main-collects-dir 'up))
(cond (cond
[(procedure-arity-includes? installer 4)
(installer dir (cc-path cc) (not (cc-main? cc)) (and (cc-main? cc)
(avoid-main-installation)))]
[(procedure-arity-includes? installer 3) [(procedure-arity-includes? installer 3)
(installer dir (cc-path cc) (not (cc-main? cc)))] (installer dir (cc-path cc) (not (cc-main? cc)))]
[(procedure-arity-includes? installer 2) [(procedure-arity-includes? installer 2)
(installer dir (cc-path cc))] (installer dir (cc-path cc))]
[else [else
(installer dir)])))))) (installer dir)])))))))
(define (bytecode-file-exists? p) (define (bytecode-file-exists? p)
(parameterize ([use-compiled-file-paths (list mode-dir)]) (parameterize ([use-compiled-file-paths (list mode-dir)])
@ -1366,7 +1396,7 @@
(error "result is not a list of strings:" l))) (error "result is not a list of strings:" l)))
(define ((or-f f) x) (when x (f x))) (define ((or-f f) x) (when x (f x)))
(define created-launchers (make-hash)) (define created-launchers (make-hash))
(for ([cc ccs-to-compile]) (for ([cc ccs-to-make-launchers])
(begin-record-error cc "launcher setup" (begin-record-error cc "launcher setup"
(define info (cc-info cc)) (define info (cc-info cc))
(define (make-launcher kind (define (make-launcher kind
@ -1396,6 +1426,15 @@
[mzll (in-list (or mzlls (map (lambda (_) #f) mzlns)))] [mzll (in-list (or mzlls (map (lambda (_) #f) mzlns)))]
[mzlf (in-list (or mzlfs (map (lambda (_) #f) mzlns)))]) [mzlf (in-list (or mzlfs (map (lambda (_) #f) mzlns)))])
(define p (program-launcher-path mzln #:user? (not (cc-main? cc)))) (define p (program-launcher-path mzln #:user? (not (cc-main? cc))))
(define addon-p (and (if (eq? kind 'gui)
(find-addon-tethered-gui-bin-dir)
(find-addon-tethered-console-bin-dir))
(program-launcher-path mzln #:user? #t #:tethered? #t)))
(define config-p (and (cc-main? cc)
(if (eq? kind 'gui)
(find-config-tethered-gui-bin-dir)
(find-config-tethered-console-bin-dir))
(program-launcher-path mzln #:user? #f #:tethered? #t)))
(define receipt-path (define receipt-path
(build-path (if (cc-main? cc) (build-path (if (cc-main? cc)
(find-lib-dir) (find-lib-dir)
@ -1404,18 +1443,29 @@
(define (prep-dir p) (define (prep-dir p)
(define dir (path-only p)) (define dir (path-only p))
(make-directory* dir)) (make-directory* dir))
(define skip-non-addon? (and (cc-main? cc)
(avoid-main-installation)))
(unless skip-non-addon?
(prep-dir p) (prep-dir p)
(prep-dir receipt-path) (prep-dir receipt-path)
(when config-p
(prep-dir config-p)))
(when addon-p
(prep-dir addon-p))
(hash-set! created-launchers (hash-set! created-launchers
(record-launcher receipt-path mzln kind (current-launcher-variant) (record-launcher receipt-path mzln kind (current-launcher-variant)
(cc-collection cc) (cc-path cc)) (cc-collection cc) (cc-path cc))
#t) #t)
(define (create p user? tethered?)
(define aux (define aux
(append (append
`((exe-name . ,mzln) `((exe-name . ,mzln)
(relative? . ,(and (cc-main? cc) (relative? . ,(and (cc-main? cc)
(not tethered?)
(not (get-absolute-installation?)))) (not (get-absolute-installation?))))
(install-mode . ,(if (cc-main? cc) 'main 'user)) (install-mode . ,(if tethered?
(if user? 'addon-tethered 'config-tethered)
(if (cc-main? cc) 'main 'user)))
,@(build-aux-from-path ,@(build-aux-from-path
(build-path (cc-path cc) (build-path (cc-path cc)
(path-replace-suffix (or mzll mzln) #"")))))) (path-replace-suffix (or mzll mzln) #""))))))
@ -1430,6 +1480,12 @@
(let ([v (current-launcher-variant)]) (let ([v (current-launcher-variant)])
(if (eq? v (cross-system-type 'gc)) "" (format " [~a]" v)))) (if (eq? v (cross-system-type 'gc)) "" (format " [~a]" v))))
(make-launcher (make-launcher
#:tether-mode (if tethered?
(if user?
'addon
'config)
#f)
(append
(or mzlf (or mzlf
(if (cc-collection cc) (if (cc-collection cc)
(list "-l-" (string-append (list "-l-" (string-append
@ -1437,9 +1493,15 @@
(map (lambda (s) (format "~a/" s)) (map (lambda (s) (format "~a/" s))
(cc-collection cc))) (cc-collection cc)))
mzll)) mzll))
(list "-t-" (path->string (build-path (cc-path cc) mzll))))) (list "-t-" (path->string (build-path (cc-path cc) mzll))))))
p p
aux)))] aux)))
(unless skip-non-addon?
(create p (not (cc-main? cc)) #f)
(when config-p
(create config-p #f #t)))
(when addon-p
(create addon-p #t #t)))]
[else [else
(define fault (define fault
(if (or (not mzlls) (= (length mzlns) (length mzlls))) 'f 'l)) (if (or (not mzlls) (= (length mzlns) (length mzlls))) 'f 'l))
@ -1485,15 +1547,11 @@
(make-tidy)) (make-tidy))
(unless (avoid-main-installation) (unless (avoid-main-installation)
(tidy-launchers #f (tidy-launchers #f
(find-console-bin-dir)
(find-gui-bin-dir)
(find-lib-dir) (find-lib-dir)
created-launchers created-launchers
ccs-to-compile)) ccs-to-compile))
(when (make-user) (when (make-user)
(tidy-launchers #t (tidy-launchers #t
(find-user-console-bin-dir)
(find-user-gui-bin-dir)
(find-user-lib-dir) (find-user-lib-dir)
created-launchers created-launchers
ccs-to-compile)))) ccs-to-compile))))
@ -1535,7 +1593,7 @@
(write-receipt-hash receipt-path ht))) (write-receipt-hash receipt-path ht)))
exe-key)) exe-key))
(define (tidy-launchers user? bin-dir gui-bin-dir lib-dir created ccs-to-compile) (define (tidy-launchers user? lib-dir created ccs-to-compile)
(define receipt-path (build-path lib-dir "launchers.rktd")) (define receipt-path (build-path lib-dir "launchers.rktd"))
(define ht (read-receipt-hash receipt-path)) (define ht (read-receipt-hash receipt-path))
(define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)]) (define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)])
@ -1562,15 +1620,21 @@
(define variant (vector-ref k 1)) (define variant (vector-ref k 1))
(define name (vector-ref k 2)) (define name (vector-ref k 2))
(parameterize ([current-launcher-variant variant]) (parameterize ([current-launcher-variant variant])
(define exe-path ((if (eq? kind 'gui) (define (get-path user? tethered?)
((if (eq? kind 'gui)
gracket-program-launcher-path gracket-program-launcher-path
racket-program-launcher-path) racket-program-launcher-path)
name name
#:user? user?)) #:user? user?
#:tethered? tethered?))
(define exe-path (get-path user? #f))
(define config-exe-path (and (not user?) (get-path #f #t)))
(define addon-exe-path (get-path #t #t))
(define is-dir? (define is-dir?
(if (eq? kind 'gui) (if (eq? kind 'gui)
(gracket-launcher-is-actually-directory?) (gracket-launcher-is-actually-directory?)
(racket-launcher-is-actually-directory?))) (racket-launcher-is-actually-directory?)))
(define (delete exe-path)
(define rel-exe-path (define rel-exe-path
((if (eq? kind 'gui) ((if (eq? kind 'gui)
path->relative-string/gui-bin path->relative-string/gui-bin
@ -1582,7 +1646,10 @@
(delete-file exe-path)] (delete-file exe-path)]
[(and is-dir? (directory-exists? exe-path)) [(and is-dir? (directory-exists? exe-path))
(setup-printf "deleting" "launcher ~a" rel-exe-path) (setup-printf "deleting" "launcher ~a" rel-exe-path)
(delete-directory/files exe-path)]) (delete-directory/files exe-path)]))
(delete exe-path)
(when config-exe-path (delete config-exe-path))
(when addon-exe-path (delete addon-exe-path))
;; Clean up any associated .desktop file and icon file: ;; Clean up any associated .desktop file and icon file:
(when (eq? 'unix (cross-system-type)) (when (eq? 'unix (cross-system-type))
(let ([desktop (installed-executable-path->desktop-path (let ([desktop (installed-executable-path->desktop-path

View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "6.5.0.1" #define MZSCHEME_VERSION "6.5.0.2"
#define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 5 #define MZSCHEME_VERSION_Y 5
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 1 #define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)