diff --git a/pkgs/plt-services/meta/pkg-index/official/build-update.rkt b/pkgs/plt-services/meta/pkg-index/official/build-update.rkt new file mode 100644 index 0000000000..f76e9b2989 --- /dev/null +++ b/pkgs/plt-services/meta/pkg-index/official/build-update.rkt @@ -0,0 +1,76 @@ +#lang racket/base +(require racket/list + racket/match + racket/file + racket/port + net/http-client + (prefix-in pkg: pkg/lib) + "common.rkt") + +(define SUMMARY-HOST "pkg-build.racket-lang.org") +(define SUMMARY-NAME "summary.rktd") +(define SUMMARY-URL (string-append "/" SUMMARY-NAME)) +(define SUMMARY-PATH (build-path cache-path SUMMARY-NAME)) +(define SUMMARY-ETAG-PATH (build-path cache-path (format "~a.etag" SUMMARY-NAME))) + +(define (extract-tag hs) + (or + (for/or ([h (in-list hs)]) + (match h + [(regexp + #rx#"^ETag: (.*?)$" + (list _ tag-bys)) + tag-bys] + [_ + #f])) + #"")) + +(define (file->bytes* p d) + (if (file-exists? p) + (file->bytes p) + d)) + +(define (build-update!) + (define cur-version + (file->bytes* SUMMARY-ETAG-PATH #"")) + (printf "Current: ~v\n" cur-version) + + (define-values + (_0 head-headers _1) + (http-sendrecv + SUMMARY-HOST SUMMARY-URL + #:method #"HEAD")) + (define head-version + (extract-tag head-headers)) + (printf "Head: ~v\n" head-version) + + (unless (bytes=? cur-version head-version) + (define-values + (_2 get-headers get-ip) + (http-sendrecv + SUMMARY-HOST SUMMARY-URL + #:method #"GET")) + (define get-version + (extract-tag get-headers)) + (printf "Get: ~v\n" get-version) + + (define new-file + (make-temporary-file "summary-~a.rktd" #f cache-path)) + (call-with-output-file new-file + #:exists 'truncate/replace + (λ (new-op) + (copy-port get-ip new-op))) + + (with-output-to-file SUMMARY-ETAG-PATH + #:exists 'truncate/replace + (λ () + (write-bytes get-version))) + + (rename-file-or-directory new-file SUMMARY-PATH #t))) + +(module+ main + (require racket/cmdline) + (command-line + #:program "build-update" + #:args () + (build-update!))) diff --git a/pkgs/plt-services/meta/pkg-index/official/common.rkt b/pkgs/plt-services/meta/pkg-index/official/common.rkt index b9703e5d49..d85e2f3018 100644 --- a/pkgs/plt-services/meta/pkg-index/official/common.rkt +++ b/pkgs/plt-services/meta/pkg-index/official/common.rkt @@ -24,6 +24,9 @@ (github-client_id (file->string (build-path root "client_id"))) (github-client_secret (file->string (build-path root "client_secret"))) +(define cache-path (build-path root "cache")) +(make-directory* cache-path) + (define pkgs-path (build-path root "pkgs")) (make-directory* pkgs-path) @@ -87,6 +90,7 @@ valid-name?) (define-runtime-path update.rkt "update.rkt") +(define-runtime-path build-update.rkt "build-update.rkt") (define-runtime-path static.rkt "static.rkt") (define-runtime-path s3.rkt "s3.rkt") @@ -105,6 +109,8 @@ (define (run-update! pkgs) (run! update.rkt pkgs)) +(define (run-build-update!) + (run! build-update.rkt empty)) (define (run-static! pkgs) (run! static.rkt pkgs)) (define (run-s3! pkgs) @@ -112,6 +118,8 @@ (define (signal-update! pkgs) (thread (λ () (run-update! pkgs)))) +(define (signal-build-update!) + (thread (λ () (run-build-update!)))) (define (signal-static! pkgs) (thread (λ () (run-static! pkgs)))) (define (signal-s3! pkgs) diff --git a/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt b/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt index c65e8763c1..b640772110 100644 --- a/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt +++ b/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt @@ -415,9 +415,11 @@ (thread (λ () (forever - (sleep (* 1 60 60)) (printf "Running scheduled update.\n") - (signal-update! empty)))) + (signal-update! empty) + (printf "Running scheduled build update.\n") + (signal-build-update!) + (sleep (* 1 60 60))))) (serve/servlet main-dispatch #:command-line? #t