starting off on summary integration

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

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)

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