diff options
author | Christopher Baines <mail@cbaines.net> | 2023-03-03 16:40:24 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-03-03 16:40:24 +0000 |
commit | bb0fa5697d51fdf3e34e2febbccd657f6c677f98 (patch) | |
tree | d7b2425637df0ac5ef1e2bc55422e15e984338b2 /guix-qa-frontpage/manage-patch-branches.scm | |
parent | 39e9ec627faca95a7b43ff91e195ca9ab9846bf3 (diff) | |
download | qa-frontpage-bb0fa5697d51fdf3e34e2febbccd657f6c677f98.tar qa-frontpage-bb0fa5697d51fdf3e34e2febbccd657f6c677f98.tar.gz |
Improve checking for patch branches to delete
Lock the repository for shorter periods, and only when necessary. Plus improve
exception handling and logging.
Diffstat (limited to 'guix-qa-frontpage/manage-patch-branches.scm')
-rw-r--r-- | guix-qa-frontpage/manage-patch-branches.scm | 78 |
1 files changed, 42 insertions, 36 deletions
diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm index c15f843..c1cd819 100644 --- a/guix-qa-frontpage/manage-patch-branches.scm +++ b/guix-qa-frontpage/manage-patch-branches.scm @@ -223,46 +223,52 @@ (let ((issue-numbers (map string->number (issue-numbers-for-branches)))) - (with-bare-git-repository - (lambda () - (simple-format #t "checking for branches to delete\n") - (for-each - (lambda (issue-number) - (when (or (if (not (mumi-issue-open? issue-number)) - (begin (simple-format (current-error-port) - "Removing ~A, issue closed\n" - issue-number) + (simple-format #t "checking for branches to delete (looking at ~A branches)\n" + (length issue-numbers)) + (for-each + (lambda (issue-number) + (when (or (if (not (mumi-issue-open? issue-number)) + (begin (simple-format (current-error-port) + "Removing ~A, issue closed\n" + issue-number) + #t) + #f) + (let ((base-commit + (assq-ref + (get-issue-branch-base-and-target-refs issue-number) + 'base))) + (with-exception-handler + (lambda (exn) + (if (and + (guix-data-service-error? exn) + (= (guix-data-service-error-response-code exn) + 404)) + (begin + (simple-format + (current-error-port) + "Removing ~A, base revision (~A) gone\n" + issue-number + base-commit) #t) - #f) - (let ((base-commit - (assq-ref - (get-issue-branch-base-and-target-refs issue-number) - 'base))) - (with-exception-handler - (lambda (exn) - (if (and - (guix-data-service-error? exn) - (= (guix-data-service-error-response-code exn) - 404)) - (begin - (simple-format - (current-error-port) - "Removing ~A, base revision (~A) gone\n" - issue-number - base-commit) - #t) - #f)) - (lambda () - (revision-details - (revision-details-url base-commit)) - #f) - #:unwind? #t))) - + (begin + (simple-format + (current-error-port) + "warning: exception when fetching revision details: ~A\n" + exn) + #f))) + (lambda () + (revision-details + (revision-details-url base-commit)) + #f) + #:unwind? #t))) + + (with-bare-git-repository + (lambda () (run "git" "push" "patches" "--delete" (simple-format #f "base-for-issue-~A" issue-number)) (run "git" "push" "patches" "--delete" - (simple-format #f "issue-~A" issue-number)))) - issue-numbers)))) + (simple-format #f "issue-~A" issue-number)))))) + issue-numbers)) (simple-format #t "finished checking for branches to delete\n") (let* ((all-patchwork-series |