1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
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))))
|
