diff options
Diffstat (limited to 'scripts/nar-herder.in')
-rw-r--r-- | scripts/nar-herder.in | 61 |
1 files changed, 32 insertions, 29 deletions
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index ac3002b..e9d3150 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -474,35 +474,38 @@ (string->uri (string-append (assq-ref opts 'mirror) "/latest-database-dump")))) - (call-with-values - (lambda () - (simple-format (current-error-port) - "starting downloading the database\n") - (http-get database-uri - #:decode-body? #f - #:streaming? #t)) - (lambda (response body) - (when (not (= (response-code response) 200)) - (error "unable to fetch database from mirror")) - - (let* ((reporter (progress-reporter/file - (uri->string database-uri) - (response-content-length response) - (current-error-port))) - (port - (progress-report-port - reporter - body - #:download-size (response-content-length response)))) - - (call-with-output-file (assq-ref opts 'database) - (lambda (output-port) - (dump-port port output-port))) - - (close-port port)) - - (simple-format (current-error-port) - "finished downloading the database\n"))))) + (with-fibers-port-timeouts + (lambda () + (call-with-values + (lambda () + (simple-format (current-error-port) + "starting downloading the database\n") + (http-get database-uri + #:decode-body? #f + #:streaming? #t)) + (lambda (response body) + (when (not (= (response-code response) 200)) + (error "unable to fetch database from mirror")) + + (let* ((reporter (progress-reporter/file + (uri->string database-uri) + (response-content-length response) + (current-error-port))) + (port + (progress-report-port + reporter + body + #:download-size (response-content-length response)))) + + (call-with-output-file (assq-ref opts 'database) + (lambda (output-port) + (dump-port port output-port))) + + (close-port port)) + + (simple-format (current-error-port) + "finished downloading the database\n")))) + #:timeout 30))) (add-handler! lgr port-log) (open-log! lgr) |