Initial.

A  .guix-authorizations
A  .guix-channel
A  COPYING
A  README
A  whispers/packages/dict.scm
A  whispers/packages/doc.scm
A  whispers/packages/pdf.scm
A  whispers/packages/sh.scm
A  whispers/packages/whispers.scm
A  whispers/services/console.scm
A  whispers/services/dict.scm
A  whispers/services/finance.scm
A  whispers/services/gps.scm
A  whispers/services/proton.scm
A  whispers/services/ssh-agent.scm
A  whispers/services/ssh-tunneler.scm
A  whispers/services/whispers.scm
A  whispers/services/whispers/finance.scm
A  whispers/services/whispers/gps.scm
A  whispers/services/whispers/mail.scm
A  whispers/services/whispers/ssh.scm
A  whispers/services/whispers/vpn.scm
A  whispers/services/whispers/xdg.scm
A  whispers/tests/ssh-tunneler.scm

1 files changed, 153 insertions, 0 deletions

diff --git a/whispers/services/ssh-agent.scm b/whispers/services/ssh-agent.scm
new file mode 100644
index 0000000..834b36a
--- /dev/null
+++ b/whispers/services/ssh-agent.scm
@@ -0,0 +1,153 @@
+;;; Whispers --- Stealth VPN and ssh tunneler
+;;; Copyright © 2023 Runciter <runciter@whispers-vpn.org>
+;;;
+;;; This file is part of Whispers.
+;;;
+;;; Whispers is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Whispers is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Whispers.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (whispers services ssh-agent)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu services admin)
+  #:use-module (gnu packages ssh)
+  #:export (ssh-agent-configuration
+            ssh-agent-configuration?
+            ssh-agent-service-type))
+
+(define-record-type* <ssh-agent-configuration>
+  ssh-agent-configuration make-ssh-agent-configuration
+  ssh-agent-configuration?
+  this-ssh-agent-configuration
+  ;; A file-like object
+  (ssh-package          ssh-agent-configuration-ssh-package
+                        (default openssh))
+  ;; A string
+  (socket-folder        ssh-agent-configuration-socket-folder
+                        (default "/var/run/ssh-agent"))
+  ;; A string
+  (socket-file-name     ssh-agent-configuration-socket-file-name
+                        (default "ssh-agent.sock"))
+  ;; A string
+  (log-folder           ssh-agent-configuration-log-folder
+                        (default "/var/log"))
+  ;; A string
+  (log-file-name        ssh-agent-configuration-log-file-name
+                        (default "ssh-agent.log"))
+  ;; A list of strings
+  (auto-added-keys      ssh-agent-configuration-auto-added-keys
+                        (default '()))
+  ;; A boolean value
+  (%auto-start?         ssh-agent-configuration-auto-start?
+                        (default #t)))
+
+(define (socket-file-path config)
+  "Returns a string specifying the path to the log file of an ssh agent
+service configurable by CONFIG, a record of the
+<ssh-agent-configuration> type."
+  (string-append (ssh-agent-configuration-socket-folder config)
+                 "/"
+                 (ssh-agent-configuration-socket-file-name config)))
+
+(define (log-file-path config)
+  "Returns a string specifying the path to the log file of an ssh agent
+service configurable by CONFIG, a record of the
+<ssh-agent-configuration> type."
+  (string-append (ssh-agent-configuration-log-folder config)
+                 "/"
+                 (ssh-agent-configuration-log-file-name config)))
+
+(define (ssh-agent-log-rotation config)
+  "Returns a list of log-rotation records specifying how to rotate the
+logs of as ssh aggent service configurable by CONFIG, a record of
+the <ssh-agent-configuration> type."
+  (list (log-rotation (frequency 'daily)
+                      (files `(,(log-file-path config))))))
+
+(define (add-key-procedure config)
+  "Returns a G-exp to a procedure adding a private key to a running ssh
+agent daemon, configurable by CONFIG, a record of the
+<ssh-agent-configuration> type."
+  (let ((ssh-package (ssh-agent-configuration-ssh-package config)))
+    #~(lambda (running key-path)
+        ((make-system-constructor
+          (string-append "SSH_AUTH_SOCK="
+                         #$(socket-file-path config)
+                         " "
+                         #$(file-append ssh-package
+                                        "/bin/ssh-add")
+                         " "
+                         key-path))))))
+
+(define (constructor-gexp config)
+  "Returns a G-exp to a procedure adding a private key to a running ssh
+agent daemon, configurable by CONFIG, a record of the
+<ssh-agent-configuration> type."
+  (let ((ssh-package (ssh-agent-configuration-ssh-package config))
+        (auto-added-keys (ssh-agent-configuration-auto-added-keys config))
+        (socket-file-path (socket-file-path config))
+        (log-file-path (log-file-path config)))
+    #~(lambda whatever
+        (let ((ret ((make-forkexec-constructor
+                     (list #$(file-append ssh-package
+                                          "/bin/ssh-agent")
+                           "-d"
+                           "-a"
+                           #$socket-file-path)
+                     #:log-file
+                     #$log-file-path))))
+          (map (lambda (key)
+                 (action 'ssh-agent 'add-key key))
+               '#$auto-added-keys)
+          ret))))
+
+(define (ssh-agent-shepherd-services config)
+  "Returns a list of shepherd services handling an ssh agent daemon
+configured by CONFIG, a record of the <ssh-agent-configuration>
+type."
+  (let ((auto-start? (ssh-agent-configuration-auto-start? config)))
+    (list
+     (shepherd-service
+      (documentation (string-append "Ssh agent service, socket file can
+be found at "
+                                    (socket-file-path config)
+                                    "."))
+      (provision '(ssh-agent))
+      (requirement '())
+      (start (constructor-gexp config))
+      (stop #~(make-kill-destructor))
+      (actions
+       (list
+        (shepherd-action (name 'add-key)
+                         (documentation "Add the private key found at at
+the path KEY-PATH to a started ssh-agent daemon.")
+                         (procedure (add-key-procedure config)))))
+      (auto-start? auto-start?)))))
+
+(define ssh-agent-service-type
+  (service-type
+   (name 'ssh-agent)
+   (description "Ssh agent service")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             ssh-agent-shepherd-services)
+          (service-extension rottlog-service-type
+                             ssh-agent-log-rotation)
+          (service-extension
+           profile-service-type
+           (lambda (config)
+             (list
+              (ssh-agent-configuration-ssh-package config))))))
+   (default-value (ssh-agent-configuration))))