diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-09-11 12:34:50 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-09-12 13:11:00 +0100 |
| commit | 27e6906e188da98ce06e755c079e852bc01c770d (patch) | |
| tree | f6cb00c1513e549d0342f09993221597fca8372b | |
| parent | 69fff1fc640257b8f5338810f572b209318f5554 (diff) | |
| download | nar-herder-27e6906e188da98ce06e755c079e852bc01c770d.tar nar-herder-27e6906e188da98ce06e755c079e852bc01c770d.tar.gz | |
Make sure to use streaming http requests everywhere
As this avoids blocking.
| -rw-r--r-- | nar-herder/mirror.scm | 10 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 10 |
2 files changed, 11 insertions, 9 deletions
diff --git a/nar-herder/mirror.scm b/nar-herder/mirror.scm index 594a163..4ccf878 100644 --- a/nar-herder/mirror.scm +++ b/nar-herder/mirror.scm @@ -83,14 +83,13 @@ (open-socket-for-uri* uri))) (http-get uri #:port port - #:decode-body? #f))) + #:streaming? #t))) #:timeout 30)) #:times 3 #:delay 15)) (lambda (response body) (if (= (response-code response) 200) - (let* ((json-body (json-string->scm - (utf8->string body))) + (let* ((json-body (json->scm body)) (recent-changes (assoc-ref json-body "recent_changes"))) @@ -158,10 +157,9 @@ recent-changes)) (raise-exception (make-exception-with-message - (simple-format #f "unknown response: ~A\n code: ~A response: ~A" + (simple-format #f "unknown response: ~A code: ~A" (uri->string uri) - (response-code response) - (utf8->string body)))))))) + (response-code response)))))))) (spawn-fiber (lambda () diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index 18fe6d5..247eeef 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -36,6 +36,7 @@ (srfi srfi-19) (srfi srfi-37) (srfi srfi-43) + (srfi srfi-71) (ice-9 ftw) (ice-9 match) (ice-9 format) @@ -480,9 +481,12 @@ (lambda () (simple-format (current-error-port) "starting downloading the database\n") - (http-get database-uri - #:decode-body? #f - #:streaming? #t)) + (let ((port + socket + (open-socket-for-uri* database-uri))) + (http-get database-uri + #:port port + #:streaming? #t))) (lambda (response body) (when (not (= (response-code response) 200)) (error "unable to fetch database from mirror")) |