Add uploading

collects/meta/pkg-index/official/upload-example.rktd

@@ -0,0 +1,6 @@
+#hash(("parenlog"
+       . #hasheq((description
+                  . "A language that is like Prolog, but parenthetical!")
+                 (versions
+                  . #hash(("5.3.4.11"
+                           . #hasheq((source . "github://github.com/jeapostrophe/parenlog/old"))))))))

collects/meta/pkg-index/official/upload.rkt

@@ -0,0 +1,32 @@
+#lang racket/base
+(require racket/list
+         net/url
+         racket/port)
+
+(define (upload! the-email the-password the-post)
+  (define the-url
+    (url "https" #f "pkg.racket-lang.org" #f #t
+         (list (path/param "api" empty)
+               (path/param "upload" empty))
+         empty
+         #f))
+  (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))
+  (read (open-input-bytes bs)))
+
+(module+ main
+  (require racket/cmdline)
+  (command-line #:program "upload"
+                #:args (email password)
+                (if (upload! email password
+                             (read (current-input-port)))
+                  (exit 0)
+                  (exit 1))))

pkgs/plt-services/meta/pkg-index/basic/main.rkt

@@ -69,6 +69,9 @@
 
 (provide
  (contract-out
+  [response/sexpr
+   (-> any/c
+       response?)]
   [request-binding/string
    (->* (request? string?)
         (boolean?)

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

@@ -118,8 +118,40 @@
    [("curate") page/curate]
    [("curate" "edit" (string-arg) (number-arg)) page/curate/edit]
    [("rss") page/rss]
+   [("api" "upload") #:method "post" api/upload]
    [else basic-start]))
 
+(define (api/upload req)
+  (define req-data (read (open-input-bytes (or (request-post-data/raw req) #""))))
+  (match-define (list email given-password pis) req-data)
+  (define password-path (build-path users.new-path email))
+  (define expected-password (file->bytes password-path))
+  (cond
+    [(not (and (bcrypt-check expected-password given-password)
+               (curation-administrator? email)))
+     (response/sexpr #f)]
+    [else
+     (for ([(p more-pi) (in-hash pis)])
+       (define pi (package-info p))
+       (define new-pi (hash-deep-merge pi more-pi))
+       (package-info-set! p new-pi)
+       (thread (λ () (update-checksum #t p))))
+     (response/sexpr #t)]))
+
+(define (hash-deep-merge ht more-ht)
+  (for/fold ([ht ht])
+      ([(k new-v) (in-hash more-ht)])
+    (hash-update ht k 
+                 (λ (old-v)
+                   (cond
+                     [(not old-v) 
+                      new-v]
+                     [(hash? old-v)
+                      (hash-deep-merge old-v new-v)]
+                     [else
+                      new-v]))
+                 #f)))
+
 (define (author->list as)
   (string-split as))
 
@@ -848,7 +880,6 @@
 (define (update-checksums force? pkgs)
   (for-each (curry update-checksum force?) pkgs))
 
-;; xxx look at all versions
 (define (update-checksum force? pkg-name)
   (define i (package-info pkg-name))
   (define old-checksum
@@ -905,7 +936,7 @@
 
 ;; Curation
 (define (curation-administrator? u)
-  (member u '("jay.mccarthy@gmail.com")))
+  (member u '("jay.mccarthy@gmail.com" "mflatt@cs.utah.edu")))
 
 (define *default-ring* 2)
 (define (ring-format i)