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

distro-build: add support for source installers

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-19 09:51:14 -06:00
parent 67a9889ef7
commit 8820ae91a6
11 changed files with 146 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Makefile
View File

@ -118,6 +118,9 @@ SERVER = localhost
# snapshot installers):
RELEASE_MODE =
# Set to "--source" to create a source "installer":
SOURCE_MODE =
# Human-readable name (spaces allowed), installation name base, and
# Unix installation directory name for the generated installers:
DIST_NAME = Racket
@ -327,7 +330,8 @@ client:
$(MAKE) bundle-config
$(MAKE) installer-from-bundle
COPY_ARGS = SERVER=$(SERVER) PKGS="$(PKGS)" RELEASE_MODE=$(RELEASE_MODE) \
COPY_ARGS = SERVER=$(SERVER) PKGS="$(PKGS)" \
RELEASE_MODE=$(RELEASE_MODE) SOURCE_MODE=$(SOURCE_MODE) \
DIST_NAME="$(DIST_NAME)" DIST_BASE=$(DIST_BASE) \
DIST_DIR=$(DIST_DIR) DIST_SUFFIX=$(DIST_SUFFIX) \
DIST_DESC="$(DIST_DESC)" README="$(README)" \
@ -356,12 +360,13 @@ bundle-from-server:
$(RACKET) -l setup/unixstyle-install bundle racket bundle/racket
$(RACKET) -l distro-build/unpack-collects http://$(SERVER):9440/
bundle/racket/bin/raco pkg install $(REMOTE_INST_AUTO) $(PKGS) $(REQUIRED_PKGS)
$(RACKET) -l setup/unixstyle-install post-adjust$(SOURCE_MODE) racket bundle/racket
bundle-config:
$(RACKET) -l distro-build/set-config $(BUNDLE_CONFIG) "" "" "$(DOC_SEARCH)" $(DIST_CATALOGS_q)
UPLOAD_q = --readme http://$(SERVER):9440/$(README) --upload http://$(SERVER):9440/ --desc "$(DIST_DESC)"
DIST_ARGS_q = $(UPLOAD_q) $(RELEASE_MODE) "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR) "$(DIST_SUFFIX)"
DIST_ARGS_q = $(UPLOAD_q) $(RELEASE_MODE) $(SOURCE_MODE) "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR) "$(DIST_SUFFIX)"
# Create an installer from the build (with installed packages) that's
# in "bundle/racket":
@ -374,7 +379,7 @@ win32-distro-build-from-server:
win32-bundle:
IF EXIST bundle cmd /c rmdir /S /Q bundle
cmd /c mkdir bundle\racket
$(WIN32_RACKET) -l setup/unixstyle-install bundle racket bundle\racket
$(WIN32_RACKET) -l setup/unixstyle-install bundle$(SOURCE_MODE) racket bundle\racket
$(WIN32_RACKET) -l setup/winstrip bundle\racket
$(WIN32_RACKET) -l setup/winvers-change bundle\racket
@ -390,7 +395,7 @@ win32-installer-from-bundle:
# ------------------------------------------------------------
# Drive installer build across server and clients:
DRIVE_ARGS_q = $(RELEASE_MODE) $(CLEAN_MODE) "$(CONFIG)" "$(CONFIG_MODE)" \
DRIVE_ARGS_q = $(RELEASE_MODE) $(SOURCE_MODE) $(CLEAN_MODE) "$(CONFIG)" "$(CONFIG_MODE)" \
$(SERVER) "$(PKGS)" "$(DOC_SEARCH)" "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR)
DRIVE_CMD_q = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS_q)

2
pkgs/distro-build/config.rkt
View File

@ -136,6 +136,8 @@
[(#:repo) (string? val)]
[(#:clean?) (boolean? val)]
[(#:pull?) (boolean? val)]
[(#:release?) (boolean? val)]
[(#:source?) (boolean? val)]
[(#:site-dest) (path-string? val)]
[(#:pdf-doc?) (boolean? val)]
[(#:max-snapshots) (real? val)]

8
pkgs/distro-build/doc.txt
View File

@ -199,6 +199,14 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
unless `#:host' is "localhost", `#:user' is #f, and `#:dir' is not
specified, in which case the default is #f
#:release? <boolean> --- if true, then create release-mode
installers; the default is determined by the `RELEASE_MODE'
makefile variable
#:source? <boolean> --- if true, then create a source archive (with
pre-build packages), instead of a platform-specific installer; the
default is #f
#:site-dest <path-string> --- destination for completed build, used
by the `site' and `snapshot-site' makefile targets; the default is
"build/site"

7
pkgs/distro-build/drive-clients.rkt
View File

@ -18,7 +18,7 @@
;; ----------------------------------------
(define release? #f)
(define default-release? #f)
(define default-clean? #f)
(define-values (config-file config-mode
@ -27,7 +27,7 @@
(command-line
#:once-each
[("--release") "Create release-mode installers"
(set! release? #t)]
(set! default-release? #t)]
[("--clean") "Erase client directories before building"
(set! default-clean? #t)]
#:args (config-file config-mode
@ -237,6 +237,8 @@
default-dist-dir))
(define dist-suffix (get-opt c '#:dist-suffix ""))
(define dist-catalogs (choose-catalogs c '("")))
(define release? (get-opt c '#:release? default-release?))
(define source? (get-opt c '#:source? #f))
(~a " SERVER=" server
" PKGS=" (q pkgs)
" DOC_SEARCH=" (q doc-search)
@ -247,6 +249,7 @@
" DIST_SUFFIX=" (q dist-suffix)
" DIST_CATALOGS_q=" (qq dist-catalogs kind)
" RELEASE_MODE=" (if release? "--release" (q ""))
" SOURCE_MODE=" (if source? "--source" (q ""))
" README=" (q (file-name-from-path readme))))
(define (unix-build c host port user server repo clean? pull? readme)

1
pkgs/distro-build/installer-sh.rkt
View File

@ -85,4 +85,3 @@
release?
readme)
sh-path)

35
pkgs/distro-build/installer-tgz.rkt Normal file
View File

@ -0,0 +1,35 @@
#lang at-exp racket/base
(require racket/system
racket/file
racket/format
file/tar)
(provide installer-tgz)
(define (system/show . l)
(displayln (apply ~a #:separator " " l))
(unless (apply system* (find-executable-path (car l)) (cdr l))
(error "failed")))
(define (generate-tgz src-dir dest-path target-dir-name readme)
(system/show "chmod" "-R" "g+w" src-dir)
(define dest (path->complete-path dest-path))
(when (file-exists? dest) (delete-file dest))
(printf "Tarring to ~s\n" dest)
(when readme
(call-with-output-file*
(build-path src-dir "README")
#:exists 'truncate
(lambda (o)
(display readme o))))
(parameterize ([current-directory src-dir])
(apply tar-gzip dest #:path-prefix target-dir-name (directory-list))))
(define (installer-tgz base-name dir-name dist-suffix readme)
(define tgz-path (format "bundle/~a-src~a.tgz"
base-name
dist-suffix))
(generate-tgz "bundle/racket" tgz-path
dir-name
readme)
tgz-path)

14
pkgs/distro-build/installer.rkt
View File

@ -3,6 +3,7 @@
"installer-sh.rkt"
"installer-dmg.rkt"
"installer-exe.rkt"
"installer-tgz.rkt"
net/url
racket/file
racket/path
@ -10,6 +11,7 @@
"display-time.rkt")
(define release? #f)
(define source? #f)
(define upload-to #f)
(define upload-desc "")
(define download-readme #f)
@ -19,6 +21,8 @@
#:once-each
[("--release") "Create a release installer"
(set! release? #t)]
[("--source") "Create a source installer"
(set! source? #t)]
[("--upload") url "Upload installer"
(set! upload-to url)]
[("--desc") desc "Description to accompany upload"
@ -49,10 +53,12 @@
(close-input-port i)))))
(define installer-file
(case (system-type)
[(unix) (installer-sh human-name base-name dir-name release? dist-suffix readme)]
[(macosx) (installer-dmg human-name base-name dist-suffix readme)]
[(windows) (installer-exe short-human-name base-name release? dist-suffix readme)]))
(if source?
(installer-tgz base-name dir-name dist-suffix readme)
(case (system-type)
[(unix) (installer-sh human-name base-name dir-name release? dist-suffix readme)]
[(macosx) (installer-dmg human-name base-name dist-suffix readme)]
[(windows) (installer-exe short-human-name base-name release? dist-suffix readme)])))
(call-with-output-file*
(build-path "bundle" "installer.txt")

20
pkgs/racket-pkgs/racket-doc/file/scribblings/tar.scrbl
View File

@ -14,28 +14,36 @@ is always ``root.''
Symbolic links (on Unix and Mac OS X) are not followed, and the path
in a link must be less than 100 bytes.}
@defproc[(tar [tar-file path-string?][path path-string?] ...)
@defproc[(tar [tar-file path-string?]
[path path-string?] ...
[#:path-prefix path-prefix (or/c #f path-string?) #f])
exact-nonnegative-integer?]{
Creates @racket[tar-file], which holds the complete content of all
@racket[path]s. The given @racket[path]s are all expected to be
relative path names of existing directories and files (i.e., relative
relative paths for existing directories and files (i.e., relative
to the current directory). If a nested path is provided as a
@racket[path], its ancestor directories are also added to the
resulting tar file, up to the current directory (using
@racket[pathlist-closure]).}
@racket[pathlist-closure]).
If @racket[path-prefix] is not @racket[#f], then it is prefixed to
each path in the archive.}
@defproc[(tar->output [paths (listof path?)]
[out output-port? (current-output-port)])
[out output-port? (current-output-port)]
[#:path-prefix path-prefix (or/c #f path-string?) #f])
exact-nonnegative-integer?]{
Packages each of the given @racket[paths] in a @exec{tar} format
archive that is written directly to the @racket[out]. The specified
@racket[paths] are included as-is; if a directory is specified, its
@racket[paths] are included as-is (except for adding @racket[path-prefix], if any); if a directory is specified, its
content is not automatically added, and nested directories are added
without parent directories.}
@defproc[(tar-gzip [tar-file path-string?] [paths path-string?] ...)
@defproc[(tar-gzip [tar-file path-string?]
[paths path-string?] ...
[#:path-prefix path-prefix (or/c #f path-string?) #f])
void?]{
Like @racket[tar], but compresses the resulting file with @racket[gzip].

25
racket/collects/file/tar.rkt
View File

@ -43,14 +43,16 @@
(define 0-byte (char->integer #\0))
(define ((tar-one-entry buf) path)
(define ((tar-one-entry buf prefix) path)
(let* ([link? (link-exists? path)]
[dir? (and (not link?) (directory-exists? path))]
[size (if (or dir? link?) 0 (file-size path))]
[p 0] ; write pointer
[cksum 0]
[cksum-p #f])
(define-values (file-name file-prefix) (split-tar-name path))
(define-values (file-name file-prefix) (split-tar-name (if prefix
(build-path prefix path)
path)))
(define-syntax advance (syntax-rules () [(_ l) (set! p (+ p l))]))
(define (write-block* len bts) ; no padding required
(when bts
@ -127,29 +129,36 @@
;; tar-write : (listof relative-path) ->
;; writes a tar file to current-output-port
(provide tar->output)
(define (tar->output files [out (current-output-port)])
(define (tar->output files [out (current-output-port)]
#:path-prefix [prefix #f])
(parameterize ([current-output-port out])
(let* ([buf (new-block)] [entry (tar-one-entry buf)])
(let* ([buf (new-block)] [entry (tar-one-entry buf prefix)])
(for-each entry files)
;; two null blocks end-marker
(write-bytes buf) (write-bytes buf))))
;; tar : output-file paths ->
(provide tar)
(define (tar tar-file . paths)
(define (tar tar-file
#:path-prefix [prefix #f]
. paths)
(when (null? paths) (error 'tar "no paths specified"))
(with-output-to-file tar-file
(lambda () (tar->output (pathlist-closure paths #:follow-links? #f)))))
(lambda () (tar->output (pathlist-closure paths #:follow-links? #f)
#:path-prefix prefix))))
;; tar-gzip : output-file paths ->
(provide tar-gzip)
(define (tar-gzip tgz-file . paths)
(define (tar-gzip tgz-file
#:path-prefix [prefix #f]
. paths)
(when (null? paths) (error 'tar-gzip "no paths specified"))
(with-output-to-file tgz-file
(lambda ()
(let-values ([(i o) (make-pipe)])
(thread (lambda ()
(tar->output (pathlist-closure paths #:follow-links? #f) o)
(tar->output (pathlist-closure paths #:follow-links? #f) o
#:path-prefix prefix)
(close-output-port o)))
(gzip-through-ports
i (current-output-port)

5
racket/collects/racket/HISTORY.txt
View File

@ -1,3 +1,8 @@
Version 5.90.0.1
Added "share" directory, moved "pkgs" there; moved "collects"
back out of "lib"
setup/dirs: added find-share-dir, find-user-share-dir
Version 5.3.900.7
Changed equal? to work on module path index values
Added 'fs-change mode to system-type

53
racket/collects/setup/unixstyle-install.rkt
View File

@ -12,8 +12,10 @@
;; (interactive, undo-on-error, create-uninstaller)
;; - `copy': similar to `move', but copies instead of moving
;; - `bundle': like `copy', but no uninstall script
;; - `post-adjust': adjust an existing bundle after package installs
;; - `post-adjust--source': (really two dashes), like `post-adjust', but for source
;; - `make-install-copytree': copies some toplevel directories, skips ".*"
;; and "compiled" subdirs, and rewrites "config.rkt", but no uninstaller
;; subdirs, and rewrites "config.rkt", but no uninstaller
;; (used by `make install') (requires an additional `origtree' argument)
;; - `make-install-destdir-fix': fixes paths in binaries, laucnhers, and
;; config.rkt (used by `make install' to fix a DESTDIR) (requires exactly
@ -300,10 +302,19 @@
(and (file-exists? file) (file-or-directory-modify-seconds file)))
(let* ([src (cpath "config.rktd")])
(printf "Rewriting configuration file at: ~a...\n" src)
(define old (or (and (file-exists? src)
(call-with-input-file src read))
(hash)))
(define (preserve key)
(define val (hash-ref old key #f))
(when val
(printf " (~s . ~s)\n" key val)))
(with-output-to-file src #:exists 'truncate/replace
(lambda ()
(printf ";; automatically generated by unixstyle-install\n")
(printf "#hash(")
(preserve 'catalogs)
(preserve 'doc-search-url)
(printf "(doc-dir . ~s)\n" (dir: 'doc))
(when (eq? 'shared (system-type 'link)) ; never true for now
(printf " (dll-dir . ~s)\n" (dir: 'lib)))
@ -388,13 +399,13 @@
(with-handlers ([exn? (lambda (e) (undo-changes) (raise e))])
(define binfiles (if (directory-exists? "bin") (ls "bin") null)) ; see below
(if (eq? 'windows (system-type))
;; Windows executables appear in the immediate directory:
(for ([f (in-list (directory-list))])
(when (and (file-exists? f)
(regexp-match? #rx#"(?i:[.]exe)$" (path-element->bytes f)))
(cp* f (build-path base-destdir f))))
;; All other platforms use "bin":
(do-tree "bin" 'bin))
;; Windows executables appear in the immediate directory:
(for ([f (in-list (directory-list))])
(when (and (file-exists? f)
(regexp-match? #rx#"(?i:[.]exe)$" (path-element->bytes f)))
(cp* f (build-path base-destdir f))))
;; All other platforms use "bin":
(do-tree "bin" 'bin))
(do-tree "doc" 'doc #:missing 'skip) ; not included in text distros
(do-tree "lib" 'librkt)
(do-tree "include" 'includerkt)
@ -425,13 +436,14 @@
(define copytree (move/copy-tree #f))
(define origtree? (equal? "yes" (get-arg)))
(current-directory rktdir)
(set! skip-filter ; skip all dot-names and compiled subdirs
(lambda (p) (regexp-match? #rx"^(?:[.].*|compiled)$" (basename p))))
(set! skip-filter ; skip all dot-names
(lambda (p) (regexp-match? #rx"^(?:[.].*)$" (basename p))))
(with-handlers ([exn? (lambda (e) (undo-changes) (raise e))])
(set! yes-to-all? #t) ; non-interactive
(copytree "collects" 'collects)
(copytree "doc" 'doc)
(copytree "man" 'man)
(copytree "share" 'sharerkt #:missing 'skip)
(copytree "doc" 'doc #:missing 'skip)
(copytree "config" 'config #:missing 'skip)
(unless origtree? (write-config))))
(define (make-install-destdir-fix)
@ -457,6 +469,21 @@
(fix-executables bindir librktdir)
(unless origtree? (write-config configdir)))
(define (post-adjust-source)
(define do-tree (move/copy-tree #f))
(current-directory rktdir)
;; Copy source into place:
(set! skip-filter ; skip src/build
(lambda (p) (regexp-match? #rx"^build$" p)))
(do-tree "src" (build-path base-destdir "src"))
;; Remove directories that get re-created:
(define (remove! dst*) (rm (dir: dst*)))
(remove! 'bin)
(remove! 'lib)
(remove! 'man)
(remove! 'config) ; may be recreated by a later bundle step
(remove! 'includerkt))
;; --------------------------------------------------------------------------
(module+ main
@ -464,6 +491,8 @@
[(move) (move/copy-distribution #t #f)]
[(copy) (move/copy-distribution #f #f)]
[(bundle) (move/copy-distribution #f #t)]
[(post-adjust) (void)]
[(post-adjust--source) (post-adjust-source)]
[(make-install-copytree) (make-install-copytree)]
[(make-install-destdir-fix) (make-install-destdir-fix)]
[else (error (format "unknown operation: ~e" op))]))