Move nars to storage when importing narinfosHEADmaster

If they're not in the storage directory.

1 files changed, 43 insertions, 21 deletions

diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index ce91fcd..87b3f0e 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -403,27 +403,49 @@
            (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-string)
+                                (unless (string=? canonical-storage
+                                                  (dirname narinfo-file))
+                                  (let ((source
+                                         (string-append
+                                          (dirname narinfo-file)
+                                          "/" (uri-decode uri-string)))
+                                        (dest
+                                         (string-append
+                                          canonical-storage
+                                          "/" (uri-decode uri-string))))
+                                    (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