projects/guix·blob python-team · refs

221 lines · 9.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Lilah Tascheter <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (gnu home services secrets)
20 #:use-module (gnu home services)
21 #:use-module (gnu home services shepherd)
22 #:use-module (gnu packages password-utils)
23 #:use-module (gnu services)
24 #:use-module (gnu services configuration)
25 #:use-module (gnu services shepherd)
26 #:use-module (guix gexp)
27 #:use-module (srfi srfi-1)
28 #:export (wrap-himitsu-prompter
29 home-himitsu-configuration
30 home-himitsu-service-type
31
32 home-himitsu-ssh-configuration
33 home-himitsu-ssh-service-type
34
35 home-himitsu-secret-service-configuration
36 home-himitsu-secret-service-type))
37
38;;
39;; himitsu
40;;
41
42(define (wrap-himitsu-prompter prompter)
43 "Wraps a prompter to autodetect DISPLAY and WAYLAND_DISPLAY, necessary since
44shepherd typically starts before a graphical session."
45 (program-file "himitsu-wrapped-prompter"
46 #~(begin (use-modules (ice-9 ftw) (ice-9 match) (srfi srfi-26))
47 (unless (or (getenv "DISPLAY") (getenv "WAYLAND_DISPLAY"))
48 (for-each (lambda (dir pat cont)
49 (match (scandir dir (cut regexp-exec pat <>) string<?)
50 ((file . _) (cont file)) (_ #f)))
51 (list "/tmp/.X11-unix" (or (getenv "XDG_RUNTIME_DIR")
52 (string-append "/run/user/" (getuid))))
53 (map make-regexp '("^X[0-9]+$" "^wayland-[0-9]+$"))
54 (list (lambda (f)
55 (setenv "DISPLAY" (string-append ":" (string-drop f 1))))
56 (cut setenv "WAYLAND_DISPLAY" <>))))
57 (apply execl #$prompter #$prompter (cdr (command-line))))))
58
59(define-maybe string (prefix himitsu-))
60
61(define (string-or-gexp? s)
62 (or (string? s) (gexp? s)))
63
64(define list-of-strings-or-gexps? (list-of string-or-gexp?))
65
66(define (himitsu-serialize-string label val)
67 #~(format #f "~a=~a~%" '#$label #$val))
68
69(define himitsu-serialize-file-like himitsu-serialize-string)
70
71(define (himitsu-serialize-list-of-strings-or-gexps label vals)
72 #~(string-join (list #$@vals) "\n" 'suffix))
73
74(define-configuration home-himitsu-configuration
75 (package (file-like himitsu) "himitsu package to use." empty-serializer)
76 (notify-reuse maybe-string "Command run to notify the user upon use of a
77secret it was already authorized to use. Limited shell expansion available.")
78 (prompter (file-like (wrap-himitsu-prompter
79 (file-append hiprompt-gtk "/bin/hiprompt-gtk")))
80"himitsu prompter to use to request user authorization for secret access.")
81 (extra-options (list-of-strings-or-gexps '()) "A list of extra options, one
82per line, to put verbatim into the config file.")
83 (prefix himitsu-))
84
85(define (himitsu-serialize config)
86 (mixed-text-file "himitsu.ini" "[himitsud]\n"
87 (serialize-configuration config home-himitsu-configuration-fields)))
88
89(define (himitsu-shepherd-service config)
90 (define start
91 #~(lambda _
92 (let ((data (or (getenv "XDG_DATA_HOME")
93 (string-append user-homedir "/.local/share"))))
94 (if (directory-exists? (string-append data "/himitsu"))
95 (fork+exec-command
96 (list #$(let ((pkg (home-himitsu-configuration-package config)))
97 (file-append pkg "/bin/himitsud"))
98 "-C" #$(himitsu-serialize config))
99 #:log-file (string-append %user-log-dir "/himitsu.log"))
100 (error "Himitsu store must exist before the service can run! Try \
101running 'himitsu-store -i' first?")))))
102 (list (shepherd-service
103 (documentation "Run the Himitsu secret service manager.")
104 (provision '(himitsud))
105 (modules (cons* '(shepherd support) %default-modules))
106 (start start)
107 (stop #~(make-kill-destructor)))))
108
109;; we need to install the file or else himitsu-store will gen it
110(define (himitsu-xdg-configuration-service config)
111 `(("himitsu/config.ini" ,(himitsu-serialize config))))
112
113(define home-himitsu-service-type
114 (service-type
115 (name 'himitsu)
116 (extensions
117 (list (service-extension home-shepherd-service-type
118 himitsu-shepherd-service)
119 (service-extension home-xdg-configuration-files-service-type
120 himitsu-xdg-configuration-service)
121 (service-extension home-profile-service-type
122 (const (list himitsu)))))
123 (compose concatenate)
124 (extend (lambda (config exts)
125 (let ((opts (home-himitsu-configuration-extra-options config)))
126 (home-himitsu-configuration
127 (inherit config)
128 (extra-options (append exts opts))))))
129 (default-value (home-himitsu-configuration))
130 (description "Run the Himitsu secret storage manager upon login. You
131should create the Himitsu database in advance.")))
132
133;;
134;; himitsu-ssh
135;;
136
137(define (remember-option? opt)
138 (or (number? opt) (memq opt '(session skip refuse))))
139
140(define list-of-remember-options? (list-of remember-option?))
141
142(define (himitsu-serialize-list-of-remember-options label val)
143 (himitsu-serialize-string label
144 (string-join (map (lambda (x) (cond ((number? x) (number->string x))
145 ((symbol? x) (symbol->string x))))
146 val)
147 ",")))
148
149(define-configuration home-himitsu-ssh-configuration
150 (package (file-like himitsu-ssh) "himitsu-ssh package to use."
151 empty-serializer)
152 (persist (list-of-remember-options '(session 300 refuse)) "List of options
153given when prompting to allow himitsu-ssh to see your keys. The option chosen
154decides how long himitsu-ssh has this access. Options can be either 'session,
155'refuse, 'skip, or a timeout in seconds. 'session means until the daemon
156closes, 'refuse to decline and never ask again, and 'skip means to ask again
157next use.")
158 (disclose (list-of-remember-options '(skip session 300)) "List of options
159given when prompting to allow himitsu-ssh use of your keys. The format is the
160same has persist.")
161 (prefix himitsu-))
162
163(define (himitsu-ssh-shepherd-service config)
164 (let* ((package (home-himitsu-ssh-configuration-package config))
165 (binary (file-append package "/bin/hissh-agent")))
166 (list (shepherd-service
167 (documentation "Start the Himitsu ssh-agent implementation.")
168 (provision '(himitsu-ssh ssh-agent))
169 (requirement '(himitsud))
170 (start #~(make-forkexec-constructor (list #$binary)))
171 (stop #~(make-kill-destructor))))))
172
173(define (himitsu-ssh-himitsu.ini config)
174 (list "[ssh.remember]"
175 (serialize-configuration config home-himitsu-ssh-configuration-fields)))
176
177(define (himitsu-ssh-environment-variables _)
178 '(("SSH_AUTH_SOCK" . "${XDG_RUNTIME_DIR:-/run/user/$UID}/hissh-agent")))
179
180(define home-himitsu-ssh-service-type
181 (service-type
182 (name 'himitsu-ssh)
183 (extensions (list (service-extension home-shepherd-service-type
184 himitsu-ssh-shepherd-service)
185 (service-extension home-himitsu-service-type
186 himitsu-ssh-himitsu.ini)
187 (service-extension home-environment-variables-service-type
188 himitsu-ssh-environment-variables)
189 (service-extension home-profile-service-type
190 (const (list himitsu-ssh)))))
191 (default-value (home-himitsu-ssh-configuration))
192 (description "Add support for ssh to store keys in Himitsu.")))
193
194;;
195;; himitsu-secret-service
196;;
197
198(define-configuration home-himitsu-secret-service-configuration
199 (package (file-like himitsu-secret-service) "himitsu-secret-service package to
200use." empty-serializer)
201 (prefix himitsu-))
202
203(define (himitsu-secret-service-shepherd-service config)
204 (let* ((package (home-himitsu-secret-service-configuration-package config))
205 (binary (file-append package "/bin/hisecrets-agent")))
206 (list (shepherd-service
207 (documentation "Start the Himitsu secret-service implementation.")
208 (provision '(himitsu-secret-service secret-service))
209 (requirement '(himitsud dbus))
210 (start #~(make-forkexec-constructor (list #$binary)))
211 (stop #~(make-kill-destructor))))))
212
213(define home-himitsu-secret-service-type
214 (service-type
215 (name 'himitsu-secret-service)
216 (extensions
217 (list (service-extension home-shepherd-service-type
218 himitsu-secret-service-shepherd-service)))
219 (default-value (home-himitsu-secret-service-configuration))
220 (description "Add support to Himitsu for the freedesktop.org
221secret-service protocol.")))