diff options
| -rw-r--r-- | genenetwork-development.scm | 82 |
1 files changed, 41 insertions, 41 deletions
diff --git a/genenetwork-development.scm b/genenetwork-development.scm index 9e5e242..bc7c8fd 100644 --- a/genenetwork-development.scm +++ b/genenetwork-development.scm @@ -1603,27 +1603,6 @@ delete-test-users, etc.) as the genenetwork user via sudo." #~(begin (use-modules (guix build utils)) - (define* (hline #:optional (char #\=)) - "Print a horizontal line 50 `char' characters long." - (display (make-string 50 char)) - (newline) - (force-output)) - - (define* (show-head-commit #:optional (path #f)) - (hline) - (display (basename (or path (getcwd)))) (newline) - (hline #\-) - (invoke #$(file-append git-minimal "/bin/git") - "-C" (or path (getcwd)) - "--no-pager" "log" "--max-count" "1") - (hline)) - - (show-head-commit #$gn-libs-checkout) - (show-head-commit #$gn-auth-checkout) - (show-head-commit #$gn-guile-checkout) - (show-head-commit #$gn3-checkout) - (show-head-commit #$gn2-checkout) - (setenv "PYTHONPATH" (string-append #$gn-libs-checkout ":" #$gn-auth-checkout ":" @@ -1644,6 +1623,34 @@ delete-test-users, etc.) as the genenetwork user via sudo." (define %gn-auth-test-flask (gn-auth-test-flask %genenetwork-configuration)) +(define %show-commits + ;; A program that takes a list of paths as arguments and prints the HEAD + ;; commit of each path that is a git repository, skipping paths that do + ;; not exist or have no .git directory. Can be invoked directly (for + ;; paths owned by the current user) or via `sudo -u genenetwork' (for + ;; paths owned by the genenetwork user). + (program-file + "show-commits" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (define (hline . args) + (let ((char (if (null? args) #\= (car args)))) + (display (make-string 50 char)) + (newline) + (force-output))) + (for-each + (lambda (path) + (when (and (file-exists? path) + (file-exists? (string-append path "/.git"))) + (hline) + (display (basename path)) (newline) + (hline #\-) + (invoke #$(file-append git-minimal "/bin/git") + "-C" path "--no-pager" "log" "--max-count" "1") + (hline))) + (cdr (program-arguments))))))) + (define (setup-gn-auth-credentials-gexp) #~(let* ((ts (strftime "%Y%m%dT%H%M%SZ" (gmtime (current-time)))) (ufile (string-append "/tmp/gn-test-" ts "-users.json")) @@ -1683,27 +1690,12 @@ delete-test-users, etc.) as the genenetwork user via sudo." (setup '()) (teardown '())) (match-record config <genenetwork-configuration> - (gn-integration-tests-repository) + (gn-integration-tests-repository repositories-checkout-directory) (with-imported-modules '((guix build utils)) (with-packages (list nss-certs git-minimal) #~(begin (use-modules (guix build utils)) - (define* (hline #:optional (char #\=)) - "Print a horizontal line 50 `char' characters long." - (display (make-string 50 char)) - (newline) - (force-output)) - - (define* (show-head-commit #:optional (path #f)) - (hline) - (display (basename (or path (getcwd)))) (newline) - (hline #\-) - (invoke #$(file-append git-minimal "/bin/git") - "-C" (or path (getcwd)) - "--no-pager" "log" "--max-count" "1") - (hline)) - (let* ((orig-dir (getcwd)) (tmp-dir (mkdtemp "/tmp/gn-integration-tests.XXXXXX")) (tests-profile #$(profile @@ -1717,8 +1709,15 @@ delete-test-users, etc.) as the genenetwork user via sudo." (chdir tmp-dir) (invoke #$(file-append git-minimal "/bin/git") "clone" "--depth" "1" #$gn-integration-tests-repository) - (with-directory-excursion "gn-integration-tests" - (show-head-commit)) + ;; Show commit for the freshly-cloned gn-integration-tests repo + ;; (owned by the Laminar user — no sudo needed). + (invoke #$%show-commits (string-append tmp-dir "/gn-integration-tests")) + ;; Show commits for CD-managed repos (owned by genenetwork). + (invoke #$sudo "-u" "genenetwork" #$%show-commits + #$(string-append repositories-checkout-directory "/gn-auth") + #$(string-append repositories-checkout-directory "/gn-libs") + #$(string-append repositories-checkout-directory "/genenetwork3") + #$(string-append repositories-checkout-directory "/genenetwork2")) (chdir "gn-integration-tests") (setenv "GN_INTEGRATION_TESTS_PROFILE" tests-profile) @@ -1789,9 +1788,10 @@ delete-test-users, etc.) as the genenetwork user via sudo." ;; Permit the acme user to restart nginx. "\nacme ALL = NOPASSWD: " (file-append shepherd "/bin/herd") " restart nginx\n" ;; Permit the laminar user to run gn-auth test setup/teardown - ;; commands as the genenetwork user. + ;; commands and show-commits as the genenetwork user. "\nlaminar ALL = (genenetwork) NOPASSWD: " - %gn-auth-test-flask "\n")) + %gn-auth-test-flask ", " + %show-commits "\n")) (services (cons* (service forge-service-type (forge-configuration (projects (list transform-genenetwork-database-project |