commit 40083f37dfe3017a7e151d0fad75ae96bbd86575
parent d7f8b9b5461da7533b7294ff220998a3397fa46d
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 17 Jul 2013 16:07:16 -0600
distro-build: support for adding READMEs
This is a first cut; the default "README" configuration will be
improved.
original commit: 1c6257a129c94712f8f43bffc83e5ed33dda3dd4
Diffstat:
9 files changed, 172 insertions(+), 30 deletions(-)
diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt
@@ -139,6 +139,12 @@
[(#:site-dest) (path-string? val)]
[(#:pdf-doc?) (boolean? val)]
[(#:max-snapshots) (real? val)]
+ [(#:readme) (or (string? val)
+ (and (procedure? val)
+ (procedure-arity-includes? val 1)))]
+ [(#:custom) (and (hash? val)
+ (for/and ([k (in-hash-keys val)])
+ (keyword? k)))]
[else 'bad-keyword]))
(define (check-machine-keyword kw val)
diff --git a/pkgs/distro-build/doc.txt b/pkgs/distro-build/doc.txt
@@ -160,6 +160,11 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
`#:dist-base-url' (if present) extended with "catalogs" in a list
followed by ""
+ #:readme <string-or-procedure> --- the content of a "README" file
+ to include in installers, or a function that takes a hash table
+ for a configuration and returns a string; the default is the
+ `make-readme' function from `distro-build/readme'
+
#:max-vm <real> --- max number of VMs allowed to run with this
machine, counting the machine; defaults to 1
@@ -204,6 +209,13 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
#:max-snapshots <number> --- number of snapshots to keep, used by
the `snapshot-site' makefile target
+ #:custom <hash-table> --- a hash table mapping arbitrary keywords to
+ arbitrary values; when a value for `#:custom' is overriden in a
+ nested configuration, the new table is merged with the overriden
+ one; use such a table for additional configuration entries other
+ than the built-in ones, where additional entires may be useful to
+ a `#:readme' procedure
+
Machine-only keywords:
#:name <string> --- defaults to host; this string is recorded as a
diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt
@@ -5,12 +5,14 @@
racket/format
racket/file
racket/string
+ racket/path
(only-in "config.rkt"
current-mode
site-config?
site-config-tag site-config-options site-config-content)
"url-options.rkt"
- "display-time.rkt")
+ "display-time.rkt"
+ "readme.rkt")
;; See "config.rkt" for an overview.
@@ -47,16 +49,23 @@
(define (merge-options opts c)
(for/fold ([opts opts]) ([(k v) (in-hash (site-config-options c))])
- (hash-set opts k v)))
+ (if (eq? k '#:custom)
+ (hash-set opts
+ '#:custom
+ (let ([prev (hash-ref opts '#:custom (hash))])
+ (for/fold ([prev prev]) ([(k2 v2) (in-hash v)])
+ (hash-set prev k2 v2))))
+ (hash-set opts k v))))
(define (get-opt opts kw [default #f] #:localhost [localhost-default default])
- (hash-ref opts kw (cond
- [(equal? default localhost-default) default]
- [(and (equal? "localhost" (get-opt opts '#:host "localhost"))
- (equal? #f (get-opt opts '#:user #f))
- (equal? #f (get-opt opts '#:dir #f)))
- localhost-default]
- [else default])))
+ (hash-ref opts kw (lambda ()
+ (cond
+ [(equal? default localhost-default) default]
+ [(and (equal? "localhost" (get-opt opts '#:host "localhost"))
+ (equal? #f (get-opt opts '#:user #f))
+ (equal? #f (get-opt opts '#:dir #f)))
+ localhost-default]
+ [else default]))))
(define (get-content c)
(site-config-content c))
@@ -213,7 +222,7 @@
"\\\"")))
"\"")]))
-(define (client-args c server kind)
+(define (client-args c server kind readme)
(define desc (client-name c))
(define pkgs (let ([l (get-opt c '#:pkgs)])
(if l
@@ -237,9 +246,10 @@
" DIST_DIR=" dist-dir
" DIST_SUFFIX=" (q dist-suffix)
" DIST_CATALOGS_q=" (qq dist-catalogs kind)
- " RELEASE_MODE=" (if release? "--release" (q ""))))
+ " RELEASE_MODE=" (if release? "--release" (q ""))
+ " README=" (q (file-name-from-path readme))))
-(define (unix-build c host port user server repo clean? pull?)
+(define (unix-build c host port user server repo clean? pull? readme)
(define dir (get-path-opt c '#:dir "build/plt" #:localhost (current-directory)))
(define (sh . args)
(list "/bin/sh" "-c" (apply ~a args)))
@@ -257,11 +267,11 @@
"git pull"))
(sh "cd " (q dir) " ; "
"make -j " j " client"
- (client-args c server 'unix)
+ (client-args c server 'unix readme)
" JOB_OPTIONS=\"-j " j "\""
" CONFIGURE_ARGS_qq=" (qq (get-opt c '#:configure null) 'unix))))
-(define (windows-build c host port user server repo clean? pull?)
+(define (windows-build c host port user server repo clean? pull? readme)
(define dir (get-path-opt c '#:dir "build\\plt" #:localhost (current-directory)))
(define bits (or (get-opt c '#:bits) 64))
(define vc (or (get-opt c '#:vc)
@@ -285,7 +295,7 @@
" " vc
" && nmake win32-client"
" JOB_OPTIONS=\"-j " j "\""
- (client-args c server 'windows))))
+ (client-args c server 'windows readme))))
(define (client-build c)
(define host (or (get-opt c '#:host)
@@ -299,11 +309,34 @@
(~a "http://" server ":9440/.git")))
(define clean? (get-opt c '#:clean? default-clean? #:localhost #f))
(define pull? (get-opt c '#:pull? #t #:localhost #f))
+
+ (define readme-txt (let ([rdme (get-opt c '#:readme make-readme)])
+ (if (string? rdme)
+ rdme
+ (rdme c))))
+ (make-directory* (build-path "build" "readmes"))
+ (define readme (make-temporary-file
+ "README-~a"
+ #f
+ (build-path "build" "readmes")))
+ (call-with-output-file*
+ readme
+ #:exists 'truncate
+ (lambda (o)
+ (display readme-txt o)
+ (unless (regexp-match #rx"\n$" readme-txt)
+ ;; ensure a newline at the end:
+ (newline o))))
+
(display-time)
- ((case (or (get-opt c '#:platform) 'unix)
- [(unix) unix-build]
- [else windows-build])
- c host port user server repo clean? pull?))
+ (begin0
+
+ ((case (or (get-opt c '#:platform) 'unix)
+ [(unix) unix-build]
+ [else windows-build])
+ c host port user server repo clean? pull? readme)
+
+ (delete-file readme)))
;; ----------------------------------------
diff --git a/pkgs/distro-build/installer-dmg.rkt b/pkgs/distro-build/installer-dmg.rkt
@@ -18,7 +18,7 @@
(unless (apply system* l)
(error "failed")))
-(define (make-dmg volname src-dir dmg bg)
+(define (make-dmg volname src-dir dmg bg readme)
(define tmp-dmg (make-temporary-file "~a.dmg"))
(define work-dir
(let-values ([(base name dir?) (split-path src-dir)])
@@ -29,6 +29,12 @@
(printf "Copying ~a\n" src-dir)
(copy-directory/files src-dir (build-path work-dir volname)
#:keep-modify-seconds? #t)
+ (when readme
+ (call-with-output-file*
+ (build-path work-dir volname "README.txt")
+ #:exists 'truncate
+ (lambda (o)
+ (display readme o))))
(when bg
(copy-file bg (build-path work-dir ".bg.png")))
;; The following command should work fine, but it looks like hdiutil in 10.4
@@ -93,10 +99,10 @@
(when del?
(delete-directory mnt)))
-(define (installer-dmg human-name base-name dist-suffix)
+(define (installer-dmg human-name base-name dist-suffix readme)
(define dmg-name (format "bundle/~a-~a~a.dmg"
base-name
(system-library-subpath #f)
dist-suffix))
- (make-dmg human-name "bundle/racket" dmg-name bg-image)
+ (make-dmg human-name "bundle/racket" dmg-name bg-image readme)
dmg-name)
diff --git a/pkgs/distro-build/installer-exe.rkt b/pkgs/distro-build/installer-exe.rkt
@@ -397,7 +397,7 @@ SectionEnd
(parameterize ([current-directory "bundle"])
(system* makensis "/V3" "installer.nsi")))
-(define (installer-exe human-name base-name release? dist-suffix)
+(define (installer-exe human-name base-name release? dist-suffix readme)
(define makensis (or (find-executable-path "makensis.exe")
(try-exe "c:\\Program Files\\NSIS\\makensis.exe")
(try-exe "c:\\Program Files (x86)\\NSIS\\makensis.exe")
@@ -405,6 +405,13 @@ SectionEnd
(define platform (let-values ([(base name dir?) (split-path (system-library-subpath #f))])
(path->string name)))
(define exe-path (format "bundle/~a-~a-win32~a.exe" base-name platform dist-suffix))
+ (when readme
+ (call-with-output-file*
+ #:exists 'truncate
+ #:mode 'text
+ (build-path "bundle" "racket" "README.txt")
+ (lambda (o)
+ (display readme o))))
(nsis-generate exe-path
human-name
(version)
diff --git a/pkgs/distro-build/installer-sh.rkt b/pkgs/distro-build/installer-sh.rkt
@@ -27,12 +27,18 @@
(for/sum ([l (in-lines i)]) 1)
(call-with-input-file* i count-lines)))
-(define (generate-installer-sh src-dir dest target-dir-name human-name release?)
+(define (generate-installer-sh src-dir dest target-dir-name human-name release? readme)
(system/show "chmod"
"-R" "g+w" src-dir)
(define tmp-tgz (make-temporary-file "~a.tgz"))
(delete-file tmp-tgz)
(printf "Tarring to ~s\n" tmp-tgz)
+ (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 tmp-tgz (directory-list)))
(define tree-size (system/read "du" "-hs" src-dir))
@@ -69,13 +75,14 @@
(system/show "chmod" "+x" dest)
(delete-file tmp-tgz))
-(define (installer-sh human-name base-name dir-name release? dist-suffix)
+(define (installer-sh human-name base-name dir-name release? dist-suffix readme)
(define sh-path (format "bundle/~a-~a~a.sh"
base-name
(system-library-subpath #f)
dist-suffix))
(generate-installer-sh "bundle/racket" sh-path
dir-name human-name
- release?)
+ release?
+ readme)
sh-path)
diff --git a/pkgs/distro-build/installer.rkt b/pkgs/distro-build/installer.rkt
@@ -6,11 +6,13 @@
net/url
racket/file
racket/path
+ racket/port
"display-time.rkt")
(define release? #f)
(define upload-to #f)
(define upload-desc "")
+(define download-readme #f)
(define-values (short-human-name human-name base-name dir-name dist-suffix)
(command-line
@@ -21,6 +23,8 @@
(set! upload-to url)]
[("--desc") desc "Description to accompany upload"
(set! upload-desc desc)]
+ [("--readme") readme "URL for README.txt to include"
+ (set! download-readme readme)]
#:args
(human-name base-name dir-name dist-suffix)
(values human-name
@@ -35,11 +39,20 @@
(display-time)
+(define readme
+ (and download-readme
+ (let ()
+ (printf "Downloading ~a\n" download-readme)
+ (define i (get-pure-port (string->url download-readme)))
+ (begin0
+ (port->string i)
+ (close-input-port i)))))
+
(define installer-file
(case (system-type)
- [(unix) (installer-sh human-name base-name dir-name release? dist-suffix)]
- [(macosx) (installer-dmg human-name base-name dist-suffix)]
- [(windows) (installer-exe short-human-name base-name release? dist-suffix)]))
+ [(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/distro-build/readme.rkt b/pkgs/distro-build/readme.rkt
@@ -0,0 +1,45 @@
+#lang at-exp racket/base
+(require racket/format)
+
+(provide make-readme)
+
+(define (make-readme config)
+ @~a{
+ The Racket Programming Language
+ ===============================
+
+ This is Racket...
+
+ More Information
+ ----------------
+
+ Visit us at
+ http://racket-lang.org/
+ for more Racket resources.
+
+
+ License
+ -------
+
+ Racket
+ Copyright (c) 2010-2013 PLT Design Inc.
+
+ Racket is distributed under the GNU Lesser General Public License
+ (LGPL). This means that you can link Racket into proprietary
+ applications, provided you follow the rules stated in the LGPL. You can
+ also modify Racket; if you distribute a modified version, you must
+ distribute it under the terms of the LGPL, which in particular means
+ that you must release the source code for the modified software. See
+ lib/COPYING_LESSER.txt for more information.})
+
+(define macosx-notes
+ @~a{Install by dragging the enclosing Racket folder to your Applications folder
+ --- or wherever you like. You can move the Racket folder at any time, but do not
+ move applications or other files within the folder. If you want to use the
+ Racket command-line programs, then (optionally) add the path of the "bin"
+ subdirectory to your PATH environment variable.})
+
+(define drracket-more-info
+ @~a{For Racket documentation, use DrRacket's `Help' menu, run the `Racket
+ Documentation' application (Windows or Mac OS X), or run `raco docs'
+ from a command line.})
diff --git a/pkgs/distro-build/serve-catalog.rkt b/pkgs/distro-build/serve-catalog.rkt
@@ -8,7 +8,8 @@
racket/cmdline
racket/file
racket/path
- racket/system)
+ racket/system
+ "readme.rkt")
(define from-dir "built")
@@ -118,6 +119,7 @@
#:extra-files-paths
(append
(list (build-path build-dir "origin"))
+ (list readmes-dir)
(for/list ([d (in-list dirs)])
(path->complete-path (build-path d "pkgs")))
;; for ".git":
@@ -125,6 +127,17 @@
#:servlet-regexp #rx""
#:port 9440))
+(define readmes-dir (build-path build-dir "readmes"))
+(make-directory* readmes-dir)
+
+(define readme-file (build-path readmes-dir "README.txt"))
+(unless (file-exists? readme-file)
+ (printf "Generating default README\n")
+ (call-with-output-file*
+ readme-file
+ (lambda (o)
+ (display (make-readme (hash)) o))))
+
(if (null? during-cmd-line)
;; Just run server:
(go)
