diff options
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 4 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 40 |
2 files changed, 37 insertions, 7 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 70b4bb7..da5c682 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -311,7 +311,7 @@ (with-time-logging (simple-format #f "sending ~A" file) (dump-port file-port port - #:buffer-size (expt 2 20)))) + #:buffer-size 32768))) #:headers `((Authorization . ,auth-value))))) (when (>= (response-code response) 400) (raise-exception @@ -365,7 +365,7 @@ (call-with-input-file file (lambda (file-port) (dump-port file-port request-port - #:buffer-size (expt 2 20))) + #:buffer-size 32768)) #:binary #t)) #:headers `((Authorization . ,auth-value))))) (if (>= (response-code response) 400) diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 31a4909..0f51a20 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -251,6 +251,33 @@ upcoming chunk." (parse-query-string query)) '()))) +(define (with-gc-protection thunk) + (monitor + (gc-disable) + (thunk) + (gc-enable))) + +(define (make-gc-guard-port port) + (define (%put-char c) + (write c port)) + + (define (%put-string s) + (display s port)) + + (define (flush) + (with-gc-protection + (lambda () + (force-output port)))) + + (define (close) + (with-gc-protection + (lambda () + (close-port port)))) + + (make-soft-port + (vector %put-char %put-string flush #f close) + "w")) + (define* (call-with-streaming-http-request uri callback #:key (headers '())) (let* ((port (open-socket-for-uri uri)) @@ -266,7 +293,7 @@ upcoming chunk." #:port port))) (set-port-encoding! port "ISO-8859-1") - (setvbuf port 'block (expt 2 20)) + (setvbuf port 'block 32768) (with-exception-handler (lambda (exp) (simple-format #t "error: PUT ~A: ~A\n" (uri-path uri) exp) @@ -275,10 +302,13 @@ upcoming chunk." (lambda () (let ((request (write-request request port))) (let ((chunked-output-port - (make-chunked-output-port - port - #:buffering (expt 2 20) - #:keep-alive? #t))) + (make-gc-guard-port + (make-chunked-output-port + port + #:buffering 32768 + #:keep-alive? #t)))) + + (setvbuf chunked-output-port 'block 32768) ;; A SIGPIPE will kill Guile, so ignore it (sigaction SIGPIPE |