diff options
Diffstat (limited to 'guix-build-coordinator/utils.scm')
-rw-r--r-- | guix-build-coordinator/utils.scm | 40 |
1 files changed, 35 insertions, 5 deletions
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 |