summaryrefslogtreecommitdiff
path: root/vkraus/services/guix-wot.scm
blob: 5b53f9ce7dc7d0e5e9aa96b297acc0256ca2bd00 (plain)
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
(define-module (vkraus services guix-wot)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services ssh)
  #:use-module (gnu services admin)
  #:use-module (gnu home services)
  #:use-module (gnu home services shells)
  #:use-module (gnu system shadow)
  #:use-module (guix gexp)
  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix build-system minetest)
  #:use-module (guix git-download)
  #:use-module (guix build utils)
  #:use-module (guix monads)
  #:use-module (guix store)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages minetest)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages gnupg)
  #:use-module (gnu packages gnome)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 threads)
  #:use-module (ice-9 textual-ports)
  #:use-module ((guix licenses) #:prefix license:)
  #:declarative? #t
  #:duplicates (merge-generics)
  #:export
  (
   <guix-system-wot-configuration>
   make-guix-system-wot-configuration
   guix-system-wot-configuration?
   guix-system-wot-configuration-users
   guix-system-wot-configuration-key-servers

   guix-system-wot-openssh
   guix-system-wot-service-type

   <guix-home-wot-configuration>
   make-guix-home-wot-configuration
   guix-home-wot-configuration?
   guix-home-wot-configuration-fingerprints

   guix-home-wot-bash
   guix-home-wot-zsh
   guix-home-wot-home-files
   guix-home-wot-service-type
   ))

;; This module defines a guix system service that converts GPG key
;; fingerprints to authorized SSH keys. The public keys are pulled
;; from key servers at reconfiguration time.

(define-record-type <guix-system-wot-configuration>
  (make-guix-system-wot-configuration users key-servers)
  guix-system-wot-configuration?
  (users guix-system-wot-configuration-users)
  (key-servers guix-system-wot-configuration-key-servers))

(define guix-system-wot-openssh
  ;; This service will export all approved authentication keys for the
  ;; openssh server to use.
  (match-lambda
    (($ <guix-system-wot-configuration> users key-servers)
     (run-with-store
      (open-connection)
      (mlet %store-monad ((gpg (package-file gnupg "/bin/gpg")))
            (apply invoke
                   `(,gpg
                     ,@(apply append
                              (map
                               (lambda (key-server)
                                 `("--keyserver" ,key-server))
                               key-servers))
                     "--recv-key"
                     ,@(map cdr users)))))
     (par-map
      (match-lambda
        ((user . fingerprint)
         `(,user
           ,(let ((port (mkstemp "/tmp/user-key-file-XXXXXXXX")))
              (with-exception-handler
                  (lambda (exn)
                    (format (current-error-port) "Warning: no SSH key exported for ~a ~a: ~a.\n" user fingerprint exn))
                (lambda ()
                  (run-with-store
                   (open-connection)
                   (mlet %store-monad ((gpg (package-file gnupg "/bin/gpg")))
                         (invoke  gpg
                                  "-o" (port-filename port)
                                  "--export-ssh-key" fingerprint))))
                #:unwind? #t)
              (let ((interned
                     (plain-file (format #f "user-key-file-~a" fingerprint)
                                 (get-string-all port))))
                (delete-file (port-filename port))
                interned)))))
      users))))

(define guix-system-wot-service-type
  (service-type
   (name 'guix-system-wot)
   (extensions
    (list
     (service-extension openssh-service-type guix-system-wot-openssh)))
   (compose
    (lambda (extensions)
      (apply append extensions)))
   (extend
    (lambda (base-configuration other-users)
      (make-guix-system-wot-configuration
       (append (guix-system-wot-configuration-users base-configuration)
           other-users)
       (guix-system-wot-configuration-key-servers base-configuration))))
   (description
    (format #f "Add every available authentication keys for each user
as an auhorized SSH key."))))

(define-record-type <guix-home-wot-configuration>
  (make-guix-home-wot-configuration fingerprints)
  guix-home-wot-configuration?
  (fingerprints guix-home-wot-configuration-fingerprints))

(define %.profile
  (computed-file
   "run-gpg-agent-.profile"
   #~(call-with-output-file #$output
       (lambda (port)
         (let ((gpgconf
                #$(file-append gnupg "/bin/gpgconf"))
               (gpg-agent
                #$(file-append gnupg "/bin/gpg-agent")))
           (format port
                   "\
eval $(~a --daemon --enable-ssh-support)
export SSH_AUTH_SOCK=$(~a --list-dirs agent-ssh-socket)
"
                   gpg-agent
                   gpgconf))))))

(define guix-home-wot-bash
  (match-lambda
    (($ <guix-home-wot-configuration> fingerprints)
     (home-bash-extension
      (bash-profile
       (list %.profile))))))

(define guix-home-wot-zsh
  (match-lambda
    (($ <guix-home-wot-configuration> fingerprints)
     (home-zsh-extension
      (zprofile
       (list %.profile))))))

(define guix-home-wot-home-files
  (match-lambda
    (($ <guix-home-wot-configuration> fingerprints)
     `(("gnupg/sshcontrol"
        ,(computed-file
          "sshcontrol"
          #~(call-with-output-file #$output
              (lambda (port)
                (for-each
                 (lambda (fingerprint)
                   (format port "~a\n" fingerprint))
                 '(#$@fingerprints))))))
       ("gnupg/gpg-agent.conf"
        ,(computed-file
          "gpg-agent.conf"
          #~(call-with-output-file #$output
              (lambda (port)
                (format port
                        "\
debug-level basic
pinentry-program ~a
enable-ssh-support
"
                        #$(file-append pinentry-gnome3 "/bin/pinentry"))))))
       ("config/autostart/gnome-keyring-ssh.desktop"
        ,(computed-file
          "gnome-keyring-ssh.desktop"
          #~(begin
              (use-modules (ice-9 textual-ports))
              (call-with-output-file #$output
                (lambda (port)
                  (format port "\
~a
X-GNOME-Autostart-enabled=false
"
                          (call-with-input-file
                              #$(file-append gnome-keyring
                                             "/etc/xdg/autostart/gnome-keyring-ssh.desktop")
                              get-string-all
                              #:encoding "ISO-8859-1")))
                #:encoding "ISO-8859-1"))))))))

(define guix-home-wot-service-type
  (service-type
   (name 'guix-home-wot)
   (extensions
    (list
     (service-extension home-bash-service-type guix-home-wot-bash)
     (service-extension home-zsh-service-type guix-home-wot-zsh)
     (service-extension home-files-service-type guix-home-wot-home-files)))
   (compose
    (lambda (extensions)
      (apply append extensions)))
   (extend
    (lambda (base-configuration other-fingerprints)
      (make-guix-home-wot-configuration
       (append (guix-home-wot-configuration-fingerprints base-configuration)
               other-fingerprints))))
   (description
    (format #f "Use the GPG agent to connect to SSH."))))