Split meta/pkg-push from the main repository.
Source for `pkg-push` is now at https://github.com/racket/pkg-push
This commit is contained in:
Sam Tobin-Hochstadt
parent
c0d9540a0d
commit
d103f26243
|
|
@ -4,5 +4,6 @@
|
||||||
"http"
|
"http"
|
||||||
"aws"
|
"aws"
|
||||||
("s3-sync" "git://github.com/mflatt/s3-sync")
|
("s3-sync" "git://github.com/mflatt/s3-sync")
|
||||||
|
("pkg-push" "git://github.com/racket/pkg-push/")
|
||||||
("racket-lang-org" "git://github.com/racket/racket-lang-org/")
|
("racket-lang-org" "git://github.com/racket/racket-lang-org/")
|
||||||
("pkg-build" "git://github.com/racket/pkg-build/"))
|
("pkg-build" "git://github.com/racket/pkg-build/"))
|
||||||
|
|
|
||||||
|
|
@ -1,59 +0,0 @@
|
||||||
# ------------------------------------------------------------
|
|
||||||
# Configuration
|
|
||||||
|
|
||||||
# This `racket' must have the the "aws" package installed,
|
|
||||||
# where "aws" depends on "html-lib", and it must be consistent
|
|
||||||
# with "pack-all.rkt" in `PLT_TOP`.
|
|
||||||
RACKET = racket
|
|
||||||
|
|
||||||
# In `PLT_TOP', "build/latest" should be a git clone to update (and it
|
|
||||||
# shouldn't be the clone that implements `RACKET'), and other files
|
|
||||||
# will be written and cached at "build":
|
|
||||||
PLT_TOP = ../../../..
|
|
||||||
# Beware that old packages can accumulate in "build/archive".
|
|
||||||
# Discard that directory periodically to clean out old versions.
|
|
||||||
# (The S3 update will independently preserve old uploaded versions
|
|
||||||
# for at least one week.)
|
|
||||||
|
|
||||||
# Along with the following, "~/.aws-keys" must have your AWS keys in
|
|
||||||
# the form
|
|
||||||
# AWSAccessKeyId=....
|
|
||||||
# AWSSecretKey=....
|
|
||||||
S3_HOST = s3-us-west-2.amazonaws.com
|
|
||||||
BUCKET = racket-packages
|
|
||||||
|
|
||||||
# The catalog server to read and update:
|
|
||||||
SRC_CATALOG = https://localhost:9004
|
|
||||||
DEST_CATALOG = $(SRC_CATALOG)
|
|
||||||
|
|
||||||
# ------------------------------------------------------------
|
|
||||||
# Targets
|
|
||||||
|
|
||||||
# Make `push' periodically to push packages to pkgs.racket-lang.org:
|
|
||||||
push:
|
|
||||||
$(MAKE) pull-latest-from-git
|
|
||||||
$(MAKE) archive-catalog
|
|
||||||
$(MAKE) push-catalog
|
|
||||||
|
|
||||||
# Update repo checkout in "build/latest" --- assuming that the
|
|
||||||
# repo has been checked out before.
|
|
||||||
pull-latest-from-git:
|
|
||||||
cd $(PLT_TOP)/build/latest && git pull && git submodule update
|
|
||||||
|
|
||||||
# Assemble all packages from a repo checkout into ".zip" form
|
|
||||||
# to checksum-based subdirectories of "build/archive/pkgs"
|
|
||||||
# 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 \
|
|
||||||
--mods
|
|
||||||
archive-catalog:
|
|
||||||
rm -rf $(PLT_TOP)/build/archive/catalog
|
|
||||||
$(RACKET) $(PLT_TOP)/racket/src/pack-all.rkt --native $(PACK_ARCHIVE) $(PLT_TOP)/build/latest/native-pkgs
|
|
||||||
$(RACKET) $(PLT_TOP)/racket/src/pack-all.rkt $(PACK_ARCHIVE) $(PLT_TOP)/build/latest/pkgs
|
|
||||||
|
|
||||||
# Copy files from "build/archive" to $(BUCKET), and update
|
|
||||||
# $(DEST_CATALOG) relative to $(SRC_CATALOG):
|
|
||||||
AWS_AND_CATALOG = $(S3_HOST) $(BUCKET) $(SRC_CATALOG) $(DEST_CATALOG)
|
|
||||||
push-catalog:
|
|
||||||
$(RACKET) push-catalog.rkt $(PLT_TOP)/build/archive $(AWS_AND_CATALOG)
|
|
||||||
|
|
@ -1,3 +0,0 @@
|
||||||
#lang info
|
|
||||||
|
|
||||||
(define compile-omit-files '("push-catalog.rkt")) ; uses extra packages
|
|
||||||
|
|
@ -1,247 +0,0 @@
|
||||||
#lang racket/base
|
|
||||||
(require aws/keys
|
|
||||||
aws/s3
|
|
||||||
racket/file
|
|
||||||
racket/cmdline
|
|
||||||
racket/set
|
|
||||||
racket/format
|
|
||||||
racket/port
|
|
||||||
net/url
|
|
||||||
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 src-catalog dest-catalog)
|
|
||||||
(command-line
|
|
||||||
#:args
|
|
||||||
(src-dir s3-hostname bucket src-catalog dest-catalog)
|
|
||||||
(values src-dir s3-hostname bucket src-catalog dest-catalog)))
|
|
||||||
|
|
||||||
(ensure-have-keys)
|
|
||||||
(s3-host s3-hostname)
|
|
||||||
|
|
||||||
(define-values (catalog-email catalog-password)
|
|
||||||
(call-with-input-file*
|
|
||||||
(build-path (find-system-path 'home-dir) ".pkg-catalog-login")
|
|
||||||
(lambda (i) (values (read i) (read i)))))
|
|
||||||
|
|
||||||
(define (status fmt . args)
|
|
||||||
(apply printf fmt args)
|
|
||||||
(flush-output))
|
|
||||||
|
|
||||||
(status "Getting current packages at ~a...\n" src-catalog)
|
|
||||||
(define current-pkgs
|
|
||||||
(parameterize ([current-pkg-catalogs (list (string->url src-catalog))])
|
|
||||||
(get-all-pkg-details-from-catalogs)))
|
|
||||||
(status "... got it.\n")
|
|
||||||
|
|
||||||
(define new-pkgs
|
|
||||||
(let ([dir (build-path src-dir "catalog" "pkg")])
|
|
||||||
(for/hash ([i (in-list (directory-list dir))])
|
|
||||||
(define ht (call-with-input-file* (build-path dir i) read))
|
|
||||||
(values (path->string i)
|
|
||||||
(hash-set ht
|
|
||||||
'source
|
|
||||||
(format "http://~a.~a/pkgs/~a/~a.zip"
|
|
||||||
bucket
|
|
||||||
s3-hostname
|
|
||||||
(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
|
|
||||||
(set-remove
|
|
||||||
(apply set (map (lambda (p) (if (pair? p) (car p) p))
|
|
||||||
(hash-ref (hash-ref new-pkgs a)
|
|
||||||
'dependencies
|
|
||||||
'())))
|
|
||||||
"racket"))))])))
|
|
||||||
|
|
||||||
(status "Getting current S3 content...\n")
|
|
||||||
(define old-content (list->set (ls (string-append bucket "/pkgs"))))
|
|
||||||
(status "... got it.\n")
|
|
||||||
|
|
||||||
;; A list of `(cons checksum p)':
|
|
||||||
(define new-checksums&files
|
|
||||||
(let ([dir (build-path src-dir "pkgs")])
|
|
||||||
(for*/list ([checksum (in-list (directory-list dir))]
|
|
||||||
[p (in-list (directory-list (build-path dir checksum)))])
|
|
||||||
(cons (path->string checksum) (path->string p)))))
|
|
||||||
|
|
||||||
;; A tag that we install for each checksum that is used.
|
|
||||||
;; We can detect obsolte checksums as not having a recent
|
|
||||||
;; enough tag (i.e., older than an era). An "era" is
|
|
||||||
;; currently defined as a week.
|
|
||||||
(define now-era (quotient (current-seconds) (* 7 24 60 60)))
|
|
||||||
(define now (~a now-era))
|
|
||||||
(define recently (~a (sub1 now-era)))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
|
||||||
|
|
||||||
;; Push one file at a given chcksum to the bucket
|
|
||||||
(define (sync-one checksum p)
|
|
||||||
(status "Checking ~a @ ~a\n" p checksum)
|
|
||||||
|
|
||||||
(define (at-checksum p)
|
|
||||||
(string-append "pkgs/" checksum "/" p))
|
|
||||||
(define (at-bucket&checksum p)
|
|
||||||
(string-append bucket "/" (at-checksum p)))
|
|
||||||
|
|
||||||
(define (put p content)
|
|
||||||
(status "Putting ~a\n" p)
|
|
||||||
(define s (put/bytes p
|
|
||||||
content
|
|
||||||
"application/octet-stream"
|
|
||||||
#hash((x-amz-storage-class . "REDUCED_REDUNDANCY")
|
|
||||||
(x-amz-acl . "public-read"))))
|
|
||||||
(unless (member (extract-http-code s) '(200))
|
|
||||||
(error 'sync-one "put failed for ~s: ~s" p s)))
|
|
||||||
|
|
||||||
(unless (set-member? old-content (at-checksum now))
|
|
||||||
(put (at-bucket&checksum now)
|
|
||||||
#"ok"))
|
|
||||||
|
|
||||||
(unless (set-member? old-content (at-checksum p))
|
|
||||||
(put (at-bucket&checksum p)
|
|
||||||
(file->bytes (build-path src-dir "pkgs" checksum p)))))
|
|
||||||
|
|
||||||
;; Discard an obsolete file
|
|
||||||
(define (purge-one checksum raw-p)
|
|
||||||
(status "Removing ~a @ ~a\n" raw-p checksum)
|
|
||||||
|
|
||||||
(define p (string-append bucket "/pkgs/" checksum "/" raw-p))
|
|
||||||
|
|
||||||
(define s (delete p))
|
|
||||||
(unless (member (extract-http-code s) '(200 204))
|
|
||||||
(error 'purge-one "delete failed for ~s: ~s" p s)))
|
|
||||||
|
|
||||||
;; Update the package catalog:
|
|
||||||
(define (update-catalog the-email the-password the-post expected-result)
|
|
||||||
(define the-url
|
|
||||||
(let ([u (string->url dest-catalog)])
|
|
||||||
(struct-copy url u
|
|
||||||
[path
|
|
||||||
(append
|
|
||||||
(url-path u)
|
|
||||||
(list (path/param "api" null)
|
|
||||||
(path/param "upload" null)))])))
|
|
||||||
(define bs
|
|
||||||
(call/input-url the-url
|
|
||||||
(λ (url)
|
|
||||||
(post-pure-port the-url
|
|
||||||
(with-output-to-bytes
|
|
||||||
(λ ()
|
|
||||||
(write (list the-email
|
|
||||||
(string->bytes/utf-8 the-password)
|
|
||||||
the-post))))))
|
|
||||||
port->bytes))
|
|
||||||
(define r (with-handlers ([exn:fail? (lambda (exn) exn)])
|
|
||||||
(read (open-input-bytes bs))))
|
|
||||||
(unless (equal? r expected-result)
|
|
||||||
(error 'update
|
|
||||||
(string-append
|
|
||||||
"unexpected result from catalog update\n"
|
|
||||||
" result: ~a\n"
|
|
||||||
" server response: ~s")
|
|
||||||
r
|
|
||||||
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-ring-0 ht)
|
|
||||||
(hash-set ht 'ring 0))
|
|
||||||
|
|
||||||
;; ------------------------------
|
|
||||||
|
|
||||||
;; Upload current files:
|
|
||||||
(for ([p (in-list new-checksums&files)])
|
|
||||||
(sync-one (car p) (cdr p)))
|
|
||||||
|
|
||||||
;; Use 'default version, if any
|
|
||||||
(define (hash-ref* ht k def)
|
|
||||||
(define ht2 (hash-ref (hash-ref ht 'versions (hash))
|
|
||||||
'default
|
|
||||||
ht))
|
|
||||||
(hash-ref ht2 k (hash-ref ht k def)))
|
|
||||||
|
|
||||||
;; Update the catalog:
|
|
||||||
(let ([changed-pkgs
|
|
||||||
(for/hash ([(k v) (in-hash new-pkgs)]
|
|
||||||
#:unless (let ([ht (hash-ref current-pkgs k #hash())])
|
|
||||||
(and (equal? (hash-ref v 'source)
|
|
||||||
(hash-ref* ht 'source #f))
|
|
||||||
(equal? (hash-ref v 'checksum)
|
|
||||||
(hash-ref* ht 'checksum #f)))))
|
|
||||||
(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))
|
|
||||||
(status "Updating catalog at ~a:\n" dest-catalog)
|
|
||||||
(for ([k (in-hash-keys changed-pkgs)])
|
|
||||||
(status " ~a\n" k))
|
|
||||||
(update-catalog catalog-email catalog-password changed-pkgs #t)))
|
|
||||||
(status "Catalog updated\n")
|
|
||||||
|
|
||||||
;; Look for files that can be discarded:
|
|
||||||
(let ([new-checksums
|
|
||||||
(for/set ([pr (in-list new-checksums&files)])
|
|
||||||
(car pr))])
|
|
||||||
(for ([p (in-set old-content)])
|
|
||||||
(define m (regexp-match #rx"^pkgs/([^/]*)/([^/]*)$" p))
|
|
||||||
(when m
|
|
||||||
(define checksum (cadr m))
|
|
||||||
(define p (caddr m))
|
|
||||||
(cond
|
|
||||||
[(set-member? new-checksums checksum)
|
|
||||||
;; Keep this checksum, but look for old timestamp files.
|
|
||||||
(when (regexp-match? #rx"^[0-9]*$" p)
|
|
||||||
(unless (or (equal? p now)
|
|
||||||
(equal? p recently))
|
|
||||||
;; Looks like we can delete it
|
|
||||||
(purge-one checksum p)))]
|
|
||||||
[(or (set-member? old-content (string-append "pkgs/" checksum "/" recently))
|
|
||||||
(set-member? old-content (string-append "pkgs/" checksum "/" recently)))
|
|
||||||
;; Recent enough timestamp; don't discard
|
|
||||||
(void)]
|
|
||||||
[else
|
|
||||||
;; Old checksum, so discard
|
|
||||||
(purge-one checksum p)]))))
|
|
||||||
Loading…
Reference in New Issue
Block a user