diff options
author | Christopher Baines <mail@cbaines.net> | 2021-05-29 23:42:06 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-05-29 23:42:06 +0100 |
commit | 8258e9c8d9f729b2670a602c523c59847b676b1a (patch) | |
tree | d0639661925db50c13711249aad6e07ad304cd33 /guix-build-coordinator/utils.scm | |
parent | f8bbd0d88cc251015eb255aecee5439fce481461 (diff) | |
download | build-coordinator-8258e9c8d9f729b2670a602c523c59847b676b1a.tar build-coordinator-8258e9c8d9f729b2670a602c523c59847b676b1a.tar.gz |
Further tweak sending chunked HTTP requests
Don't compress then send, since I think compression can be slower than
sending, so doing both at the same time is probably faster. Add
make-chunked-output-port* which might be more efficient than the Guile chunked
output port, will disable garbage collection to avoid issues with GnuTLS and
will try to force the garbage collector to run if there's garbage building up.
Diffstat (limited to 'guix-build-coordinator/utils.scm')
-rw-r--r-- | guix-build-coordinator/utils.scm | 67 |
1 files changed, 37 insertions, 30 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index b221199..9887d05 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -6,6 +6,7 @@ #:use-module (ice-9 q) #:use-module (ice-9 ftw) #:use-module (ice-9 popen) + #:use-module (ice-9 iconv) #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 threads) @@ -254,30 +255,41 @@ upcoming chunk." '()))) (define (with-gc-protection thunk) - (monitor - (dynamic-wind - gc-disable - thunk - gc-enable))) - -(define (make-gc-guard-port port) - (define (%put-char c) - (write c port)) + (dynamic-wind + gc-disable + thunk + gc-enable)) +(define* (make-chunked-output-port* port #:key (keep-alive? #f) + (buffering 1200)) (define (%put-string s) - (display s port)) + (let ((length (string-length s))) + (unless (eq? length 0) + (with-gc-protection + (lambda () + (put-string port (number->string length 16)) + (put-string port "\r\n") + (write s port) + (put-string port "\r\n")))))) + (define (%put-char c) + (%put-string (list->string (list c)))) (define (flush) + (force-output port)) + (define (safe-flush) + (with-gc-protection flush)) + (define (close) (with-gc-protection (lambda () - (force-output port)))) - - (define (close) - (close-port port)) - - (make-soft-port - (vector %put-char %put-string flush #f close) - "w")) + (flush) + (put-string port "0\r\n\r\n") + (force-output port) + (unless keep-alive? + (close-port port))))) + (let ((ret (make-soft-port + (vector %put-char %put-string safe-flush #f close) "w"))) + (setvbuf ret 'block buffering) + ret)) (define* (call-with-streaming-http-request uri callback #:key (headers '())) @@ -294,7 +306,7 @@ upcoming chunk." #:port port))) (set-port-encoding! port "ISO-8859-1") - (setvbuf port 'block 65536) + (setvbuf port 'block (expt 2 13)) (with-exception-handler (lambda (exp) (simple-format #t "error: PUT ~A: ~A\n" (uri-path uri) exp) @@ -302,14 +314,11 @@ upcoming chunk." (raise-exception exp)) (lambda () (let ((request (write-request request port))) - (let ((chunked-output-port - (make-gc-guard-port - (make-chunked-output-port + (let* ((chunked-output-port + (make-chunked-output-port* port - #:buffering 65536 - #:keep-alive? #t)))) - - (setvbuf chunked-output-port 'block 1048576) + #:buffering (expt 2 12) + #:keep-alive? #t))) ;; A SIGPIPE will kill Guile, so ignore it (sigaction SIGPIPE @@ -318,12 +327,10 @@ upcoming chunk." (set-port-encoding! chunked-output-port "ISO-8859-1") (callback chunked-output-port) + (close-port chunked-output-port) + (with-gc-protection (lambda () - (close-port chunked-output-port) - (display "\r\n" port) - (force-output port) - (let ((response (read-response port))) (let ((body (read-response-body response))) (close-port port) |