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

distro-build: merge and improve package packing and cataloging

Browse Source 
Use the `pkg-authors' and `pkg-desc' fields from "info.rkt"
when creating a catalog.

Also add an `archive-catalog' makefile target for assembling
archives (binary for native-library package, source others)
and a catalog in "build/archive".
This commit is contained in:
Matthew Flatt 2013-07-30 19:06:57 -06:00
parent 948ce9c08f
commit 15e60c2da1
4 changed files with 179 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Makefile
View File

@ -267,12 +267,15 @@ complain-no-submodule:
exit 1
# Create packages and a catalog for all native libraries:
PACK_NATIVE = --native --absolute --pack build/native/pkgs \
++catalog build/native/catalog \
++catalog build/local/catalog
native-catalog:
$(RACKET) $(DISTBLD)/pack-native.rkt native-pkgs
$(RACKET) $(DISTBLD)/pack-and-catalog.rkt $(PACK_NATIVE) native-pkgs
# Create a catalog for all packages in this directory:
local-source-catalog:
$(RACKET) $(DISTBLD)/catalog-local.rkt
$(RACKET) $(DISTBLD)/pack-and-catalog.rkt ++catalog build/local/catalog pkgs
# Clear out a package build in "build/user", and then install
# packages:
@ -333,6 +336,16 @@ binary-catalog:
binary-catalog-server:
$(RACKET) -l- distro-build/serve-catalog --mode binary
# Assemble all packages from this repo into ".zip" form
# to checksum-based subdirectories of "build/archive/pkgs"
# and a catalog in "build/archive/catalog":
PACK_ARCHIVE = --at-checksum build/archive/pkgs \
--pack build/archive/pre-pkgs \
++catalog build/archive/catalog
archive-catalog:
$(RACKET) $(DISTBLD)/pack-and-catalog.rkt --native $(PACK_ARCHIVE) native-pkgs
$(RACKET) $(DISTBLD)/pack-and-catalog.rkt $(PACK_ARCHIVE) pkgs
# ------------------------------------------------------------
# On each supported platform (for an installer build):
#

48
pkgs/distro-build/catalog-local.rkt
View File

@ -1,48 +0,0 @@
#lang racket/base
(require racket/cmdline
racket/file
net/url)
(command-line
#:args
()
(void))
(define src-dir "pkgs")
(define dest-dir (build-path "build" "local"))
(define catalog-dir (build-path dest-dir "catalog" "pkg"))
(make-directory* catalog-dir)
(define found (make-hash))
;; Recur through directory tree, and treat each directory
;; that has an "info.rkt" file as a package (and don't recur
;; further into the package)
(let loop ([src-dir src-dir])
(for ([f (in-list (directory-list src-dir))])
(define src-f (build-path src-dir f))
(cond
[(file-exists? (build-path src-f "info.rkt"))
(when (hash-ref found f #f)
(error 'pack-local
"found packages multiple times: ~a and ~a"
(hash-ref found f)
src-f))
(hash-set! found f src-f)
(call-with-output-file*
(build-path catalog-dir f)
#:exists 'truncate
(lambda (o)
(write (hash 'source (path->string (path->directory-path src-f))
'checksum "0"
'name (path->string f)
'author "plt@racket-lang.org"
'description "library"
'tags '()
'dependencies '()
'modules '())
o)
(newline o)))]
[(directory-exists? src-f)
(loop src-f)])))

164
pkgs/distro-build/pack-and-catalog.rkt Normal file
View File

@ -0,0 +1,164 @@
#lang racket/base
(require racket/cmdline
racket/file
racket/port
racket/string
file/zip
openssl/sha1
net/url
pkg/strip
setup/getinfo)
(define pack-dest-dir #f)
(define catalog-dirs null)
(define native? #f)
(define relative? #t)
(define checksum-dir #f)
(define src-dirs
(command-line
#:once-each
[("--pack") dest-dir "Pack to <dest-dir>"
(set! pack-dest-dir dest-dir)]
[("--native") "Pack as native"
(set! native? #t)]
[("--absolute") "Record paths as absolute"
(set! relative? #f)]
[("--at-checksum") dir "Copy each to to <dir>/<checksum>"
(set! checksum-dir dir)]
#:multi
[("++catalog") catalog-dir "Write catalog entry to <catalog-dir>"
(set! catalog-dirs (cons catalog-dir catalog-dirs))]
#:args
pkgs-dir
pkgs-dir))
(when pack-dest-dir
(make-directory* pack-dest-dir))
(for ([catalog-dir (in-list catalog-dirs)])
(make-directory* catalog-dir))
(define (stream-directory d)
(define-values (i o) (make-pipe (* 100 4096)))
(define (skip-path? p)
(member (let-values ([(base name dir?) (split-path p)]) (path->string name))
'("compiled")))
(thread (lambda ()
(for ([f (in-directory d)])
(cond
[(skip-path? f) (void)]
[(directory-exists? f)
(write (directory-list f) o)]
[(file-exists? f)
(call-with-input-file*
f
(lambda (i) (copy-port i o)))]))
(close-output-port o)))
i)
(define (do-package src-dir pkg-name)
(define zip-file (path-add-suffix pkg-name #".zip"))
(define dest-zip (and pack-dest-dir
(build-path (path->complete-path pack-dest-dir)
zip-file)))
(when pack-dest-dir
(define sum-file (path-add-suffix pkg-name #".srcsum"))
(define pkg-src-dir (build-path src-dir pkg-name))
(printf "summing ~a\n" pkg-src-dir)
(define src-sha1 (sha1 (stream-directory pkg-src-dir)))
(define dest-sum (build-path (path->complete-path pack-dest-dir) sum-file))
(unless (and (file-exists? dest-zip)
(file-exists? dest-sum)
(equal? (list (version) src-sha1)
(call-with-input-file* dest-sum read)))
(printf "packing ~a\n" zip-file)
(define tmp-dir (make-temporary-file "~a-pkg" 'directory))
(generate-stripped-directory (if native? 'binary 'source)
pkg-src-dir
tmp-dir)
(parameterize ([current-directory tmp-dir])
(when (file-exists? dest-zip) (delete-file dest-zip))
(apply zip dest-zip (directory-list)))
(delete-directory/files tmp-dir)
(call-with-output-file*
dest-sum
#:exists 'truncate/replace
(lambda (o)
(write (list (version) src-sha1) o)
(newline o)))))
(define info-path (build-path src-dir pkg-name))
(define i (get-info/full info-path))
(define (get key)
(i key (lambda ()
(error 'catalog-local
"missing `~a'\n path: ~a"
key
(build-path info-path "info.rkt")))))
(define (write-catalog-entry catalog-dir)
(define catalog-pkg-dir (build-path catalog-dir "pkg"))
(define checksum (if dest-zip
(call-with-input-file* dest-zip sha1)
"0"))
(define orig-dest (if dest-zip
(build-path pack-dest-dir zip-file)
#f))
(define checksum-dest (if checksum-dir
(build-path checksum-dir checksum zip-file)
orig-dest))
(when dest-zip
(when checksum-dir
(make-directory* (build-path checksum-dir checksum))
(copy-file orig-dest checksum-dest #t))
(call-with-output-file*
(build-path (path-replace-suffix checksum-dest #".zip.CHECKSUM"))
#:exists 'truncate/replace
(lambda (o)
(display checksum o))))
(make-directory* catalog-pkg-dir)
(call-with-output-file*
(build-path catalog-pkg-dir pkg-name)
#:exists 'truncate
(lambda (o)
(write (hash 'source (path->string
((if relative? values path->complete-path)
(if dest-zip
checksum-dest
(path->directory-path (build-path src-dir pkg-name)))))
'checksum checksum
'name (path->string pkg-name)
'author (string-join (for/list ([r (get 'pkg-authors)])
(if (symbol? r)
(format "~a@racket-lang.org" r)
r))
", ")
'description (get 'pkg-desc)
'tags '()
'dependencies '()
'modules '())
o)
(newline o))))
(for ([catalog-dir (in-list catalog-dirs)])
(write-catalog-entry catalog-dir)))
(define found (make-hash))
;; Recur through directory tree, and treat each directory
;; that has an "info.rkt" file as a package (and don't recur
;; further into the package)
(for ([src-dir (in-list src-dirs)])
(let loop ([src-dir src-dir])
(for ([f (in-list (directory-list src-dir))])
(define src-f (build-path src-dir f))
(cond
[(file-exists? (build-path src-f "info.rkt"))
(when (hash-ref found f #f)
(error 'pack-local
"found packages multiple times: ~a and ~a"
(hash-ref found f)
src-f))
(hash-set! found f src-f)
(do-package src-dir f)]
[(directory-exists? src-f)
(loop src-f)]))))

83
pkgs/distro-build/pack-native.rkt
View File

@ -1,83 +0,0 @@
#lang racket/base
(require racket/cmdline
racket/file
racket/port
file/zip
openssl/sha1
net/url
pkg/strip)
(define src-dir
(command-line
#:args
(native-pkgs-dir)
native-pkgs-dir))
(define dest-dir (build-path "build" "native" "pkgs"))
(define catalog-dir (build-path "build" "native" "catalog"))
(define local-catalog-dir (build-path "build" "local" "catalog"))
(make-directory* dest-dir)
(make-directory* catalog-dir)
(make-directory* local-catalog-dir)
(define (stream-directory d)
(define-values (i o) (make-pipe (* 100 4096)))
(thread (lambda ()
(for ([f (in-directory d)])
(cond
[(directory-exists? f)
(write (directory-list f) o)]
[(file-exists? f)
(call-with-input-file*
f
(lambda (i) (copy-port i o)))]))
(close-output-port o)))
i)
(for ([pkg-name (in-list (directory-list src-dir))])
(when (file-exists? (build-path src-dir pkg-name "info.rkt"))
(define zip-file (path-add-suffix pkg-name #".zip"))
(define sum-file (path-add-suffix pkg-name #".srcsum"))
(define pkg-src-dir (build-path src-dir pkg-name))
(printf "summing ~a\n" pkg-src-dir)
(define src-sha1 (sha1 (stream-directory pkg-src-dir)))
(define dest-zip (build-path (path->complete-path dest-dir) zip-file))
(define dest-sum (build-path (path->complete-path dest-dir) sum-file))
(unless (and (file-exists? dest-zip)
(file-exists? dest-sum)
(equal? (list (version) src-sha1)
(call-with-input-file* dest-sum read)))
(printf "packing ~a\n" zip-file)
(define tmp-dir (make-temporary-file "~a-pkg" 'directory))
(generate-stripped-directory 'binary pkg-src-dir tmp-dir)
(parameterize ([current-directory tmp-dir])
(when (file-exists? dest-zip) (delete-file dest-zip))
(apply zip dest-zip (directory-list)))
(delete-directory/files tmp-dir)
(call-with-output-file*
dest-sum
#:exists 'truncate/replace
(lambda (o)
(write (list (version) src-sha1) o)
(newline o))))
(define (write-catalog-entry catalog-dir)
(define catalog-pkg-dir (build-path catalog-dir "pkg"))
(make-directory* catalog-pkg-dir)
(call-with-output-file*
(build-path catalog-pkg-dir pkg-name)
#:exists 'truncate
(lambda (o)
(write (hash 'source (path->string dest-zip)
'checksum (call-with-input-file* dest-zip sha1)
'name (path->string pkg-name)
'author "plt@racket-lang.org"
'description "native library"
'tags '()
'dependencies '()
'modules '())
o)
(newline o))))
(write-catalog-entry catalog-dir)
(write-catalog-entry local-catalog-dir)))