From 8820ae91a6423c8f02cc3da3754c97f597303403 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 19 Jul 2013 09:51:14 -0600 Subject: [PATCH] distro-build: add support for source installers --- Makefile | 13 +++-- pkgs/distro-build/config.rkt | 2 + pkgs/distro-build/doc.txt | 8 +++ pkgs/distro-build/drive-clients.rkt | 7 ++- pkgs/distro-build/installer-sh.rkt | 1 - pkgs/distro-build/installer-tgz.rkt | 35 ++++++++++++ pkgs/distro-build/installer.rkt | 14 +++-- .../racket-doc/file/scribblings/tar.scrbl | 20 ++++--- racket/collects/file/tar.rkt | 25 ++++++--- racket/collects/racket/HISTORY.txt | 5 ++ racket/collects/setup/unixstyle-install.rkt | 53 ++++++++++++++----- 11 files changed, 146 insertions(+), 37 deletions(-) create mode 100644 pkgs/distro-build/installer-tgz.rkt diff --git a/Makefile b/Makefile index b0fdc2f872..f4214d1600 100644 --- a/Makefile +++ b/Makefile @@ -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) diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt index 3f8c800e0c..2e5b0b6c01 100644 --- a/pkgs/distro-build/config.rkt +++ b/pkgs/distro-build/config.rkt @@ -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)] diff --git a/pkgs/distro-build/doc.txt b/pkgs/distro-build/doc.txt index 143a8a2aee..5badd9dd84 100644 --- a/pkgs/distro-build/doc.txt +++ b/pkgs/distro-build/doc.txt @@ -199,6 +199,14 @@ Site-configuration keywords (where means no spaces, etc.): unless `#:host' is "localhost", `#:user' is #f, and `#:dir' is not specified, in which case the default is #f + #:release? --- if true, then create release-mode + installers; the default is determined by the `RELEASE_MODE' + makefile variable + + #:source? --- if true, then create a source archive (with + pre-build packages), instead of a platform-specific installer; the + default is #f + #:site-dest --- destination for completed build, used by the `site' and `snapshot-site' makefile targets; the default is "build/site" diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt index f17363b20c..5b32a050c7 100644 --- a/pkgs/distro-build/drive-clients.rkt +++ b/pkgs/distro-build/drive-clients.rkt @@ -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) diff --git a/pkgs/distro-build/installer-sh.rkt b/pkgs/distro-build/installer-sh.rkt index d52a466168..5bec2708b2 100644 --- a/pkgs/distro-build/installer-sh.rkt +++ b/pkgs/distro-build/installer-sh.rkt @@ -85,4 +85,3 @@ release? readme) sh-path) - diff --git a/pkgs/distro-build/installer-tgz.rkt b/pkgs/distro-build/installer-tgz.rkt new file mode 100644 index 0000000000..5e813e70a3 --- /dev/null +++ b/pkgs/distro-build/installer-tgz.rkt @@ -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) diff --git a/pkgs/distro-build/installer.rkt b/pkgs/distro-build/installer.rkt index e0d1ea34d4..bbd351d9ff 100644 --- a/pkgs/distro-build/installer.rkt +++ b/pkgs/distro-build/installer.rkt @@ -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") diff --git a/pkgs/racket-pkgs/racket-doc/file/scribblings/tar.scrbl b/pkgs/racket-pkgs/racket-doc/file/scribblings/tar.scrbl index 03396eb055..eb1f57c370 100644 --- a/pkgs/racket-pkgs/racket-doc/file/scribblings/tar.scrbl +++ b/pkgs/racket-pkgs/racket-doc/file/scribblings/tar.scrbl @@ -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]. diff --git a/racket/collects/file/tar.rkt b/racket/collects/file/tar.rkt index 3f1e143358..ff41e12e51 100644 --- a/racket/collects/file/tar.rkt +++ b/racket/collects/file/tar.rkt @@ -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) diff --git a/racket/collects/racket/HISTORY.txt b/racket/collects/racket/HISTORY.txt index c01824a30b..647babb12b 100644 --- a/racket/collects/racket/HISTORY.txt +++ b/racket/collects/racket/HISTORY.txt @@ -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 diff --git a/racket/collects/setup/unixstyle-install.rkt b/racket/collects/setup/unixstyle-install.rkt index 1869f875e0..aeb521effc 100644 --- a/racket/collects/setup/unixstyle-install.rkt +++ b/racket/collects/setup/unixstyle-install.rkt @@ -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))]))