diff options
Diffstat (limited to 'guix-build-coordinator/agent-messaging/http.scm')
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 113 |
1 files changed, 51 insertions, 62 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index da5c682..f223f66 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -88,11 +88,6 @@ (string-drop agent-path 1))) #:query query))) -(define (with-request-mutex thunk) - (if (running-on-the-hurd?) - (thunk) - (monitor (thunk)))) - (define (default-log level . components) (apply log-msg level components)) @@ -274,16 +269,14 @@ 1000000) ; 1MB (retry-on-error (lambda () - (with-request-mutex - (lambda () - (call-with-streaming-http-request - uri - (lambda (port) - (call-with-lzip-output-port port - (lambda (port) - (write-file file port)) - #:level 9)) - #:headers `((Authorization . ,auth-value)))))) + (call-with-streaming-http-request + uri + (lambda (port) + (call-with-lzip-output-port port + (lambda (port) + (write-file file port)) + #:level 9)) + #:headers `((Authorization . ,auth-value)))) #:times 6 #:delay 15) (let* ((directory (or (getenv "TMPDIR") "/tmp")) @@ -300,27 +293,25 @@ (log 'INFO "finished compressing " file ", now sending") (retry-on-error (lambda () - (with-request-mutex - (lambda () - (call-with-input-file template - (lambda (file-port) - (let-values (((response body) - (call-with-streaming-http-request - uri - (lambda (port) - (with-time-logging - (simple-format #f "sending ~A" file) - (dump-port file-port port - #:buffer-size 32768))) - #:headers `((Authorization . ,auth-value))))) - (when (>= (response-code response) 400) - (raise-exception - (make-exception-with-message - (coordinator-handle-failed-request log - 'PUT - (uri-path uri) - response - body)))))))))) + (call-with-input-file template + (lambda (file-port) + (let-values (((response body) + (call-with-streaming-http-request + uri + (lambda (port) + (with-time-logging + (simple-format #f "sending ~A" file) + (dump-port file-port port + #:buffer-size 32768))) + #:headers `((Authorization . ,auth-value))))) + (when (>= (response-code response) 400) + (raise-exception + (make-exception-with-message + (coordinator-handle-failed-request log + 'PUT + (uri-path uri) + response + body)))))))) #:times 12 #:delay (random 15)) @@ -356,32 +347,30 @@ (retry-on-error (lambda () - (with-request-mutex - (lambda () - (let-values (((response body) - (call-with-streaming-http-request - uri - (lambda (request-port) - (call-with-input-file file - (lambda (file-port) - (dump-port file-port request-port - #:buffer-size 32768)) - #:binary #t)) - #:headers `((Authorization . ,auth-value))))) - (if (>= (response-code response) 400) - (raise-exception - (make-exception-with-message - (coordinator-handle-failed-request log - 'PUT - (uri-path uri) - response - body))) - (begin - (log 'INFO - "successfully uploaded log file (" - (response-code response) - ")") - #t)))))) + (let-values (((response body) + (call-with-streaming-http-request + uri + (lambda (request-port) + (call-with-input-file file + (lambda (file-port) + (dump-port file-port request-port + #:buffer-size 32768)) + #:binary #t)) + #:headers `((Authorization . ,auth-value))))) + (if (>= (response-code response) 400) + (raise-exception + (make-exception-with-message + (coordinator-handle-failed-request log + 'PUT + (uri-path uri) + response + body))) + (begin + (log 'INFO + "successfully uploaded log file (" + (response-code response) + ")") + #t)))) #:times 12 #:delay (random 15))) args)) |