about summary refs log tree commit diff
diff options
context:
space:
mode:
authorClaude2026-06-26 00:00:00 +0000
committerFrederick Muriuki Muriithi2026-06-26 10:14:49 -0500
commit2866d00d74286c24e82b2af758f05d951c399b42 (patch)
tree7bdb84af36650cb9eb3fab96470a4abb66eca934
parent40aa65663d500c5e738787c78e39bd83096aa1c0 (diff)
downloadgn-machines-2866d00d74286c24e82b2af758f05d951c399b42.tar.gz
Add %show-commits and wire it into gn-integration-tests-gexp
Introduce %show-commits, a standalone program-file that accepts an
arbitrary list of paths as command-line arguments and prints the HEAD
commit of each one that is a git repository, silently skipping any
path that does not exist or has no .git directory.

This replaces the ad-hoc show-head-commit helpers that were defined
locally in gn-auth-test-flask and gn-integration-tests-gexp.  The
caller decides whether sudo is required:

  ;; Laminar user owns this clone — no sudo:
  (invoke #$%show-commits path)

  ;; CD-managed repos are owned by genenetwork — use sudo:
  (invoke #$sudo "-u" "genenetwork" #$%show-commits path1 path2 ...)

Changes:

* Remove hline, show-head-commit, and the five show-head-commit calls
  from gn-auth-test-flask.  They ran on every flask invocation (noisy)
  and will be replaced by a single %show-commits call at the job level.

* Define %show-commits after %gn-auth-test-flask.

* In gn-integration-tests-gexp:
  - Add repositories-checkout-directory to the match-record.
  - Remove the local hline and show-head-commit helpers.
  - Call %show-commits without sudo for the freshly-cloned
    gn-integration-tests repo (Laminar user owns it).
  - Call %show-commits via sudo -u genenetwork for the four
    CD-managed repos (gn-auth, gn-libs, genenetwork3, genenetwork2).

* Add %show-commits to the sudoers rule so the Laminar user may run
  it as the genenetwork user.
-rw-r--r--genenetwork-development.scm82
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