diff --git a/src/jsonp-client.rkt b/src/jsonp-client.rkt index c8e152e..0c5f22f 100644 --- a/src/jsonp-client.rkt +++ b/src/jsonp-client.rkt @@ -44,12 +44,12 @@ (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-url - (string->url - (format "~a~a?~a" + (define request-urls + (format "~a~a?~a" baseurl site-relative-url - (alist->form-urlencoded parameters)))) + (alist->form-urlencoded parameters))) + (define request-url (string->url request-urls)) (define req-headers (if include-credentials? (list @@ -65,10 +65,16 @@ (get-pure-port/headers request-url req-headers))) (define raw-response (port->string body-port)) - (match-define (pregexp extraction-expr (list _ json)) raw-response) - (define reply (string->jsexpr json)) - (unless sensitive? (log-info "jsonp-rpc: reply ~a" reply)) - reply) + (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] @@ -96,6 +102,9 @@ (session-password s))) '())) (define raw-response (port->string (post-pure-port request-url post-data req-headers))) + (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) diff --git a/src/packages.rkt b/src/packages.rkt index 3737a5e..dac9110 100644 --- a/src/packages.rkt +++ b/src/packages.rkt @@ -57,8 +57,10 @@ (lambda (e) ((error-display-handler) (exn-message e) e) #f)]) - (define response-bytes - (port->bytes (get-pure-port (string->url package-index-url)))) + (define response-port + (get-pure-port (string->url package-index-url))) + (define response-bytes (port->bytes response-port)) + (close-input-port response-port) (define decompressed (gunzip/bytes response-bytes)) (define decoded (bytes->jsexpr decompressed)) decoded)) diff --git a/src/site.rkt b/src/site.rkt index a93bddd..9941a5e 100644 --- a/src/site.rkt +++ b/src/site.rkt @@ -1396,9 +1396,11 @@ package-name (exn->string e)) "")]) - (port->string - (get-pure-port (string->url (@ default-version source_url)) - #:redirections 10))))) + (define the-port + (get-pure-port (string->url (@ default-version source_url)) + #:redirections 10)) + (begin0 (port->string the-port) + (close-input-port the-port))))) ;;(log-info "CONTENTS: ~a === ~a" (@ default-version source_url) contents) (if (regexp-match? #px"(?i:id=.readme.)" contents) (let ((readme-url (string-append (@ default-version source_url) "#readme")))