Removing separate processes and trying to get faster turn-around, plus a few little things

pkgs/plt-services/meta/pkg-index/official/build-update.rkt

@@ -5,7 +5,8 @@
          racket/port
          net/http-client
          (prefix-in pkg: pkg/lib)
-         "common.rkt")
+         "common.rkt"
+         "notify.rkt")
 
 (define SUMMARY-HOST "pkg-build.racket-lang.org")
 (define SUMMARY-URL (string-append "/" SUMMARY-NAME))
@@ -66,11 +67,22 @@
 
     (rename-file-or-directory new-file SUMMARY-PATH #t)))
 
+(define (do-build-update! l)
+  (notify! "package build status being checked for updates")
+  (build-update!)
+  (notify! ""))
+(define (run-build-update!)
+  (run! do-build-update! empty))
+(define (signal-build-update!)
+  (thread (λ () (run-build-update!))))
+
+(provide do-build-update!
+         run-build-update!
+         signal-build-update!)
+
 (module+ main
   (require racket/cmdline)
   (command-line
    #:program "build-update"
    #:args ()
-   (notify! "package build status being checked for updates")
-   (build-update!)
-   (notify! "")))
+   (do-build-update! empty)))

pkgs/plt-services/meta/pkg-index/official/common.rkt

@@ -35,6 +35,7 @@
 
 (define static.src-path (build-path src "static"))
 (define static-path (build-path src "static-gen"))
+(define notice-path (format "~a/notice.json" static-path))
 
 (define (package-list)
   (sort (map path->string (directory-list pkgs-path))
@@ -92,44 +93,12 @@
 (define valid-tag?
   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")
-(define-runtime-path notify.rkt "notify.rkt")
-
 (define run-sema (make-semaphore 1))
-(define (run! file args)
-  (call-with-semaphore
-   run-sema
-   (λ ()
-     (parameterize ([date-display-format 'iso-8601])
-       (printf "~a: ~a ~v\n" (date->string (current-date) #t) file args))
-     (apply system* (find-executable-path (find-system-path 'exec-file))
-            "-t" file
-            "--"
-            args)
-     (printf "~a: done\n" (date->string (current-date) #t)))))
-
-(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)
-  (run! s3.rkt pkgs))
-(define (notify! m)
-  (run! notify.rkt (list m)))
-
-(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)
-  (thread (λ () (run-s3! pkgs))))
+(define (run! f args)
+  (parameterize ([date-display-format 'iso-8601])
+    (printf "~a: ~a ~v\n" (date->string (current-date) #t) f args)
+    (f args)
+    (printf "~a: done\n" (date->string (current-date) #t))))
 
 (define s3-config (build-path (find-system-path 'home-dir) ".s3cfg-plt"))
 (define s3-bucket "pkgs.racket-lang.org")

pkgs/plt-services/meta/pkg-index/official/dynamic.rkt

@@ -1,6 +1,10 @@
 #lang racket/base
 (require web-server/http
          "common.rkt"
+         "update.rkt"
+         "notify.rkt"
+         "static.rkt"
+         "build-update.rkt"
          "jsonp.rkt"
          web-server/servlet-env
          racket/file
@@ -390,6 +394,9 @@
   (signal-update! (packages-of (current-user)))
   #t)
 
+(define jsonp/notice
+  (make-jsonp-responder (λ (args) (file->string notice-path))))
+
 (define-values (main-dispatch main-url)
   (dispatch-rules
    [("jsonp" "authenticate") jsonp/authenticate]
@@ -404,6 +411,7 @@
    [("jsonp" "package" "author" "del") jsonp/package/author/del]
    [("jsonp" "package" "curate") jsonp/package/curate]
    [("api" "upload") #:method "post" api/upload]
+   [("jsonp" "notice") jsonp/notice]
    [else redirect-to-static]))
 
 (define-syntax-rule (forever . body)

pkgs/plt-services/meta/pkg-index/official/notify.rkt

@@ -7,20 +7,7 @@
          "common.rkt")
 
 (define (upload-notice! m)
-  (define notice-p (format "~a/notice.json" static-path))
-  
-  (write-to-file m notice-p #:exists 'replace)
-  
-  (system* s3cmd-path
-           "-c" s3-config
-           "sync"
-           "-M"
-           "--acl-public"
-           "--delete-removed"
-           notice-p
-           (format "s3://~a/notice.json" s3-bucket))
-
-  (void))
+  (display-to-file m notice-path #:exists 'replace))
 
 (module+ main
   (require racket/cmdline)
@@ -28,3 +15,11 @@
    #:program "notify"
    #:args (message)
    (upload-notice! message)))
+
+(define (do-notify! l)
+  (upload-notice! (first l)))
+(define (notify! m)
+  (run! do-notify! (list m)))
+
+(provide do-notify!
+         notify!)

pkgs/plt-services/meta/pkg-index/official/s3.rkt

@@ -5,7 +5,8 @@
          racket/system
          file/gzip
          racket/match
-         "common.rkt")
+         "common.rkt"
+         "notify.rkt")
 
 (define (upload-all)
   (gzip (format "~a/pkgs-all.json" static-path)
@@ -39,6 +40,14 @@
 (define (upload-pkgs pkgs)
   ;; FUTURE make this more efficient
   (upload-all))
+(define (run-s3! pkgs)
+  (run! upload-pkgs pkgs))
+(define (signal-s3! pkgs)
+  (thread (λ () (run-s3! pkgs))))
+
+(provide upload-pkgs
+         run-s3!
+         signal-s3!)
 
 (module+ main
   (require racket/cmdline)

pkgs/plt-services/meta/pkg-index/official/static.rkt

@@ -13,7 +13,9 @@
          racket/path
          racket/promise
          meta/pkg-index/basic/main
-         "common.rkt")
+         "common.rkt"
+         "notify.rkt"
+         "s3.rkt")
 
 (define convert-to-json
   (match-lambda
@@ -373,13 +375,24 @@
         (delete-file (build-path pkg-path f))
         (delete-file (build-path pkg-path (path-add-suffix f #".json")))))))
 
+(define (do-static pkgs)
+  (notify! "update upload being computed: the information below may not represent all recent changes and updates")
+   ;; FUTURE make this more efficient by looking at pkgs
+  (generate-static)
+  (run-s3! pkgs))
+(define (run-static! pkgs)
+  (run! do-static pkgs))
+(define (signal-static! pkgs)
+  (thread (λ () (run-static! pkgs))))
+
+(provide do-static
+         run-static!
+         signal-static!)
+
 (module+ main
   (require racket/cmdline)
 
   (command-line
    #:program "static"
    #:args pkgs
-   ;; FUTURE make this more efficient
-   (notify! "update upload being computed: the information below may not represent all recent changes and updates")
-   (generate-static)
-   (run-s3! pkgs)))
+   (do-static pkgs)))

pkgs/plt-services/meta/pkg-index/official/static/index.js

@@ -506,16 +506,17 @@ $( document ).ready(function() {
                 bstatus ); }
 
     function pollNotice(){
-        $.getJSON( "/notice.json", function( resp ) {
+        $.getJSON( dynamic_url("/jsonp/notice"), function( resp ) {
             $("#server_notice").html(resp);
             // If there is no notice, update every 5 minutes
-            if ( resp == "" ) {
+            if ( ! (/\S/.test(resp)) ) {
                 $("#server_notice").hide();
                 setTimeout(pollNotice, 1000*60*5); }
             // Otherwise, update every 5 seconds
             else {
                 $("#server_notice").show();
                 setTimeout(pollNotice, 1000*5); } }); }
+    $("#server_notice").hide();
     pollNotice();
 
     var pkgdb = {};
@@ -601,6 +602,9 @@ $( document ).ready(function() {
     function menu_logout () {
         logged_in = false;
         $("#logout").html( jslink( "login", function () { $( "#login" ).dialog( "open" ); } ) ); }
+    function menu_logging () {
+        logged_in = false;
+        $("#logout").html( "logging in..." ); }
     function menu_loggedin ( curate_p ) {
         logged_in = true;
         $("#logout").html("")
@@ -656,6 +660,7 @@ $( document ).ready(function() {
                          menu_logout (); }) ); }
 
     function initial_login () {
+        menu_logging();
         $.getJSON( dynamic_url("/jsonp/authenticate"),
                    { email: localStorage['email'], passwd: localStorage['passwd'], code: "" },
                    function( resp ) {

pkgs/plt-services/meta/pkg-index/official/static/style.css

@@ -45,14 +45,15 @@ body {
 #server_notice {
     text-align: center;
     background: #ffffcc;
-    padding-bottom: 0.5em;
+    padding-bottom: 0.25em;
     color: black;
-    font-size: 150%;
+    font-size: 75%;
     font-weight: bold;
 }
 
 #logout {
     float: right;
+    color: white;
 }
 
 .content {

pkgs/plt-services/meta/pkg-index/official/update.rkt

@@ -4,7 +4,9 @@
          pkg/util
          racket/package
          (prefix-in pkg: pkg/lib)
-         "common.rkt")
+         "common.rkt"
+         "notify.rkt"
+         "static.rkt")
 
 (define (update-all)
   (update-checksums #f (package-list)))
@@ -19,8 +21,8 @@
       ([exn:fail?
         (λ (x)
           (define i (package-info pkg-name))
-          (package-info-set! 
-           pkg-name 
+          (package-info-set!
+           pkg-name
            (hash-set i 'checksum-error (exn-message x))))])
     (define i (package-info pkg-name))
     (define old-checksum
@@ -77,16 +79,28 @@
    (define* i (hash-set i 'dependencies dependencies))
    i))
 
+
+(define (do-update! pkgs)
+  (notify! "package sources being checked for updates")
+  (cond
+    [(empty? pkgs)
+     (update-all)
+     (run-static! empty)]
+    [else
+     (update-pkgs pkgs)
+     (run-static! pkgs)]))
+(define (run-update! pkgs)
+  (run! do-update! pkgs))
+(define (signal-update! pkgs)
+  (thread (λ () (run-update! pkgs))))
+
+(provide do-update!
+         run-update!
+         signal-update!)
+
 (module+ main
   (require racket/cmdline)
   (command-line
    #:program "update"
    #:args pkgs
-   (notify! "package sources being checked for updates")
-   (cond
-     [(empty? pkgs)
-      (update-all)
-      (run-static! empty)]
-     [else
-      (update-pkgs pkgs)
-      (run-static! pkgs)])))
+   (do-update! pkgs)))