diff options
Diffstat (limited to 'whispers/services/ssh-agent.scm')
| -rw-r--r-- | whispers/services/ssh-agent.scm | 153 |
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)))) |