diff options
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/nar-herder.in | 90 |
1 files changed, 65 insertions, 25 deletions
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index ce91fcd..a0e3127 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -149,8 +149,8 @@ (string->number arg)) (alist-delete 'storage-limit result)))) - ;; stored-on=https://other-nar-herder-server - ;; stored-on=https://other-nar-herder-server&stored-on=https://different-server + ;; (stored-on https://other-nar-herder-server) + ;; and=((stored-on https://other-nar-herder-server) (stored-on https://different-server)) (option '("storage-nar-removal-criteria") #t #f (lambda (opt name arg result) (alist-cons 'storage-nar-removal-criteria @@ -403,27 +403,66 @@ (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"))))) + + (define (check-size! file size) + (let ((actual-size (stat:size (stat file)))) + (unless (= size actual-size) + (error + (simple-format + #f + "error importing ~A, ~A should be ~A bytes but is ~A" + narinfo-file + file + size + actual-size))))) + + (database-insert-narinfo + database + narinfo + #:tags (or (assq-ref opts 'tags) + '())) + + (when canonical-storage + (for-each + (lambda (uri size) + (let* ((nar-path + (uri-decode (uri-path uri))) + (source + (string-append + (dirname narinfo-file) "/" nar-path))) + (if (string=? canonical-storage + (dirname narinfo-file)) + (check-size! source size) + (let ((dest + (string-append + canonical-storage "/" nar-path))) + (check-size! source size) + (simple-format (current-error-port) + "moving ~A to ~A\n" + source dest) + (rename-file source dest) + ;; Re-check file size + (check-size! dest size))))) + (narinfo-uris narinfo) + (narinfo-file-sizes narinfo))) + + (report) + + narinfo)) + narinfos))) (when (assq-ref opts 'ensure-references-exist) (for-each @@ -514,8 +553,9 @@ ;; that'll stop these files appearing in narinfos (database-remove-cached-narinfo-file database - narinfo-id - (symbol->string compression))) + (assq-ref narinfo-details 'id) + (symbol->string + (assq-ref cached-narinfo-details 'compression)))) cached-narinfo-files) (database-remove-narinfo database store-path)) |