From 62dd8ea647408db70e6f923a2ab073bc7669f4a6 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 14 Jul 2014 16:45:56 +0100
Subject: [PATCH] meta/pkg-push: allow separate src and dest catalog URLs

Also, report failures as errors, so that the result code is
helpful.
---
 pkgs/plt-services/meta/pkg-push/Makefile       |  9 +++++----
 .../meta/pkg-push/push-catalog.rkt             | 18 +++++++++---------
 2 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/pkgs/plt-services/meta/pkg-push/Makefile b/pkgs/plt-services/meta/pkg-push/Makefile
index 93d300c0c0..689df927c3 100644
--- a/pkgs/plt-services/meta/pkg-push/Makefile
+++ b/pkgs/plt-services/meta/pkg-push/Makefile
@@ -18,8 +18,9 @@ PLT_TOP = ../../../..
 S3_HOST = s3-us-west-2.amazonaws.com
 BUCKET = racket-packages
 
-# The catalog server to update:
-DEST_CATALOG = https://localhost:9004
+# The catalog server to read and update:
+SRC_CATALOG = https://localhost:9004
+DEST_CATALOG = $(SRC_CATALOG)
 
 # ------------------------------------------------------------
 # Targets
@@ -48,7 +49,7 @@ archive-catalog:
 	$(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):
-AWS_AND_CATALOG = $(S3_HOST) $(BUCKET) $(DEST_CATALOG)
+# $(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)
diff --git a/pkgs/plt-services/meta/pkg-push/push-catalog.rkt b/pkgs/plt-services/meta/pkg-push/push-catalog.rkt
index 8159f7eea4..47abbcab14 100644
--- a/pkgs/plt-services/meta/pkg-push/push-catalog.rkt
+++ b/pkgs/plt-services/meta/pkg-push/push-catalog.rkt
@@ -15,11 +15,11 @@
 ;; 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)
+(define-values (src-dir s3-hostname bucket src-catalog dest-catalog)
   (command-line
    #:args
-   (src-dir s3-hostname bucket dest-catalog)
-   (values src-dir s3-hostname bucket dest-catalog)))
+   (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)
@@ -29,9 +29,9 @@
    (build-path (find-system-path 'home-dir) ".pkg-catalog-login")
    (lambda (i) (values (read i) (read i)))))
 
-(printf "Getting current packages at ~a...\n" dest-catalog)
+(printf "Getting current packages at ~a...\n" src-catalog)
 (define current-pkgs
-  (parameterize ([current-pkg-catalogs (list (string->url dest-catalog))])
+  (parameterize ([current-pkg-catalogs (list (string->url src-catalog))])
     (get-all-pkg-details-from-catalogs)))
 (printf "... got it.\n")
 
@@ -107,7 +107,7 @@
                          #hash((x-amz-storage-class . "REDUCED_REDUNDANCY")
                                (x-amz-acl . "public-read"))))
     (unless (member (extract-http-code s) '(200))
-      (printf "put failed for ~s: ~s\n" p s)))
+      (error 'sync-one "put failed for ~s: ~s" p s)))
 
   (unless (set-member? old-content (at-checksum now))
     (put (at-bucket&checksum now)
@@ -125,7 +125,7 @@
 
   (define s (delete p))
   (unless (member (extract-http-code s) '(200 204))
-    (printf "delete failed for ~s: ~s\n" p s)))
+    (error 'purge-one "delete failed for ~s: ~s" p s)))
 
 ;; Update the package catalog:
 (define (update-catalog the-email the-password the-post)
@@ -202,12 +202,12 @@
                        (add-tag v "main-tests")]
                       [else v])))))])
   (unless (zero? (hash-count changed-pkgs))
-    (printf "Updating catalog:\n")
+    (printf "Updating catalog at ~a:\n" dest-catalog)
     (for ([k (in-hash-keys changed-pkgs)])
       (printf "  ~a\n" k))
     (define r (update-catalog catalog-email catalog-password changed-pkgs))
     (unless (equal? r #t)
-      (printf "unexpected result from catalog update: ~s\n" r))))
+      (error 'update "unexpected result from catalog update: ~s" r))))
 (printf "Catalog updated\n")
 
 ;; Look for files that can be discarded: