distro-build: support for adding READMEs

This is a first cut; the default "README" configuration will be
improved.

INSTALL.txt

@@ -328,6 +328,9 @@ Roughly, the steps are
     initial package catalog URLs. Use the empty string in place of a
     URL to indicate that the default path should be spliced.
 
+    Add `README="..."' to specify a file to download from the server
+    to use as the "README" file in the generated installer.
+
 In more detail:
 
  1a. Build "racket" on a server.
@@ -357,6 +360,11 @@ In more detail:
      represented by directories in the makefile's directory. For now,
      "local" is the default.
 
+     The server provides README files from the "build/readmes"
+     directory. If "README.txt" does not exist when the sever is
+     started, when a default file is created (and clients download
+     "README.txt" by default).
+
      If you stop the server and want to restart it, use the
      `built-package-server' makefile target instead of starting over
      with the `server' target.
@@ -416,6 +424,10 @@ In more detail:
      (but not single quotes) --- which are needed to specify an empty
      string, for example.
 
+     To select a "README" file for the client, provide `README' to
+     `make'. The `README' value is used as a file name to download
+     from the server.
+
 On each client, step 2b produces a "bundle/installer.txt" file that
 contains the path to the generated installer on one line, followed by
 the description on a second line. The installer is also uploaded to

Makefile

@@ -134,6 +134,9 @@ DIST_DESC =
 # installers, where "" is replaced by the default configuration:
 DIST_CATALOGS_q = ""
 
+# A README file to download from the server for the client:
+README = README.txt
+
 # Configuration module that describes a build, normally implemented
 # with `#lang distro-build/config':
 CONFIG = build/site.rkt
@@ -327,7 +330,8 @@ client:
 COPY_ARGS = SERVER=$(SERVER) PKGS="$(PKGS)" RELEASE_MODE=$(RELEASE_MODE) \
             DIST_NAME="$(DIST_NAME)" DIST_BASE=$(DIST_BASE) \
             DIST_DIR=$(DIST_DIR) DIST_SUFFIX=$(DIST_SUFFIX) \
-            DIST_DESC="$(DIST_DESC)" JOB_OPTIONS="$(JOB_OPTIONS)"
+            DIST_DESC="$(DIST_DESC)" README="$(README)" \
+            JOB_OPTIONS="$(JOB_OPTIONS)"
 
 win32-client:
 	IF EXIST build\user cmd /c rmdir /S /Q build\user
@@ -356,7 +360,7 @@ bundle-from-server:
 bundle-config:
 	$(RACKET) -l distro-build/set-config $(BUNDLE_CONFIG) "" "" "$(DOC_SEARCH)" $(DIST_CATALOGS_q)
 
-UPLOAD_q = --upload http://$(SERVER):9440/ --desc "$(DIST_DESC)"
+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)"
 
 # Create an installer from the build (with installed packages) that's

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)

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

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
+  (hash-ref opts kw (lambda ()
-                     [(equal? default localhost-default) default]
+                      (cond
-                     [(and (equal? "localhost" (get-opt opts '#:host "localhost"))
+                       [(equal? default localhost-default) default]
-                           (equal? #f (get-opt opts '#:user #f))
+                       [(and (equal? "localhost" (get-opt opts '#:host "localhost"))
-                           (equal? #f (get-opt opts '#:dir #f)))
+                             (equal? #f (get-opt opts '#:user #f))
-                      localhost-default]
+                             (equal? #f (get-opt opts '#:dir #f)))
-                     [else default])))
+                        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)
+  (begin0
-     [(unix) unix-build]
+   
-     [else windows-build])
+   ((case (or (get-opt c '#:platform) 'unix)
-   c host port user server repo clean? pull?))
+      [(unix) unix-build]
+      [else windows-build])
+    c host port user server repo clean? pull? readme)
+
+   (delete-file readme)))
 
 ;; ----------------------------------------
 

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)

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)

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)
 

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)]
+    [(unix) (installer-sh human-name base-name dir-name release? dist-suffix readme)]
-    [(macosx) (installer-dmg human-name base-name dist-suffix)]
+    [(macosx) (installer-dmg human-name base-name dist-suffix readme)]
-    [(windows) (installer-exe short-human-name base-name release? dist-suffix)]))
+    [(windows) (installer-exe short-human-name base-name release? dist-suffix readme)]))
 
 (call-with-output-file*
  (build-path "bundle" "installer.txt")

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.})

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)