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

raco setup: allow foreign-lib and man-page installation

Browse Source 
This change hopefully fills out the things that a distribution
can do and that packages should be able to extend.
This commit is contained in:
Matthew Flatt 2013-05-03 09:11:55 -06:00
parent 717eacf90d
commit 03b35cd846
8 changed files with 259 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/scribblings/raco/setup.scrbl
View File

@ -26,7 +26,9 @@
dynext/file-sig
racket/gui/base
racket/future
mrlib/terminal))
mrlib/terminal
(only-in ffi/unsafe ffi-lib)
racket/path))
@(define-syntax-rule (local-module mod . body)
(begin
@ -128,7 +130,11 @@ flags:
the assumption that they are already up-to-date.}
@item{@DFlag{no-launcher} or @Flag{x} --- refrain from creating
executables (as specified in @filepath{info.rkt} files; see
executables or installing @tt{man} pages (as specified in
@filepath{info.rkt}; see @secref["setup-info"].}
@item{@DFlag{no-foreign-libs} --- refrain from installing foreign
libraries (as specified in @filepath{info.rkt}; see
@secref["setup-info"]).}
@item{@DFlag{no-install} or @Flag{i} --- refrain from running
@ -459,6 +465,26 @@ Optional @filepath{info.rkt} fields trigger additional actions by
@racket[mred-launcher-flags] --- Backward-compatible variant of
@racket[gracket-launcher-names], etc.}
@item{@indexed-racket[copy-foreign-libs] : @racket[(listof (and/c
path-string? relative-path?))] --- Files to copy into a
directory where foreign libraries are found by @racket[ffi-lib].}
@item{@indexed-racket[move-foreign-libs] : @racket[(listof (and/c
path-string? relative-path?))] --- Like @racket[copy-foreign-libs],
but the original file is removed after it is copied (which makes sense
for precompiled packages).}
@item{@indexed-racket[copy-man-pages] : @racket[(listof (and/c
path-string? relative-path? filename-extension))] --- Files to copy
into a @tt{man} directory. The file suffix determines its category;
for example, @litchar{.1} should be used for a @tt{man} page
describing an executable.}
@item{@indexed-racket[move-man-pages] : @racket[(listof (and/c
path-string? relative-path? filename-extension))] --- Like
@racket[copy-man-pages], but the original file is removed after it
is copied (which makes sense for precompiled packages).}
@item{@indexed-racket[install-collection] : @racket[path-string?] --- A
library module relative to the collection that provides
@racket[installer]. The @racket[installer] procedure accepts either
@ -663,7 +689,7 @@ form.}
@filepath{.so}/@filepath{.dll}/@filepath{.dylib} files in the
specified collections. @defaults[@racket[#f]]}
@defparam[compile-mode path (or/c path? false/c)]{
@defparam[compile-mode path (or/c path? #f)]{
If a @racket[path] is given, use a @filepath{.zo} compiler other than plain
@exec{compile}, and build to @racket[(build-path "compiled" (compile-mode))].
@defaults[@racket[#f]]}
@ -676,7 +702,10 @@ form.}
collection path. @defaults[@racket[#t]]}
@defboolparam[make-launchers on?]{
If on, make collection @filepath{info.rkt}-specified launchers. @defaults[@racket[#t]]}
If on, make collection @filepath{info.rkt}-specified launchers and @tt{man} pages. @defaults[@racket[#t]]}
@defboolparam[make-foreign-lib on?]{
If on, install collection @filepath{info.rkt}-specified libraries. @defaults[@racket[#t]]}
@defboolparam[make-docs on?]{
If on, build documentation.
@ -697,6 +726,12 @@ form.}
If on, avoid building bytecode in the main installation tree when building
other bytecode (e.g., in a user-specific collection). @defaults[@racket[#f]]}
@defboolparam[make-tidy on?]{
If on, remove metadata cache information and
documentation for non-existent collections (to clean up after removal)
even when @racket[specific-collections] or @racket[specific-planet-dirs]
is non-@racket['()] or @racket[make-only] is true. @defaults[@racket[#f]]}
@defboolparam[call-install on?]{
If on, call collection @filepath{info.rkt}-specified setup code.
@defaults[@racket[#t]]}
@ -733,6 +768,10 @@ form.}
is also @racket['()]. @defaults[@racket['()]]
}
@defboolparam[make-only on?]{
If true, set up no collections if @racket[specific-collections]
and @racket[specific-planet-dirs] are both @racket['()].}
@defparam[archives arch (listof path-string?)]{
A list of @filepath{.plt} archives to unpack; any collections specified
by the archives are set-up in addition to the collections listed in
@ -779,7 +818,7 @@ interface.
@defproc[(run-single-installer
(file path-string?)
(get-dir-proc (-> (or/c path-string? false/c)))) void?]{
(get-dir-proc (-> (or/c path-string? #f)))) void?]{
Creates a separate thread and namespace, runs the installer in that
thread with the new namespace, and returns when the thread
completes or dies. It also creates a custodian
@ -860,7 +899,7 @@ v
}
@defproc[(run-single-installer (file path-string?)
(get-dir-proc (-> (or/c path-string? false/c))))
(get-dir-proc (-> (or/c path-string? #f))))
void?]{
The same as the export from @racketmodname[setup/plt-single-installer],
but with a GUI.}
@ -890,7 +929,7 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
The @racketmodname[setup/dirs] library provides several procedures for locating
installation directories:}
@defproc[(find-collects-dir) (or/c path? false/c)]{
@defproc[(find-collects-dir) (or/c path? #f)]{
Returns a path to the installation's main @filepath{collects} directory, or
@racket[#f] if none can be found. A @racket[#f] result is likely only
in a stand-alone executable that is distributed without libraries.}
@ -904,7 +943,7 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
which means that this result is not sensitive to the value of the
@racket[use-user-specific-search-paths] parameter.}
@defproc[(find-doc-dir) (or/c path? false/c)]{
@defproc[(find-doc-dir) (or/c path? #f)]{
Returns a path to the installation's @filepath{doc} directory.
The result is @racket[#f] if no such directory is available.}
@ -920,12 +959,12 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
included only if the value of the @racket[use-user-specific-search-paths]
parameter is @racket[#t].}
@defproc[(find-lib-dir) (or/c path? false/c)]{
@defproc[(find-lib-dir) (or/c path? #f)]{
Returns a path to the installation's @filepath{lib} directory, which contains
libraries and other build information. The result is @racket[#f] if no such
directory is available.}
@defproc[(find-dll-dir) (or/c path? false/c)]{
@defproc[(find-dll-dir) (or/c path? #f)]{
Returns a path to the directory that contains DLLs for use with the
current executable (e.g., @filepath{libmzsch.dll} on Windows).
The result is @racket[#f] if no such directory is available, or if no
@ -944,7 +983,7 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
value of the @racket[use-user-specific-search-paths] parameter
is @racket[#t].}
@defproc[(find-include-dir) (or/c path? false/c)]{
@defproc[(find-include-dir) (or/c path? #f)]{
Returns a path to the installation's @filepath{include} directory, which
contains @filepath{.h} files for building Racket extensions and embedding
programs. The result is @racket[#f] if no such directory is available.}
@ -960,12 +999,12 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
latter is included only if the value of the
@racket[use-user-specific-search-paths] parameter is @racket[#t].}
@defproc[(find-console-bin-dir) (or/c path? false/c)]{
@defproc[(find-console-bin-dir) (or/c path? #f)]{
Returns a path to the installation's executable directory, where the
stand-alone Racket executable resides. The result is @racket[#f] if no
such directory is available.}
@defproc[(find-gui-bin-dir) (or/c path? false/c)]{
@defproc[(find-gui-bin-dir) (or/c path? #f)]{
Returns a path to the installation's executable directory, where the
stand-alone GRacket executable resides. The result is @racket[#f] if no such
directory is available.}
@ -979,6 +1018,14 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
programs; the directory indicated by the returned path may or may
not exist.}
@defproc[(find-man-dir) (or/c path? #f)]{
Returns a path to the installation's man-page directory. The result is
@racket[#f] if no such directory exists.}
@defproc[(find-user-man-dir) path?]{
Returns a path to the user's man-page directory; the directory
indicated by the returned path may or may not exist.}
@defthing[absolute-installation? boolean?]{
A binary boolean flag that is true if this installation is using
absolute path names.}
@ -995,7 +1042,7 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
[#:namespace namespace (or/c namespace? #f) #f])
(or/c
(symbol? [(-> any)] . -> . any)
false/c)]{
#f)]{
Accepts a list of strings naming a collection or sub-collection,
and calls @racket[get-info/full] with the full path corresponding to the
named collection and the @racket[namespace] argument.}
@ -1004,7 +1051,7 @@ Imports @racket[mred^] and exports @racket[setup:plt-installer^]. }
[#:namespace namespace (or/c namespace? #f) #f])
(or/c
(symbol? [(-> any)] . -> . any)
false/c)]{
#f)]{
Accepts a path to a directory. If it finds either a well-formed
an @filepath{info.rkt} file or an @filepath{info.ss} file (with

3
collects/setup/configtab.rkt
View File

@ -18,7 +18,8 @@
lib-search-dirs
include-dir
include-search-dirs
bin-dir))
bin-dir
man-dir))
(define-for-syntax string-exports
'(cgc-suffix
3m-suffix))

9
collects/setup/dirs.rkt
View File

@ -122,6 +122,15 @@
get-lib-search-dirs find-dll-dir
"lib")
;; ----------------------------------------
;; "man"
(define-finder provide
config:man-dir
find-man-dir
find-user-man-dir
"man")
;; ----------------------------------------
;; Executables

1
collects/setup/option-sig.rkt
View File

@ -14,6 +14,7 @@
make-only
make-zo
make-info-domain
make-foreign-libs
make-launchers
make-docs
make-user

1
collects/setup/option-unit.rkt
View File

@ -39,6 +39,7 @@
(define-flag-param make-only #f)
(define-flag-param make-zo #t)
(define-flag-param make-launchers #t)
(define-flag-param make-foreign-libs #t)
(define-flag-param make-info-domain #t)
(define-flag-param make-docs #t)
(define-flag-param make-user #t)

2
collects/setup/setup-cmdline.rkt
View File

@ -60,6 +60,8 @@
(add-flags '((trust-existing-zos #t)))]
[("-x" "--no-launcher") "Do not produce launcher programs"
(add-flags '((make-launchers #f)))]
[("--no-foreign-libs") "Do not install foreign libraries"
(add-flags '((make-foreign-libs #f)))]
[("-i" "--no-install") "Do not call collection-specific pre-installers"
(add-flags '((call-install #f)))]
[("-I" "--no-post-install") "Do not call collection-specific post-installers"

189
collects/setup/setup-unit.rkt
View File

@ -101,6 +101,10 @@
(make-path->relative-string
(list (cons find-gui-bin-dir "<gui-bin>/"))))
(define path->relative-string/lib
(make-path->relative-string
(list (cons find-lib-dir "<lib>/"))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Errors ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1213,13 +1217,13 @@
make-mzscheme-launcher
mzscheme-launcher-up-to-date?))))))
(define (read-launchers receipt-path)
(define (read-receipt-hash receipt-path)
(if (file-exists? receipt-path)
(with-handlers ([exn:fail?
(lambda (exn)
(setup-printf
"WARNING"
"error reading launcher list ~s: ~a"
"error reading receipts ~s: ~a"
receipt-path
(exn-message exn))
#hash())])
@ -1232,14 +1236,14 @@
(error "content is not a hash table")))))
#hash()))
(define (write-launchers receipt-path ht)
(define (write-receipt-hash receipt-path ht)
(call-with-output-file*
#:exists 'truncate/replace
receipt-path
(lambda (o) (write ht o))))
(lambda (o) (write ht o) (newline o))))
(define (record-launcher receipt-path name kind variant coll coll-path)
(let ([ht (read-launchers receipt-path)])
(let ([ht (read-receipt-hash receipt-path)])
(define coll-rel (let ([p (path->main-collects-relative coll-path)])
(if (path? p)
(path->bytes p)
@ -1251,11 +1255,11 @@
(unless (equal? (hash-ref ht exe-key #f)
exe-val)
(let ([ht (hash-set ht exe-key exe-val)])
(write-launchers receipt-path ht)))))
(write-receipt-hash receipt-path ht)))))
(define (tidy-launchers user? bin-dir gui-bin-dir lib-dir)
(define receipt-path (build-path lib-dir "launchers.rktd"))
(define ht (read-launchers receipt-path))
(define ht (read-receipt-hash receipt-path))
(define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)])
(define coll-path (main-collects-relative->path (cdr v)))
(cond
@ -1295,7 +1299,171 @@
ht])))
(unless (equal? ht ht2)
(setup-printf "updating" "launcher list")
(write-launchers receipt-path ht2)))
(write-receipt-hash receipt-path ht2)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Foriegn Libraries and Man Pages ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-copy/move-step what
whats
what/title
copy-tag
move-tag
find-target-dir
find-user-target-dir
receipt-file
check-entry
build-dest-path)
(define (make-libs-step)
(setup-printf #f (format "--- installing ~a ---" whats))
(when (or no-specific-collections?
(make-tidy))
(unless (avoid-main-installation)
(tidy-libs #f
(find-target-dir)
(find-lib-dir)))
(when (make-user)
(tidy-libs #t
(find-user-target-dir)
(find-user-lib-dir))))
(for ([cc ccs-to-compile])
(begin-record-error cc what/title
(define info (cc-info cc))
(define copy-libs
(call-info info copy-tag (lambda () null) check-entry))
(define move-libs
(call-info info move-tag (lambda () null) check-entry))
(unless (and (null? copy-libs)
(null? move-libs))
(define dir (if (cc-main? cc)
(find-target-dir)
(find-user-target-dir)))
(define r-dir (if (cc-main? cc)
(find-lib-dir)
(find-user-lib-dir)))
(define receipt-path (build-path r-dir receipt-file))
(make-directory* dir)
(make-directory* r-dir)
(define (copy-lib lib [check (lambda (s d) #t)])
(define src (path->complete-path lib (cc-path cc)))
(define lib-name (file-name-from-path lib))
(define dest (build-dest-path dir lib-name))
(when (check src dest)
(unless (and (file-exists? dest)
(same-content? src dest))
(setup-printf "installing" (string-append what " ~a")
(path->relative-string/lib dest))
(record-lib receipt-path lib-name (cc-collection cc) (cc-path cc))
(when (file-exists? dest) (delete-file dest))
(copy-file src dest)))
src)
(for ([lib (in-list copy-libs)])
(copy-lib lib))
(for ([lib (in-list move-libs)])
(define src
(copy-lib lib
(lambda (src dest)
(or (not (file-exists? dest))
(file-exists? src)))))
(when (file-exists? src)
(delete-file src)))))))
(define (same-content? a b)
(call-with-input-file*
a
(lambda (a)
(call-with-input-file*
b
(lambda (b)
(define as (make-bytes 4096))
(define bs (make-bytes 4096))
(let loop ()
(define an (read-bytes! as a))
(define bn (read-bytes! bs a))
(and (equal? an bn)
(equal? as bs)
(or (eof-object? an)
(loop)))))))))
(define (record-lib receipt-path name coll coll-path)
(let ([ht (read-receipt-hash receipt-path)])
(define coll-rel (let ([p (path->main-collects-relative coll-path)])
(if (path? p)
(path->bytes p)
p)))
(define lib-key (path-element->bytes name))
(define lib-val (cons (map path->string coll) coll-rel))
(unless (equal? (hash-ref ht lib-key #f)
lib-val)
(let ([ht (hash-set ht lib-key lib-val)])
(write-receipt-hash receipt-path ht)))))
(define (tidy-libs user? target-dir lib-dir)
(define receipt-path (build-path lib-dir receipt-file))
(define ht (read-receipt-hash receipt-path))
(define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)])
(define coll-path (main-collects-relative->path (cdr v)))
(cond
[(and (directory-exists? coll-path)
;; Collection path must match collection resolution:
(with-handlers ([exn:fail? (lambda (exn) #f)])
(equal? coll-path (apply collection-path (car v)))))
;; keep the lib
(hash-set ht k v)]
[else
;; remove the lib
(define lib-path (build-dest-path target-dir (bytes->path-element k)))
(when (file-exists? lib-path)
(setup-printf "deleting" (string-append what " ~a")
(path->relative-string/lib lib-path))
(delete-file lib-path))
ht])))
(unless (equal? ht ht2)
(setup-printf "updating" (format "~a list" what))
(write-receipt-hash receipt-path ht2)))
make-libs-step)
(define make-foreign-libs-step
(make-copy/move-step "foreign library"
"foreign libraries"
"Foreign Library Setup"
'copy-foreign-libs
'move-foreign-libs
find-lib-dir
find-user-lib-dir
"libs.rktd"
(lambda (l)
(unless (list-of relative-path-string? l)
(error "entry is not a list of relative path strings:" l)))
build-path))
(define make-mans-step
(make-copy/move-step "man page"
"man pages"
"Man Page Setup"
'copy-man-pages
'move-man-pages
find-man-dir
find-user-man-dir
"mans.rktd"
(lambda (l)
(unless (list-of (lambda (p)
(and (relative-path-string? p)
(filename-extension p)))
l)
(error
"entry is not a list of relative path strings,each with a non-empty extension:"
l)))
(lambda (d n)
(build-path d
(bytes->path-element (bytes-append #"man" (filename-extension n)))
n))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; setup-unit Body ;;
@ -1318,10 +1486,15 @@
(do-install-part 'pre)
(when (make-foreign-libs) (make-foreign-libs-step))
(when (make-zo) (make-zo-step))
(when (make-info-domain) (make-info-domain-step))
(when (make-launchers) (make-launchers-step))
(when (make-launchers)
(unless (eq? 'windows (system-type))
(make-mans-step)))
(when make-docs?
(make-docs-step))

1
collects/setup/unixstyle-install.rkt
View File

@ -297,6 +297,7 @@
(printf " (define lib-dir ~s)\n" (dir: 'librkt))
(printf " (define include-dir ~s)\n" (dir: 'includerkt))
(printf " (define bin-dir ~s)\n" (dir: 'bin))
(printf " (define man-dir ~s)\n" (dir: 'man))
(printf " (define absolute-installation? #t))\n")))
;; recompile & set times as if nothing happened (don't remove .dep)
;; this requires the file to look the same on all compilations, and