gn-guile: Setup SSH configurations

To enable successful cloning and pushing of repositories, we need to
set up the identity file and some known hosts.

1 files changed, 43 insertions, 11 deletions

diff --git a/genenetwork/services/genenetwork.scm b/genenetwork/services/genenetwork.scm
index 69e8973..9b851d3 100644
--- a/genenetwork/services/genenetwork.scm
+++ b/genenetwork/services/genenetwork.scm
@@ -47,6 +47,7 @@
   #:use-module (forge utils)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (gnu packages ssh)
   #:export (genenetwork-service-type
             genenetwork-configuration
             genenetwork-configuration?
@@ -121,6 +122,10 @@
             (default gn-guile))
   (gn-guile-port genenetwork-configuration-gn-guile-port
                  (default 8091))
+  (gn-guile-ssh-identity-file genenetwork-configuration-gn-guile-ssh-identity-file
+                              (default "/opt/home/gn-guile/.ssh/id_ed25519"))
+  (gn-guile-known-hosts-file genenetwork-configuration-gn-guile-known-hosts-file
+                             (default "/opt/home/gn-guile/.ssh/known_hosts"))
   (gn-doc-git-checkout genenetwork-configuration-gn-doc-git-checkout
                        (default "/export/data/gn-docs"))
   (gn-virtuoso-ttl-directory genenetwork-configuration-gn-virtuoso-ttl-directory
@@ -290,7 +295,7 @@
 
 (define (genenetwork-activation config)
   (match-record config <genenetwork-configuration>
-    (gn2-secrets gn3-secrets gn-auth-secrets auth-db llm-db-path genotype-files gn-tmpdir gn-doc-git-checkout gn2-sessions-dir)
+    (gn2-secrets gn3-secrets gn-auth-secrets auth-db llm-db-path genotype-files gn-tmpdir gn-doc-git-checkout gn2-sessions-dir gn-guile-ssh-identity-file)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
@@ -353,8 +358,10 @@
                       (chown file
                              (passwd:uid (getpw "genenetwork"))
                              (passwd:gid (getpw "genenetwork"))))
-                    (find-files #$(dirname gn-doc-git-checkout)
-                                #:directories? #t))))))
+                    (append (find-files #$(dirname gn-doc-git-checkout)
+                                        #:directories? #t)
+                            (find-files #$(dirname (dirname gn-guile-ssh-identity-file))
+                                        #:directories? #t)))))))
 
 (define (configuration-file-gexp alist)
   "Return a G-expression that constructs a configuration file of
@@ -655,7 +662,7 @@ 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)
+(define (gn-guile-gexp gn-guile-port gn-guile-pkg bare-repo ssh-command)
   (with-imported-modules '((guix build utils))
     #~(begin
         (use-modules (guix build utils))
@@ -670,6 +677,7 @@ a @code{<genenetwork-configuration>} record."
           (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)
 
           (when (file-exists? current-repo-path)
             (delete-file-recursively current-repo-path))
@@ -681,7 +689,7 @@ a @code{<genenetwork-configuration>} record."
 
 (define (gn-guile-shepherd-service config)
   (match-record config <genenetwork-configuration>
-    (gn-guile gn-doc-git-checkout gn-guile-port)
+    (gn-guile gn-doc-git-checkout gn-guile-port gn-guile-ssh-identity-file gn-guile-known-hosts-file)
     (shepherd-service
      (documentation "Run gn-guile server.")
      (provision '(gn-guile))
@@ -689,23 +697,47 @@ a @code{<genenetwork-configuration>} record."
      (modules '((ice-9 match)
                 (srfi srfi-1)))
      (start
-      (let* ((gn-guile-settings
+      (let* ((ssh-command
+              (program-file
+               "gn-guile-git-ssh-command"
+               (with-imported-modules '((guix build utils))
+                 #~(begin
+                     (use-modules (guix build utils))
+
+                     (invoke #$(file-append openssh-sans-x "/bin/ssh")
+                             "-F"
+                             #$(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))))))
+             (gn-guile-settings
               `(("CGIT_REPO_PATH" ,gn-doc-git-checkout)
                 ("LC_ALL" "en_US.UTF-8")
                 ("GIT_COMMITTER_NAME" "genenetwork")
-                ("GIT_COMMITTER_EMAIL" "no-reply@git.genenetwork.org"))))
+                ("GIT_COMMITTER_EMAIL" "no-reply@git.genenetwork.org")
+                ("GIT_SSH_COMMAND" ,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))
+                                  (gn-guile-gexp gn-guile-port gn-guile gn-doc-git-checkout ssh-command))
                     #:name "gn-guile-pola-wrapper"
                     #:directory (dirname gn-doc-git-checkout)
                     #:preserved-environment-variables
                     (map first gn-guile-settings)
                     #:mappings (list (file-system-mapping
-                                       (source (dirname gn-doc-git-checkout))
-                                       (target source)
-                                       (writable? #t)))
+                                      (source (dirname gn-doc-git-checkout))
+                                      (target source)
+                                      (writable? #t))
+                                     (file-system-mapping
+                                      (source gn-guile-ssh-identity-file)
+                                      (target source)
+                                      (writable? #f))
+                                     (file-system-mapping
+                                      (source gn-guile-known-hosts-file)
+                                      (target source)
+                                      (writable? #f)))
                     #:namespaces (delq 'net %namespaces))
                  "127.0.0.1" #$(number->string gn-guile-port))
            #:user "genenetwork"