meta/pkg-push: add module and dependency information
This commit is contained in:
Matthew Flatt
parent
6035db418f
commit
494a428a94
|
|
@ -8,12 +8,14 @@
|
|||
openssl/sha1
|
||||
net/url
|
||||
pkg/strip
|
||||
pkg/lib
|
||||
setup/getinfo)
|
||||
|
||||
(define pack-dest-dir #f)
|
||||
(define catalog-dirs null)
|
||||
(define native? #f)
|
||||
(define relative? #t)
|
||||
(define get-modules? #f)
|
||||
(define checksum-dir #f)
|
||||
|
||||
(define src-dirs
|
||||
|
|
@ -27,6 +29,8 @@
|
|||
(set! relative? #f)]
|
||||
[("--at-checksum") dir "Copy each to to <dir>/<checksum>"
|
||||
(set! checksum-dir dir)]
|
||||
[("--mods") "Include modules and dependencies in catalog"
|
||||
(set! get-modules? #t)]
|
||||
#:multi
|
||||
[("++catalog") catalog-dir "Write catalog entry to <catalog-dir>"
|
||||
(set! catalog-dirs (cons catalog-dir catalog-dirs))]
|
||||
|
|
@ -39,6 +43,8 @@
|
|||
(for ([catalog-dir (in-list catalog-dirs)])
|
||||
(make-directory* catalog-dir))
|
||||
|
||||
(define metadata-ns (make-base-namespace))
|
||||
|
||||
(define (stream-directory d)
|
||||
(define-values (i o) (make-pipe (* 100 4096)))
|
||||
(define (skip-path? p)
|
||||
|
|
@ -117,6 +123,11 @@
|
|||
(define checksum-dest (if checksum-dir
|
||||
(build-path checksum-dir checksum zip-file)
|
||||
orig-dest))
|
||||
(define pkg-dir (build-path src-dir pkg-name))
|
||||
(define info (and get-modules?
|
||||
(get-info/full pkg-dir
|
||||
#:namespace metadata-ns
|
||||
#:bootstrap? #t)))
|
||||
(when dest-zip
|
||||
(when checksum-dir
|
||||
(make-directory* (build-path checksum-dir checksum))
|
||||
|
|
@ -135,7 +146,7 @@
|
|||
((if relative? values path->complete-path)
|
||||
(if dest-zip
|
||||
checksum-dest
|
||||
(path->directory-path (build-path src-dir pkg-name)))))
|
||||
(path->directory-path pkg-dir))))
|
||||
'checksum checksum
|
||||
'name (path->string pkg-name)
|
||||
'author (string-join (for/list ([r (get 'pkg-authors)])
|
||||
|
|
@ -145,8 +156,17 @@
|
|||
" ")
|
||||
'description (get 'pkg-desc)
|
||||
'tags '()
|
||||
'dependencies '()
|
||||
'modules '())
|
||||
'dependencies (if get-modules?
|
||||
(append
|
||||
(info 'deps (lambda () null))
|
||||
(info 'build-deps (lambda () null)))
|
||||
'())
|
||||
'modules (if get-modules?
|
||||
(pkg-directory->module-paths
|
||||
pkg-dir
|
||||
(path->string pkg-name)
|
||||
#:namespace metadata-ns)
|
||||
'()))
|
||||
o)
|
||||
(newline o))))
|
||||
(for ([catalog-dir (in-list catalog-dirs)])
|
||||
|
|
|
|||
|
|
@ -39,7 +39,8 @@ pull-latest-from-git:
|
|||
# and a catalog in "build/archive/catalog":
|
||||
PACK_ARCHIVE = --at-checksum $(PLT_TOP)/build/archive/pkgs \
|
||||
--pack $(PLT_TOP)/build/archive/pre-pkgs \
|
||||
++catalog $(PLT_TOP)/build/archive/catalog
|
||||
++catalog $(PLT_TOP)/build/archive/catalog \
|
||||
--mods
|
||||
archive-catalog:
|
||||
rm -rf $(PLT_TOP)/build/archive/catalog
|
||||
$(RACKET) -l- distro-build/pack-and-catalog --native $(PACK_ARCHIVE) $(PLT_TOP)/build/latest/native-pkgs
|
||||
|
|
|
|||
|
|
@ -10,6 +10,11 @@
|
|||
http/head
|
||||
pkg/lib)
|
||||
|
||||
(define empty-source "empty.zip")
|
||||
(define empty-source-checksum "9f098dddde7f217879070816090c1e8e74d49432")
|
||||
;; Versions to map to the empty source:
|
||||
(define compatibility-versions '("5.3.4" "5.3.5" "5.3.6"))
|
||||
|
||||
(define-values (src-dir s3-hostname bucket dest-catalog)
|
||||
(command-line
|
||||
#:args
|
||||
|
|
@ -43,6 +48,25 @@
|
|||
(hash-ref ht 'checksum)
|
||||
i))))))
|
||||
|
||||
;; Compute the package in the main distribution
|
||||
(define main-dist-pkgs
|
||||
;; A union-find would be better...
|
||||
(let loop ([pkgs (set)] [check-pkgs (set "main-distribution")])
|
||||
(cond
|
||||
[(set-empty? check-pkgs) pkgs]
|
||||
[else
|
||||
(define a (set-first check-pkgs))
|
||||
(define r (set-rest check-pkgs))
|
||||
(if (set-member? pkgs a)
|
||||
(loop pkgs r)
|
||||
(loop (set-add pkgs a)
|
||||
(set-union
|
||||
r
|
||||
(apply set (map (lambda (p) (if (pair? p) (car p) p))
|
||||
(hash-ref (hash-ref new-pkgs a)
|
||||
'dependencies
|
||||
'()))))))])))
|
||||
|
||||
(printf "Getting current S3 content...\n")
|
||||
(define old-content (list->set (ls (string-append bucket "/pkgs"))))
|
||||
(printf "... got it.\n")
|
||||
|
|
@ -123,6 +147,20 @@
|
|||
port->bytes))
|
||||
(read (open-input-bytes bs)))
|
||||
|
||||
(define (add-compatibility-pkgs ht)
|
||||
(hash-set ht 'versions
|
||||
(for/fold ([ht2 (hash-ref ht 'versions (hash))]) ([v compatibility-versions])
|
||||
(hash-set ht2 v (hash 'source
|
||||
(format "http://~a.~a/pkgs/~a"
|
||||
bucket
|
||||
s3-hostname
|
||||
empty-source)
|
||||
'checksum
|
||||
empty-source-checksum)))))
|
||||
|
||||
(define (add-rung-0 ht)
|
||||
(hash-set ht 'ring 0))
|
||||
|
||||
;; ------------------------------
|
||||
|
||||
;; Upload current files:
|
||||
|
|
@ -137,7 +175,23 @@
|
|||
(hash-ref ht 'source #f))
|
||||
(equal? (hash-ref v 'checksum)
|
||||
(hash-ref ht 'checksum #f)))))
|
||||
(values k v))])
|
||||
(define (add-tag v t)
|
||||
(define l (hash-ref v 'tags '()))
|
||||
(if (member t l)
|
||||
v
|
||||
(hash-set v 'tags (cons t l))))
|
||||
(values k (add-ring-0
|
||||
(add-compatibility-pkgs
|
||||
(cond
|
||||
[(set-member? main-dist-pkgs k)
|
||||
(add-tag v "main-distribution")]
|
||||
[(let ([m (regexp-match #rx"^(.*)-test$" k)])
|
||||
(and m
|
||||
(set-member? main-dist-pkgs (cadr m))))
|
||||
(add-tag v "main-tests")]
|
||||
[(equal? k "racket-test")
|
||||
(add-tag v "main-tests")]
|
||||
[else v])))))])
|
||||
(unless (zero? (hash-count changed-pkgs))
|
||||
(printf "Updating catalog:\n")
|
||||
(for ([k (in-hash-keys changed-pkgs)])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user