diff options
author | Christopher Baines <mail@cbaines.net> | 2021-05-28 14:25:20 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-05-28 14:25:20 +0100 |
commit | c9d71251dc979dc220864a099c4c0fdad5cd0fa2 (patch) | |
tree | bde0f81913382588e647a0beca8b70017cb34973 /guix-build-coordinator/utils.scm | |
parent | 96b8a18412f7fb3c68c94f7cdc683f7139e2dc29 (diff) | |
download | build-coordinator-c9d71251dc979dc220864a099c4c0fdad5cd0fa2.tar build-coordinator-c9d71251dc979dc220864a099c4c0fdad5cd0fa2.tar.gz |
Tune sending files over HTTP
Guile's garbage collector interferes with Guile+gnutls, which means that
sending files while the garbage collector is active is difficult.
These changes try to work around this by disabling the garbage collector just
as the data is being written, then enabling it again. I think this helps to
work around the issue.
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 |