diff options
Diffstat (limited to 'guix-qa-frontpage/manage-patch-branches.scm')
| -rw-r--r-- | guix-qa-frontpage/manage-patch-branches.scm | 121 |
1 files changed, 38 insertions, 83 deletions
diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm index c3ae256..7cb9cee 100644 --- a/guix-qa-frontpage/manage-patch-branches.scm +++ b/guix-qa-frontpage/manage-patch-branches.scm @@ -17,21 +17,17 @@ #:use-module (guix sets) #:use-module (guix memoization) #:use-module (guix build utils) - #:use-module ((guix build syscalls) - #:select (set-thread-name)) - #:use-module (guix-build-coordinator utils) - #:use-module (guix-build-coordinator utils fibers) #:use-module ((guix build download) #:select (http-fetch)) #:use-module ((guix build utils) #:select (with-directory-excursion)) + #:use-module (knots thread-pool) #:use-module (guix-qa-frontpage mumi) #:use-module (guix-qa-frontpage database) #:use-module (guix-qa-frontpage git-repository) #:use-module (guix-qa-frontpage patchwork) + #:use-module (guix-qa-frontpage branch) #:use-module (guix-qa-frontpage guix-data-service) #:export (create-branch-for-issue - patchwork-series->branch - start-manage-patch-branches-thread get-issue-branch-base-and-target-refs)) @@ -129,65 +125,8 @@ (close-pipe pipe) result)) -(define (parse-patch-name name) - (let ((args - (and - (string-prefix? "[" name) - (let ((stop (string-index name #\]))) - (substring name 1 stop)))) - (as-bug-number - (lambda (arg) - (and (string-prefix? "bug#" arg) - (string->number (substring arg (string-length "bug#")))))) - (as-v2 - (lambda (arg) - (and (string-prefix? "v" arg) - (string->number (substring arg 1))))) - (as-patch-number - (lambda (arg) - (match (string-split arg #\/) - (((= string->number index) (= string->number total)) - (and index total (<= index total) - (cons index total))) - (else #f))))) - (let analyze ((bug-number #f) - (branch "master") - (version 1) - (index 1) - (total 1) - (arguments - (if args - (string-split args #\,) - '()))) - (match arguments - ((or ("") ()) - `((bug-number . ,bug-number) - (branch . ,branch) - (version . ,version) - (index . ,index) - (total . ,total))) - (((= as-bug-number (? number? new-bug-number)) - arguments ...) - (analyze new-bug-number branch version index total arguments)) - (((= as-v2 (? number? new-version)) - arguments ...) - (analyze bug-number branch new-version index total arguments)) - (((= as-patch-number ((? number? new-index) . (? number? new-total))) - arguments ...) - (analyze bug-number branch version new-index new-total arguments)) - ((feature-branch arguments ...) - (analyze bug-number feature-branch version index total arguments)))))) - -(define (patchwork-series->branch series) - (match (assoc-ref series "patches") - (#() "master") - (#(first-patch rest ...) - (let ((details - (parse-patch-name - (assoc-ref first-patch "name")))) - (assq-ref details 'branch))))) - -(define (create-branch-for-issue database issue-number patchwork-series) +(define (create-branch-for-issue database latest-processed-master-revision + issue-number patchwork-series) (define branch-name (simple-format #f "issue-~A" issue-number)) @@ -196,10 +135,9 @@ (define (get-base-commit) (let ((branch - (patchwork-series->branch patchwork-series))) + (assq-ref patchwork-series 'branch))) (if (string=? branch "master") - (get-latest-processed-branch-revision "master") - + latest-processed-master-revision (with-bare-git-repository (lambda () (invoke "git" "fetch" "--prune" "origin") @@ -226,14 +164,16 @@ 'issue-patches-overall-status #:args (list issue-number))) - (define (insert-log results) + (define (insert-log base-commit-hash results) (define log - (string-join - (map - (lambda (patch) - (assq-ref patch 'output)) - results) - "\n\n")) + (string-append + "Using base commit " base-commit-hash "\n\n" + (string-join + (map + (lambda (patch) + (assq-ref patch 'output)) + results) + "\n\n"))) (insert-create-branch-for-issue-log database issue-number log)) @@ -253,7 +193,7 @@ (results '())) (if (null? patch-data) (begin - (insert-log results) + (insert-log base-commit-hash results) (if (string=? base-commit-hash (with-repository (getcwd) repository @@ -304,7 +244,8 @@ (begin (simple-format #t "Failed to apply \"~A.patch\" (~A)\n" id name) - (insert-log new-results) + (insert-log base-commit-hash + new-results) #f))))))))) (delete-create-branch-for-issue-log database issue-number) @@ -385,7 +326,12 @@ #:args `(#:count ,(+ series-count series-count-buffer)) #:ttl 120)) (get-latest-processed-branch-revision* - (memoize get-latest-processed-branch-revision))) + (memoize get-latest-processed-branch-revision)) + (branches + (map (lambda (branch) + (assoc-ref branch "name")) + (list-branches + (list-branches-url %data-service-guix-repository-id))))) ;; Several series can use the same base revision, so memoize looking up ;; the changes compared to master @@ -404,6 +350,7 @@ (simple-format #t "checking for branches to delete (looking at ~A branches)\n" (length issue-numbers)) + (simple-format #t "all branches: ~A\n" branches) (for-each (lambda (issue-number) (when (or (if (not (mumi-issue-open? issue-number)) @@ -424,8 +371,9 @@ (assq-ref (get-issue-branch-base-and-target-refs issue-number) 'base)) - (branch (patchwork-series->branch - (assq-ref all-patchwork-series issue-number)))) + (branch + (assq-ref (assq-ref all-patchwork-series issue-number) + 'branch))) (with-exception-handler (lambda (exn) (if (and (guix-data-service-error? exn) @@ -435,7 +383,11 @@ "query_parameters" "base_commit" "message") (lambda (message) - (string=? message "unknown commit")))) + (string=? message "unknown commit"))) + ;; Don't treat the base revision + ;; as gone if the branch is + ;; unknown + (member branch branches)) (begin (simple-format (current-error-port) @@ -494,7 +446,9 @@ 'latest-patchwork-series-by-issue latest-patchwork-series-by-issue #:args `(#:count ,series-count) - #:ttl 120))) + #:ttl 120)) + (latest-processed-master-revision + (get-latest-processed-branch-revision "master"))) (for-each (match-lambda ((issue-number . patchwork-series) @@ -537,6 +491,7 @@ (const #t) (lambda () (create-branch-for-issue database + latest-processed-master-revision issue-number patchwork-series)) #:unwind? #t)))) @@ -564,7 +519,7 @@ (current-error-port) "exception in manage patch branches thread: ~A\n" exn) - (unless (worker-thread-timeout-error? exn) + (unless (thread-pool-timeout-error? exn) (sleep 240))) (lambda () (with-throw-handler #t |