diff options
Diffstat (limited to 'scripts/nar-herder.in')
-rw-r--r-- | scripts/nar-herder.in | 82 |
1 files changed, 46 insertions, 36 deletions
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index c8726b8..9845e46 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -312,42 +312,52 @@ (call-with-progress-reporter progress (lambda (report) - (for-each (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 (assq-ref opts 'ensure-references-exist) - (let ((self-reference - (store-path-base - (narinfo-path narinfo)))) - (for-each - (lambda (reference) - (when (and - (not - (string=? reference self-reference)) - (not - (database-select-narinfo-by-hash - database - (string-take reference 32)))) - (error - (simple-format (current-error-port) - "missing reference to ~A\n" - reference)))) - (narinfo-references narinfo)))) - - (database-insert-narinfo - database - narinfo - #:tags (or (assq-ref opts 'tags) - '())) - - (report))) - narinfos)))))) + (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))) + + (when (assq-ref opts 'ensure-references-exist) + (for-each + (lambda (narinfo) + (let ((self-reference + (store-path-base + (narinfo-path narinfo)))) + (for-each + (lambda (reference) + (when (and + (not + (string=? reference self-reference)) + (not + (database-select-narinfo-by-hash + database + (string-take reference 32)))) + (error + (simple-format (current-error-port) + "missing reference to ~A\n" + reference)))) + (narinfo-references narinfo)))) + read-narinfos)))))))))) (("remove" rest ...) (let* ((opts (parse-options %base-options %base-option-defaults |