aboutsummaryrefslogtreecommitdiff
path: root/scripts/nar-herder.in
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/nar-herder.in')
-rw-r--r--scripts/nar-herder.in61
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)