gn-guile: Refactor gn-guile-gexp

* Generate the GIT_SSH_COMMAND within the "inner" gexp
* Return both the config, and the generated gexp

1 files changed, 41 insertions, 30 deletions

diff --git a/genenetwork/services/genenetwork.scm b/genenetwork/services/genenetwork.scm
index bc3e731..2177033 100644
--- a/genenetwork/services/genenetwork.scm
+++ b/genenetwork/services/genenetwork.scm
@@ -666,34 +666,46 @@ a @code{<genenetwork-configuration>} record."
                #$(program-file "samples-count-script-gexp"
                                (samples-count-script-gexp config)))))
 
-(define (gn-guile-gexp gn-guile-port gn-guile-pkg bare-repo ssh-command working-branch)
-  (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
-        (let* ((gn-guile-profile #$(profile (content (package->development-manifest gn-guile-pkg))
-                                            (allow-collisions? #t)))
-               (ssl-cert-dir (string-append gn-guile-profile "/etc/ssl/certs"))
-               (ssl-cert-file (string-append ssl-cert-dir "/ca-certificates.crt"))
-               (current-repo-path (string-append (pk "CWD" (getcwd)) "/gn-docs")))
-          ;; These have to be setup manually here an not in the
-          ;; `gn-guile-shepherd-service' function, otherwise, they do not take
-          ;; effect for some reason.
-          (setenv "SSL_CERT_DIR" ssl-cert-dir)
-          (setenv "SSL_CERT_FILE" ssl-cert-file)
-          (setenv "GUILE_TLS_CERTIFICATE_DIRECTORY" ssl-cert-dir)
-          (setenv "GIT_SSH_COMMAND" #$ssh-command)
-          (setenv "GIT_COMMITTER_NAME" "genenetwork")
-          (setenv "GIT_COMMITTER_EMAIL" "no-reply@git.genenetwork.org")
+(define (gn-guile-gexp config)
+  (values
+   config
+   (match-record config <genenetwork-configuration>
+                 (gn-guile-port gn-guile gn-guile-ssh-identity-file gn-guile-known-hosts-file gn-doc-git-checkout gn-docs-working-branch)
+     (with-imported-modules '((guix build utils))
+       #~(begin
+           (use-modules (guix build utils))
+           (let* ((gn-guile-profile #$(profile (content (package->development-manifest gn-guile))
+                                               (allow-collisions? #t)))
+                  (ssl-cert-dir (string-append gn-guile-profile "/etc/ssl/certs"))
+                  (ssl-cert-file (string-append ssl-cert-dir "/ca-certificates.crt"))
+                  (current-repo-path (string-append (pk "CWD" (getcwd)) "/gn-docs"))
+                  (ssh-command #$(file-append openssh-sans-x "/bin/ssh"))
+                  (ssh-config-file #$(mixed-text-file "gn-guile-ssh-config"
+                                                      "Host git.genenetwork.org\n"
+                                                      "\tUser git\n"
+                                                      "\tIdentitiesOnly yes\n"
+                                                      "\tIdentityFile " gn-guile-ssh-identity-file "\n"
+                                                      "\tUserKnownHostsFile " gn-guile-known-hosts-file)))
+             (setenv "SSL_CERT_DIR" ssl-cert-dir)
+             (setenv "SSL_CERT_FILE" ssl-cert-file)
+             (setenv "GUILE_TLS_CERTIFICATE_DIRECTORY" ssl-cert-dir)
+             (setenv "GIT_SSH_COMMAND" (pk "GIT_SSH_COMMAND ===> "
+                                           (string-append ssh-command
+                                                          " -F "
+                                                          ssh-config-file)))
+             (setenv "GIT_COMMITTER_NAME" "genenetwork")
+             (setenv "GIT_COMMITTER_EMAIL" "no-reply@git.genenetwork.org")
+             (setenv "CURRENT_REPO_PATH" current-repo-path)
+             (setenv "CGIT_REPO_PATH" #$gn-doc-git-checkout)
 
-          (when (file-exists? current-repo-path)
-            (delete-file-recursively current-repo-path))
-          (setenv "CURRENT_REPO_PATH" current-repo-path)
-          (invoke #$(file-append git-minimal "/bin/git")
-                  "clone" "--depth" "1" "--branch" #$working-branch #$bare-repo))
-        (invoke #$(file-append gn-guile "/bin/gn-guile")
-                (number->string #$gn-guile-port)))))
+             (when (file-exists? current-repo-path)
+               (delete-file-recursively current-repo-path))
+             (invoke #$(file-append git-minimal "/bin/git")
+                     "clone" "--depth" "1" "--branch" #$gn-docs-working-branch #$gn-doc-git-checkout))
+           (invoke #$(file-append gn-guile "/bin/gn-guile")
+                   (number->string #$gn-guile-port)))))))
 
-(define (gn-guile-shepherd-service config)
+(define (gn-guile-shepherd-service config program-gexp)
   (match-record config <genenetwork-configuration>
     (gn-guile gn-doc-git-checkout gn-guile-port gn-guile-ssh-identity-file gn-guile-known-hosts-file gn-docs-working-branch gn-guile-working-dir)
     (shepherd-service
@@ -723,11 +735,10 @@ a @code{<genenetwork-configuration>} record."
                 ("LC_ALL" "en_US.UTF-8")
                 ("GIT_COMMITTER_NAME" "genenetwork")
                 ("GIT_COMMITTER_EMAIL" "no-reply@git.genenetwork.org")
-                ("GIT_SSH_COMMAND" ,ssh-command))))
+                ("GIT_SSH_COMMAND" "some-ssh-command"))))
         #~(make-forkexec-constructor
 	   (list #$(least-authority-wrapper
-                    (program-file "gn-guile"
-                                  (gn-guile-gexp gn-guile-port gn-guile gn-doc-git-checkout ssh-command gn-docs-working-branch))
+                    (program-file "gn-guile" program-gexp)
                     #:name "gn-guile-pola-wrapper"
                     #:directory gn-guile-working-dir
                     #:preserved-environment-variables
@@ -770,7 +781,7 @@ a @code{<genenetwork-configuration>} record."
           (service-extension forge-nginx-service-type
                              genenetwork-nginx-server-blocks)
           (service-extension shepherd-root-service-type
-                             (compose list gn-guile-shepherd-service))
+                             (compose list gn-guile-shepherd-service gn-guile-gexp))
           (service-extension mcron-service-type genenetwork-mcron-jobs)))
    (default-value (genenetwork-configuration))))