diff options
Diffstat (limited to 'scripts/nar-herder.in')
| -rw-r--r-- | scripts/nar-herder.in | 114 |
1 files changed, 75 insertions, 39 deletions
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index 67515dc..7f5db5c 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -391,37 +391,61 @@ (assq-ref opts 'arguments))) (len (length narinfos)) (progress - (progress-reporter/bar len - (format #f "importing ~a narinfos" - len) - (current-error-port)))) + (if (= 1 len) + progress-reporter/silent + (progress-reporter/bar len + (format #f "importing ~a narinfos" + len) + (current-error-port))))) (call-with-progress-reporter progress (lambda (report) (database-call-with-transaction database (lambda (db) - (let ((read-narinfos - (map - (lambda (narinfo-file) - (let ((narinfo - (call-with-input-file narinfo-file - (lambda (port) - ;; Set url to a dummy value as this doesn't - ;; matter - (read-narinfo port - "https://narherderdummyvalue"))))) - - (database-insert-narinfo - database - narinfo - #:tags (or (assq-ref opts 'tags) - '())) - - (report) - - narinfo)) - narinfos))) + (let* ((canonical-storage + (and=> (assq-ref opts 'storage) + canonicalize-path)) + (read-narinfos + (map + (lambda (narinfo-file) + (let ((narinfo + (call-with-input-file narinfo-file + (lambda (port) + ;; Set url to a dummy value as this doesn't + ;; matter + (read-narinfo port + "https://narherderdummyvalue"))))) + + (when canonical-storage + (for-each + (lambda (uri) + (unless (string=? canonical-storage + (dirname narinfo-file)) + (let ((source + (string-append + (dirname narinfo-file) + "/" (uri-decode (uri-path uri)))) + (dest + (string-append + canonical-storage + "/" (uri-decode (uri-path uri))))) + (simple-format (current-error-port) + "moving ~A to ~A\n" + source dest) + (rename-file source dest)))) + (narinfo-uris narinfo))) + + (database-insert-narinfo + database + narinfo + #:tags (or (assq-ref opts 'tags) + '())) + + (report) + + narinfo)) + narinfos))) (when (assq-ref opts 'ensure-references-exist) (for-each @@ -443,7 +467,9 @@ "missing reference to ~A\n" reference)))) (narinfo-references narinfo)))) - read-narinfos)))))))))) + read-narinfos))))))) + (when (= 1 len) + (simple-format (current-error-port) "imported narinfo\n"))))) (("remove" rest ...) (let* ((opts (parse-options %base-options %base-option-defaults @@ -458,11 +484,14 @@ (port-log (make <port-log> #:port (current-output-port) #:formatter - (lambda (lvl time str) + ;; In guile-lib v0.2.8 onwards, the formatter is + ;; called with more arguments + (lambda args ; lvl, time, str (format #f "~a (~5a): ~a~%" - (strftime "%F %H:%M:%S" (localtime time)) - lvl - str))))) + (strftime "%F %H:%M:%S" (localtime + (second args))) + (first args) + (third args)))))) (add-handler! lgr port-log) (open-log! lgr) @@ -524,11 +553,14 @@ (port-log (make <port-log> #:port (current-output-port) #:formatter - (lambda (lvl time str) + ;; In guile-lib v0.2.8 onwards, the formatter is + ;; called with more arguments + (lambda args ; lvl, time, str (format #f "~a (~5a): ~a~%" - (strftime "%F %H:%M:%S" (localtime time)) - lvl - str)))) + (strftime "%F %H:%M:%S" (localtime + (second args))) + (first args) + (third args))))) (metrics-registry (make-metrics-registry #:namespace "narherder"))) @@ -567,11 +599,14 @@ (port-log (make <port-log> #:port (current-output-port) #:formatter - (lambda (lvl time str) + ;; In guile-lib v0.2.8 onwards, the formatter is + ;; called with more arguments + (lambda args ; lvl, time, str (format #f "~a (~5a): ~a~%" - (strftime "%F %H:%M:%S" (localtime time)) - lvl - str))))) + (strftime "%F %H:%M:%S" (localtime + (second args))) + (first args) + (third args)))))) (add-handler! lgr port-log) (open-log! lgr) @@ -602,4 +637,5 @@ (lambda (port) (simple-format port "~A\n" (getpid)))))) - (run-nar-herder-service opts lgr)))) + (with-fluids ((%file-port-name-canonicalization 'none)) + (run-nar-herder-service opts lgr))))) |