Avoid jsonp entirely. Matches pkg-index commit 9f78e88.

src/json-rpc.rkt

@@ -0,0 +1,46 @@
+#lang racket/base
+;; Trivially simple authenticated JSON-over-HTTPS RPC.
+
+(provide simple-json-rpc!)
+
+(require racket/port)
+(require net/url)
+(require net/base64)
+(require json)
+(require "sessions.rkt")
+
+(define (make-basic-auth-credentials-header username password)
+  (define token
+    (base64-encode (string->bytes/utf-8 (string-append username ":" password)) #""))
+  (string-append "Authorization: Basic " (bytes->string/utf-8 token)))
+
+(define (simple-json-rpc! #:sensitive? [sensitive? #f]
+                          #:include-credentials? [include-credentials? #t]
+                          baseurl
+                          site-relative-url
+                          jsexpr-to-send)
+  (define s (current-session))
+  (if sensitive?
+      (log-info "simple-json-rpc: sensitive request ~v" site-relative-url)
+      (log-info "simple-json-rpc: request ~v params ~v~a"
+                site-relative-url
+                jsexpr-to-send
+                (if include-credentials?
+                    (if s
+                        " +creds"
+                        " +creds(missing)")
+                    "")))
+  (define request-urls (format "~a~a" baseurl site-relative-url))
+  (define request-url (string->url request-urls))
+  (define post-data (string->bytes/utf-8 (jsexpr->string jsexpr-to-send)))
+  (define req-headers
+    (if include-credentials?
+        (list (make-basic-auth-credentials-header (session-email s)
+                                                  (session-password s)))
+        '()))
+  (define response-port (post-pure-port request-url post-data req-headers))
+  (define raw-response (port->string response-port))
+  (close-input-port response-port)
+  (define reply (string->jsexpr raw-response))
+  (unless sensitive? (log-info "simple-json-rpc: reply ~v" reply))
+  reply)

src/jsonp-client.rkt

@@ -1,109 +0,0 @@
-#lang racket/base
-
-(provide jsonp-baseurl
-         jsonp-rpc!
-         simple-json-rpc!)
-
-(require racket/match)
-(require racket/format)
-(require racket/port)
-(require net/url)
-(require net/uri-codec)
-(require net/base64)
-(require json)
-(require "sessions.rkt")
-
-(define jsonp-baseurl (make-parameter #f))
-
-(define (make-basic-auth-credentials-header username password)
-  (define token
-    (base64-encode (string->bytes/utf-8 (string-append username ":" password)) #""))
-  (string-append "Authorization: Basic " (bytes->string/utf-8 token)))
-
-(define (jsonp-rpc! #:sensitive? [sensitive? #f]
-                    #:include-credentials? [include-credentials? #t]
-                    #:post-data [post-data #f]
-                    site-relative-url
-                    original-parameters)
-  (define s (current-session))
-  (if sensitive?
-      (log-info "jsonp-rpc: sensitive request ~a" site-relative-url)
-      (log-info "jsonp-rpc: request ~a params ~a~a~a"
-                site-relative-url
-                original-parameters
-                (if post-data
-                    (format " post-data: ~v" post-data)
-                    "")
-                (if include-credentials?
-                    (if s
-                        " +creds"
-                        " +creds(missing)")
-                    "")))
-  (define stamp (~a (inexact->exact (truncate (current-inexact-milliseconds)))))
-  (define callback-label (format "callback~a" stamp))
-  (define extraction-expr (format "^callback~a\\((.*)\\);$" stamp))
-  (define parameters (cons (cons 'callback callback-label) original-parameters))
-  (define baseurl (or (jsonp-baseurl) (error 'jsonp-rpc! "jsonp-baseurl is not set")))
-  (define request-urls
-    (format "~a~a?~a"
-             baseurl
-             site-relative-url
-             (alist->form-urlencoded parameters)))
-  (define request-url (string->url request-urls))
-  (define req-headers
-    (if include-credentials?
-        (list
-         (make-basic-auth-credentials-header (session-email s)
-                                             (session-password s)))
-        null))
-  (define-values (body-port response-headers)
-    (if post-data
-        (values (post-pure-port request-url
-                                post-data
-                                req-headers)
-                'unknown-response-headers-because-post-pure-port-doesnt-return-them)
-        (get-pure-port/headers request-url
-                               req-headers)))
-  (define raw-response (port->string body-port))
-  (close-input-port body-port)
-  (match raw-response
-    [(pregexp extraction-expr (list _ json))
-     (define reply (string->jsexpr json))
-     (unless sensitive? (log-info "jsonp-rpc: reply ~a" reply))
-     reply]
-    [x
-     (error 'jsonp-rpc! "Illegal response to ~v: ~v"
-            (if sensitive? "REDACTED" request-urls)
-            (if sensitive? "REDACTED" raw-response))]))
-
-(define (simple-json-rpc! #:sensitive? [sensitive? #f]
-                          #:include-credentials? [include-credentials? #t]
-                          site-relative-url
-                          jsexpr-to-send)
-  (define s (current-session))
-  (if sensitive?
-      (log-info "simple-json-rpc: sensitive request ~v" site-relative-url)
-      (log-info "simple-json-rpc: request ~v params ~v~a"
-                site-relative-url
-                jsexpr-to-send
-                (if include-credentials?
-                    (if s
-                        " +creds"
-                        " +creds(missing)")
-                    "")))
-  (define baseurl
-    (or (jsonp-baseurl) (error 'simple-json-rpc! "jsonp-baseurl is not set")))
-  (define request-urls (format "~a~a" baseurl site-relative-url))
-  (define request-url (string->url request-urls))
-  (define post-data (string->bytes/utf-8 (jsexpr->string jsexpr-to-send)))
-  (define req-headers
-    (if include-credentials?
-        (list (make-basic-auth-credentials-header (session-email s)
-                                                  (session-password s)))
-        '()))
-  (define response-port (post-pure-port request-url post-data req-headers))
-  (define raw-response (port->string response-port))
-  (close-input-port response-port)
-  (define reply (string->jsexpr raw-response))
-  (unless sensitive? (log-info "simple-json-rpc: reply ~v" reply))
-  reply)

src/site.rkt

@@ -22,7 +22,7 @@
 (require "html-utils.rkt")
 (require "packages.rkt")
 (require "sessions.rkt")
-(require "jsonp-client.rkt")
+(require "json-rpc.rkt")
 (require reloadable)
 (require "daemon.rkt")
 (require "config.rkt")
@@ -158,8 +158,7 @@
                                  (format "PkgSiteStaticBaseUrl = '~a';" static-urlprefix)
                                  (format "IsStaticPage = ~a;" (if (rendering-static-page?)
                                                                   "true"
-                                                                  "false"))))
+                                                                  "false")))))
-                 (jsonp-baseurl backend-baseurl))
     body ...))
 
 (define clear-session-cookie (make-cookie COOKIE
@@ -352,6 +351,7 @@
 (define (authenticate-with-server! email password code)
   (simple-json-rpc! #:sensitive? #t
                     #:include-credentials? #f
+                    backend-baseurl
                     "/api/authenticate"
                     (hash 'email email
                           'passwd password
@@ -1169,7 +1169,7 @@
                             (a ((class "btn btn-default")
                                 (href ,k-url))
                                "Confirm deletion")))))
-   (jsonp-rpc! "/jsonp/package/del" `((pkg . ,package-name-str)))
+   (simple-json-rpc! backend-baseurl "/api/package/del" (hash 'pkg package-name-str))
    (define completion-ch (make-channel))
    (delete-package! completion-ch (string->symbol package-name-str))
    (channel-get completion-ch)
@@ -1262,16 +1262,11 @@
   (define source (unparse-package-source (cadr default-version)))
   (define versions (remove default-version versions/default))
   (define old-pkg (package-detail (string->symbol old-name)))
-  ;; name, description, and default source are updateable via /jsonp/package/modify.
-  ;; tags are added and removed via /jsonp/package/tag/add and .../del.
-  ;; authors are added and removed via /jsonp/package/author/add and .../del.
-  ;; versions other than default are added and removed via /jsonp/package/version/add and .../del.
-  ;;
-  ;; modify-all incorporates all the add/delete stuff into a single API call.
   (and (or (equal? old-name name)
            ;; Don't let renames stomp on existing packages
            (not (package-detail (string->symbol name))))
-       (eq? #t (simple-json-rpc! "/api/package/modify-all"
+       (eq? #t (simple-json-rpc! backend-baseurl
+                                 "/api/package/modify-all"
                                  (hash 'pkg old-name
                                        'name name
                                        'description description
@@ -1345,7 +1340,7 @@
 (define (update-my-packages-page request)
   (authentication-wrap/require-login
    #:request request
-   (jsonp-rpc! "/jsonp/update" '())
+   (simple-json-rpc! backend-baseurl "/api/update" (hash))
    (bootstrap-response "Refresh All My Packages"
                        `(div
                          (p "All packages where you are listed as an author are now being rescanned.")
@@ -1361,8 +1356,10 @@
   (authentication-wrap/require-login
    #:request request
    (when (session-curator? (current-session))
-     (when (jsonp-rpc! "/jsonp/package/curate" `((pkg . ,package-name-str)
+     (when (simple-json-rpc! backend-baseurl
-                                                 (ring . ,(number->string new-ring))))
+                             "/api/package/curate"
+                             (hash 'pkg package-name-str
+                                   'ring new-ring))
        (define old-pkg (package-detail (string->symbol package-name-str)))
        (let* ((new-pkg (hash-set old-pkg 'ring new-ring))
               (completion-ch (make-channel)))