blob: 5e4dbadd354191ab804d7bb3d0cebfa3f2f6cc3c (
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
|
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix pki)
#:use-module (guix config)
#:use-module (guix pk-crypto)
#:use-module ((guix utils) #:select (with-atomic-file-output))
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:export (%public-key-file
%private-key-file
%acl-file
current-acl
public-keys->acl
acl->public-keys
signature-sexp
authorized-key?))
;;; Commentary:
;;;
;;; Public key infrastructure for the authentication and authorization of
;;; archive imports. This is essentially a subset of SPKI for our own
;;; purposes (see <http://theworld.com/~cme/spki.txt> and
;;; <http://www.ietf.org/rfc/rfc2693.txt>.)
;;;
;;; Code:
(define (acl-entry-sexp public-key)
"Return a SPKI-style ACL entry sexp for PUBLIC-KEY, authorizing imports
signed by the corresponding secret key (see the IETF draft at
<http://theworld.com/~cme/spki.txt> for the ACL format.)"
;; Note: We always use PUBLIC-KEY to designate the subject. Someday we may
;; want to have name certificates and to use subject names instead of
;; complete keys.
(string->canonical-sexp
(format #f
"(entry ~a (tag (guix import)))"
(canonical-sexp->string public-key))))
(define (acl-sexp entries)
"Return an ACL sexp from ENTRIES, a list of 'entry' sexps."
(string->canonical-sexp
(string-append "(acl "
(string-join (map canonical-sexp->string entries))
")")))
(define (public-keys->acl keys)
"Return an ACL canonical sexp that lists all of KEYS with a '(guix import)'
tag---meaning that all of KEYS are authorized for archive imports. Each
element in KEYS must be a canonical sexp with type 'public-key'."
(acl-sexp (map acl-entry-sexp keys)))
(define %acl-file
(string-append %config-directory "/acl"))
(define %public-key-file
(string-append %config-directory "/signing-key.pub"))
(define %private-key-file
(string-append %config-directory "/signing-key.sec"))
(define (ensure-acl)
"Make sure the ACL file exists, and create an initialized one if needed."
(unless (file-exists? %acl-file)
;; If there's no public key file, don't attempt to create the ACL.
(when (file-exists? %public-key-file)
(let ((public-key (call-with-input-file %public-key-file
(compose string->canonical-sexp
get-string-all))))
(mkdir-p (dirname %acl-file))
(with-atomic-file-output %acl-file
(lambda (port)
(display (canonical-sexp->string
(public-keys->acl (list public-key)))
port)))))))
(define (current-acl)
"Return the current ACL as a canonical sexp."
(ensure-acl)
(if (file-exists? %acl-file)
(call-with-input-file %acl-file
(compose string->canonical-sexp
get-string-all))
(public-keys->acl '()))) ; the empty ACL
(define (acl->public-keys acl)
"Return the public keys (as canonical sexps) listed in ACL with the '(guix
import)' tag."
(match (canonical-sexp->sexp acl)
(('acl
('entry subject-keys
('tag ('guix 'import)))
...)
(map sexp->canonical-sexp subject-keys))
(_
(error "invalid access-control list" acl))))
(define* (authorized-key? key
#:optional (acl (current-acl)))
"Return #t if KEY (a canonical sexp) is an authorized public key for archive
imports according to ACL."
(let ((key (canonical-sexp->sexp key)))
(match (canonical-sexp->sexp acl)
(('acl
('entry subject-keys
('tag ('guix 'import)))
...)
(not (not (member key subject-keys))))
(_
(error "invalid access-control list" acl)))))
(define (signature-sexp data secret-key public-key)
"Return a SPKI-style sexp for the signature of DATA with SECRET-KEY that
includes DATA, the actual signature value (with a 'sig-val' tag), and
PUBLIC-KEY (see <http://theworld.com/~cme/spki.txt> for examples.)"
(string->canonical-sexp
(format #f
"(signature ~a ~a ~a)"
(canonical-sexp->string data)
(canonical-sexp->string (sign data secret-key))
(canonical-sexp->string public-key))))
;;; pki.scm ends here
|