summaryrefslogtreecommitdiff
path: root/guix/scripts/authenticate.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/authenticate.scm')
-rw-r--r--guix/scripts/authenticate.scm138
1 files changed, 108 insertions, 30 deletions
diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index 37e6cef53c..dc73981092 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -22,6 +22,10 @@
#:use-module (gcrypt pk-crypto)
#:use-module (guix pki)
#:use-module (guix ui)
+ #:use-module (guix diagnostics)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
@@ -40,41 +44,90 @@
(compose string->canonical-sexp read-string))
(define (sign-with-key key-file sha256)
- "Sign the hash SHA256 (a bytevector) with KEY-FILE, and write an sexp that
-includes both the hash and the actual signature."
+ "Sign the hash SHA256 (a bytevector) with KEY-FILE, and return the signature
+as a canonical sexp that includes both the hash and the actual signature."
(let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
(public-key (if (string-suffix? ".sec" key-file)
(call-with-input-file
(string-append (string-drop-right key-file 4)
".pub")
read-canonical-sexp)
- (leave
- (G_ "cannot find public key for secret key '~a'~%")
- key-file)))
+ (raise
+ (formatted-message
+ (G_ "cannot find public key for secret key '~a'~%")
+ key-file))))
(data (bytevector->hash-data sha256
#:key-type (key-type public-key)))
(signature (signature-sexp data secret-key public-key)))
- (display (canonical-sexp->string signature))
- #t))
+ signature))
(define (validate-signature signature)
"Validate SIGNATURE, a canonical sexp. Check whether its public key is
-authorized, verify the signature, and print the signed data to stdout upon
-success."
+authorized, verify the signature, and return the signed data (a bytevector)
+upon success."
(let* ((subject (signature-subject signature))
(data (signature-signed-data signature)))
(if (and data subject)
(if (authorized-key? subject)
(if (valid-signature? signature)
- (let ((hash (hash-data->bytevector data)))
- (display (bytevector->base16-string hash))
- #t) ; success
- (leave (G_ "error: invalid signature: ~a~%")
- (canonical-sexp->string signature)))
- (leave (G_ "error: unauthorized public key: ~a~%")
- (canonical-sexp->string subject)))
- (leave (G_ "error: corrupt signature data: ~a~%")
- (canonical-sexp->string signature)))))
+ (hash-data->bytevector data) ; success
+ (raise
+ (formatted-message (G_ "invalid signature: ~a")
+ (canonical-sexp->string signature))))
+ (raise
+ (formatted-message (G_ "unauthorized public key: ~a")
+ (canonical-sexp->string subject))))
+ (raise
+ (formatted-message (G_ "corrupt signature data: ~a")
+ (canonical-sexp->string signature))))))
+
+(define (read-command port)
+ "Read a command from PORT and return the command and arguments as a list of
+strings. Return the empty list when the end-of-file is reached.
+
+Commands are newline-terminated and must look something like this:
+
+ COMMAND 3:abc 5:abcde 1:x
+
+where COMMAND is an alphanumeric sequence and the remainder is the command
+arguments. Each argument is written as its length (in characters), followed
+by colon, followed by the given number of characters."
+ (define (consume-whitespace port)
+ (let ((chr (lookahead-u8 port)))
+ (when (eqv? chr (char->integer #\space))
+ (get-u8 port)
+ (consume-whitespace port))))
+
+ (match (read-delimited " \t\n\r" port)
+ ((? eof-object?)
+ '())
+ (command
+ (let loop ((result (list command)))
+ (consume-whitespace port)
+ (let ((next (lookahead-u8 port)))
+ (cond ((eqv? next (char->integer #\newline))
+ (get-u8 port)
+ (reverse result))
+ ((eof-object? next)
+ (reverse result))
+ (else
+ (let* ((len (string->number (read-delimited ":" port)))
+ (str (utf8->string
+ (get-bytevector-n port len))))
+ (loop (cons str result))))))))))
+
+(define-syntax define-enumerate-type ;TODO: factorize
+ (syntax-rules ()
+ ((_ name->int (name id) ...)
+ (define-syntax name->int
+ (syntax-rules (name ...)
+ ((_ name) id) ...)))))
+
+;; Codes used when reply to requests.
+(define-enumerate-type reply-code
+ (success 0)
+ (command-not-found 404)
+ (command-failed 500))
;;;
@@ -85,6 +138,13 @@ success."
(category internal)
(synopsis "sign or verify signatures on normalized archives (nars)")
+ (define (send-reply code str)
+ ;; Send CODE and STR as a reply to our client.
+ (let ((bv (string->utf8 str)))
+ (format #t "~a ~a:" code (bytevector-length bv))
+ (put-bytevector (current-output-port) bv)
+ (force-output (current-output-port))))
+
;; Signature sexps written to stdout may contain binary data, so force
;; ISO-8859-1 encoding so that things are not mangled. See
;; <http://bugs.gnu.org/17312> for details.
@@ -95,21 +155,39 @@ success."
(with-fluids ((%default-port-encoding "ISO-8859-1")
(%default-port-conversion-strategy 'error))
(match args
- (("sign" key-file hash)
- (sign-with-key key-file (base16-string->bytevector hash)))
- (("verify" signature-file)
- (call-with-input-file signature-file
- (lambda (port)
- (validate-signature (string->canonical-sexp
- (read-string port))))))
-
(("--help")
(display (G_ "Usage: guix authenticate OPTION...
-Sign or verify the signature on the given file. This tool is meant to
-be used internally by 'guix-daemon'.\n")))
+Sign data or verify signatures. This tool is meant to be used internally by
+'guix-daemon'.\n")))
(("--version")
(show-version-and-exit "guix authenticate"))
- (else
- (leave (G_ "wrong arguments"))))))
+ (()
+ (let loop ()
+ (guard (c ((formatted-message? c)
+ (send-reply (reply-code command-failed)
+ (apply format #f
+ (G_ (formatted-message-string c))
+ (formatted-message-arguments c)))))
+ ;; Read a request on standard input and reply.
+ (match (read-command (current-input-port))
+ (("sign" signing-key (= base16-string->bytevector hash))
+ (let ((signature (sign-with-key signing-key hash)))
+ (send-reply (reply-code success)
+ (canonical-sexp->string signature))))
+ (("verify" signature)
+ (send-reply (reply-code success)
+ (bytevector->base16-string
+ (validate-signature
+ (string->canonical-sexp signature)))))
+ (()
+ (exit 0))
+ (commands
+ (warning (G_ "~s: invalid command; ignoring~%") commands)
+ (send-reply (reply-code command-not-found)
+ "invalid command"))))
+
+ (loop)))
+ (_
+ (leave (G_ "wrong arguments~%"))))))
;;; authenticate.scm ends here