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

distro-build: support for adding READMEs

Browse Source 
This is a first cut; the default "README" configuration will be
improved.
This commit is contained in:
Matthew Flatt 2013-07-17 16:07:16 -06:00
parent 4500c7c4d5
commit 1c6257a129
11 changed files with 190 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
INSTALL.txt
View File

@ -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

8
Makefile
View File

@ -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

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

@ -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)

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

@ -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

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

@ -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)))
;; ----------------------------------------

12
pkgs/distro-build/installer-dmg.rkt
View File

@ -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)

9
pkgs/distro-build/installer-exe.rkt
View File

@ -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)

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

@ -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)

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

@ -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")

45
pkgs/distro-build/readme.rkt Normal file
View File

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

15
pkgs/distro-build/serve-catalog.rkt
View File

@ -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)