From bbf5119200b844fdb59b54d87fa01cc6abee46c2 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 18 May 2024 18:12:41 +0100 Subject: Move nars to storage when importing narinfos If they're not in the storage directory. --- scripts/nar-herder.in | 64 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 43 insertions(+), 21 deletions(-) (limited to 'scripts') diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index ce91fcd..7f5db5c 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) + (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 -- cgit v1.2.3