‘guix archive’ doesn’t work over ‘./pre-inst-env’

‘guix archive’ doesn’t work over ‘./pre-inst-env’

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 653 bytes --]

$ sudo ./pre-inst-env guix archive --generate-key
$ ./pre-inst-env guix archive --export hello > hello.nar
error: executing `guix-authenticate': No such file or directory
guix archive: error: build failed: program `guix-authenticate' failed with exit code 1

The command succeeded when I installed Guix and re-ran it without
‘./pre-inst-env’.

Slightly off-topic: is Hydra supposed to do the same when someone
requests a substitute?

Also, where can I find the corresponding NAR info file?  According to
this commit [1], the signature should be there.

[1] https://github.com/NixOS/nix/commit/0fdf4da0e979f992db75cc17376e455ddc5a96d8

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: ‘guix archive’ doesn’t work over ‘./pre-inst-env’

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> $ sudo ./pre-inst-env guix archive --generate-key
> $ ./pre-inst-env guix archive --export hello > hello.nar
> error: executing `guix-authenticate': No such file or directory
> guix archive: error: build failed: program `guix-authenticate' failed with exit code 1
>
> The command succeeded when I installed Guix and re-ran it without
> ‘./pre-inst-env’.

Indeed.  I just fixed that.

> Slightly off-topic: is Hydra supposed to do the same when someone
> requests a substitute?

It’s supposed to do something equivalent, yes (specifically, it uses a
Nix command-line client tool which calls the ‘export-paths’ RPC, which
then calls ‘guix authenticate’ to create the signature.)

However, note that hydra.gnu.org runs an older version of Hydra that
lacks support for that.  We can upgrade it when needed.

> Also, where can I find the corresponding NAR info file?  According to
> this commit [1], the signature should be there.

The .narinfo files are created on the fly.  When looking for a binary
for /nix/store/x4mnd9747fgwacjrvl1rynh59qlgz8gh-coreutils-8.21, the
substituter attempts to fetch:

  http://hydra.gnu.org/x4mnd9747fgwacjrvl1rynh59qlgz8gh.narinfo

It caches the answer (positive or negative) under
/nix/var/nix/substitute-binary/cache/x4mnd9747fgwacjrvl1rynh59qlgz8gh
(or similar.)

HTH,
Ludo’.

Signed archives (was: ‘guix archive’ doesn’t work over ‘./pre-inst-env’)

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 660 bytes --]

> Indeed.  I just fixed that.

Thanks!

>> Also, where can I find the corresponding NAR info file?  According to
>> this commit [1], the signature should be there.

> The .narinfo files are created on the fly.  When looking for a binary
> for /nix/store/x4mnd9747fgwacjrvl1rynh59qlgz8gh-coreutils-8.21, the
> substituter attempts to fetch:

>   http://hydra.gnu.org/x4mnd9747fgwacjrvl1rynh59qlgz8gh.narinfo

> It caches the answer (positive or negative) under
> /nix/var/nix/substitute-binary/cache/x4mnd9747fgwacjrvl1rynh59qlgz8gh
> (or similar.)

Does Hydra create the .narinfo files?  How can I create a signed
.narinfo file locally (for testing purposes)?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>>> Also, where can I find the corresponding NAR info file?  According to
>>> this commit [1], the signature should be there.
>
>> The .narinfo files are created on the fly.  When looking for a binary
>> for /nix/store/x4mnd9747fgwacjrvl1rynh59qlgz8gh-coreutils-8.21, the
>> substituter attempts to fetch:
>
>>   http://hydra.gnu.org/x4mnd9747fgwacjrvl1rynh59qlgz8gh.narinfo
>
>> It caches the answer (positive or negative) under
>> /nix/var/nix/substitute-binary/cache/x4mnd9747fgwacjrvl1rynh59qlgz8gh
>> (or similar.)
>
> Does Hydra create the .narinfo files?

Yes, as shown above.  :-)

(See NARInfo.pm in Hydra.)

> How can I create a signed .narinfo file locally (for testing
> purposes)?

You could copy one from /nix/var/nix/substitute-binary/cache or from a
URL like above.

To get the signature sexp, you can run ‘guix authenticate rsautl -sign
...’ (see tests/guix-authenticate.sh for an example.)  Then you’ll have
to base64-encode it somehow.

HTH,
Ludo’.

Re: Signed archives

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 606 bytes --]

Sorry, I’m failing to understand how the protocol works.  Is the spec
available somewhere?

Could you describe the entire process in a step-by-step way?  What does
happen when the client requests a substitute?  You mentioned that the
client attempts to fetch the corresponding .narinfo file.  What does
happen after that?

Why does the client need to cache the answer?  Does it check the cache
first?

‘guix authenticate’ accepts a ‘hash-file’ argument.  Does it come from
the .narinfo file?  If so, should ‘substitute-binary.scm’ check the
signature against the NarHash field?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> Sorry, I’m failing to understand how the protocol works.  Is the spec
> available somewhere?

No.

> Could you describe the entire process in a step-by-step way?  What does
> happen when the client requests a substitute?  You mentioned that the
> client attempts to fetch the corresponding .narinfo file.  What does
> happen after that?

The substituter can be invoked either in query mode, or in substitution
mode.

In query mode, it is passed a list of store file names, and it must tell
whether substitutes exist for them.  This is what happens, for instance,
when running ‘guix build foo --dry-run’: it allows ‘guix build’ to know
what would be downloaded from hydra.gnu.org, and what would be built.

In substitute mode, it is passed a list of store file names to actually
substitute.


‘guix substitute-binary’ implements that protocol, with the aim of
reflecting binaries served by Hydra.  Thus, its query mode consists in
verifying whether the .narinfo for a given item exists at
http://hydra.gnu.org.  Its substitute mode consists in downloading the
archive specified in the corresponding .narinfo.

See the thread at
<http://lists.gnu.org/archive/html/bug-guix/2013-04/msg00013.html>.

> Why does the client need to cache the answer?  Does it check the cache
> first?

If it didn’t cache the answer, then it would have to do one HTTP GET for
each item you want to build.  For instance:

  guix build coreutils -n

would lead something like 20 HTTP requests to hydra.gnu.org, which could
take a lot of time.

So, instead, it does two things:

  • it caches Hydra’s .narinfo or lack thereof, for a limited time (see
    <http://lists.gnu.org/archive/html/bug-guix/2013-04/msg00082.html>);

  • when there’s no info in cache, a HTTP requests are made in parallel
    (see <https://lists.gnu.org/archive/html/guix-devel/2013-11/msg00032.html>.)

> ‘guix authenticate’ accepts a ‘hash-file’ argument.  Does it come from
> the .narinfo file?

No, it comes from LocalStore::importPath, in local-store.cc.

> If so, should ‘substitute-binary.scm’ check the signature against the
> NarHash field?

Hmm I think so, but we’d have to double-check whether that’s what Nix
actually does.

HTH!

Ludo’.

Re: Signed archives

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 223 bytes --]

I’d like to see a signature in the wild.  Are there any signed .narinfo
files on hydra.nixos.org?  I’ve checked GNU Hello [1]; it’s not signed.

[1] http://hydra.nixos.org/6iqpvq3k2nlmfn3l59rsf3c57ji7jiyb.narinfo

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives

[Ludovic Courtès]

Hi!

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> I’d like to see a signature in the wild.  Are there any signed .narinfo
> files on hydra.nixos.org?  I’ve checked GNU Hello [1]; it’s not signed.

Then I guess it’s not actually deployed on hydra.nixos.org.

The log of the Nix commits I referred to does contain an example, and I
believe there are test cases as well.  So I guess for now the best we
can do is look at the code.

HTH,
Ludo’.

Re: Signed archives

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 813 bytes --]

More questions:

1. Will hydra.gnu.org serve only signed .narinfo files?

2. If not, how can one opt out of verifying while using ‘guix
   substitute-binary’?  Should we add an option to ‘guix package’ and
   ‘guix build’?

3. How does a user get Hydra’s public key?

4. Will the entire cache be signed with a single key?  (Mark, would you
   like to add something?)

5. When do we want to verify the .narinfo file?  Can it be done in
   ‘read-narinfo’?  Similarly, should we sign and base64-encode in
   ‘write-narinfo’?

6. Where should ‘guix substitute-binary’ look for a keypair?

7. How do we determine that a file is signed with a trusted key?  What
   if we don’t have the needed public key?  Does it mean we miss the
   right one, or is it a MITM attack?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 2290 bytes --]

Hello,

Sorry for the delay!

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> 1. Will hydra.gnu.org serve only signed .narinfo files?

Hydra (the software) can do both, but hydra.gnu.org will sign
everything.

> 2. If not, how can one opt out of verifying while using ‘guix
>    substitute-binary’?  Should we add an option to ‘guix package’ and
>    ‘guix build’?

In general, I don’t think we’d want to opt out.

Technically there’s also the problem that substitute-binary is spawned
by the daemon, so we have no direct way to communicate with it.

> 3. How does a user get Hydra’s public key?

I imagine we could distribute it with Guix tarballs, in the repo, and
perhaps also on ftp.gnu.org GPG-signed by myself (say).

> 4. Will the entire cache be signed with a single key?  (Mark, would you
>    like to add something?)

(I think “cache” is ambiguous here.)  All the archives served by Hydra
will be signed.

> 5. When do we want to verify the .narinfo file?  Can it be done in
>    ‘read-narinfo’?

I think so, yes, and raise an error if there’s a signature issue, as
done in ‘restore-file-set’, in nar.scm.

(IIRC what’s implemented in Hydra, only .narinfos are signed, and not
the archives themselves, right?)

> Similarly, should we sign and base64-encode in ‘write-narinfo’?

Currently ‘write-narinfo’ is used only internally, when populating the
local narinfo lookup cache.  So there’s no need to sign things here (it
will be useful when we have an HTTP server that can publish archives
using the same protocol.)

However, the local lookup cache should probably keep the signatures it
got from hydra.gnu.org, unchanged.  Thus, ‘write-narinfo’ should do the
right thing to preserve the ‘Signature’ field.

> 6. Where should ‘guix substitute-binary’ look for a keypair?

It should use ‘authorized-key?’ from (guix pki), which in turn loads the
ACL from $sysconfdir (info "(guix) Invoking guix archive").

> 7. How do we determine that a file is signed with a trusted key?  What
>    if we don’t have the needed public key?  Does it mean we miss the
>    right one, or is it a MITM attack?

‘authorized-key?’ will DTRT.  :-)

HTH!

Ludo’.

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 119 bytes --]

Too lazy to write a proper commit message, so here’s the diff.  Please
take a look and comment on the XXX stuff.


[-- Attachment #1.2: signature.diff --]
[-- Type: text/x-diff, Size: 21530 bytes --]

diff --git a/guix/base64.scm b/guix/base64.scm
new file mode 100644
index 0000000..f7f7f5f
--- /dev/null
+++ b/guix/base64.scm
@@ -0,0 +1,212 @@
+;; -*- mode: scheme; coding: utf-8 -*-
+;;
+;; This module was renamed from (weinholt text base64 (1 0 20100612)) to
+;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
+;; February 12, 2014.
+;;
+;; Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
+;;
+;; This program 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.
+;;
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+#!r6rs
+
+;; RFC 4648 Base-N Encodings
+
+(library (guix base64)
+  (export base64-encode
+          base64-decode
+          base64-alphabet
+          base64url-alphabet
+          get-delimited-base64
+          put-delimited-base64)
+  (import (rnrs)
+          (only (srfi :13 strings)
+                string-index
+                string-prefix? string-suffix?
+                string-concatenate string-trim-both))
+
+  (define base64-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+
+  (define base64url-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
+
+  (define base64-encode
+    (case-lambda
+      ;; Simple interface. Returns a string containing the canonical
+      ;; base64 representation of the given bytevector.
+      ((bv)
+       (base64-encode bv 0 (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start)
+       (base64-encode bv start (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start end)
+       (base64-encode bv start end #f #f base64-alphabet #f))
+      ((bv start end line-length)
+       (base64-encode bv start end line-length #f base64-alphabet #f))
+      ((bv start end line-length no-padding)
+       (base64-encode bv start end line-length no-padding base64-alphabet #f))
+      ((bv start end line-length no-padding alphabet)
+       (base64-encode bv start end line-length no-padding alphabet #f))
+      ;; Base64 encodes the bytes [start,end[ in the given bytevector.
+      ;; Lines are limited to line-length characters (unless #f),
+      ;; which must be a multiple of four. To omit the padding
+      ;; characters (#\=) set no-padding to a true value. If port is
+      ;; #f, returns a string.
+      ((bv start end line-length no-padding alphabet port)
+       (assert (or (not line-length) (zero? (mod line-length 4))))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-string-output-port))))
+         (letrec ((put (if line-length
+                           (let ((chars 0))
+                             (lambda (p c)
+                               (when (fx=? chars line-length)
+                                 (set! chars 0)
+                                 (put-char p #\linefeed))
+                               (set! chars (fx+ chars 1))
+                               (put-char p c)))
+                           put-char)))
+           (let lp ((i start))
+             (cond ((= i end))
+                   ((<= (+ i 3) end)
+                    (let ((x (bytevector-uint-ref bv i (endianness big) 3)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (put p (string-ref alphabet (fxbit-field x 0 6)))
+                      (lp (+ i 3))))
+                   ((<= (+ i 2) end)
+                    (let ((x (fxarithmetic-shift-left (bytevector-u16-ref bv i (endianness big)) 8)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (unless no-padding
+                        (put p #\=))))
+                   (else
+                    (let ((x (fxarithmetic-shift-left (bytevector-u8-ref bv i) 16)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (unless no-padding
+                        (put p #\=)
+                        (put p #\=)))))))
+         (extract)))))
+
+  ;; Decodes a base64 string. The string must contain only pure
+  ;; unpadded base64 data.
+  (define base64-decode
+    (case-lambda
+      ((str)
+       (base64-decode str base64-alphabet #f))
+      ((str alphabet)
+       (base64-decode str alphabet #f))
+      ((str alphabet port)
+       (unless (zero? (mod (string-length str) 4))
+         (error 'base64-decode
+                "input string must be a multiple of four characters"))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-bytevector-output-port))))
+         (do ((i 0 (+ i 4)))
+             ((= i (string-length str))
+              (extract))
+           (let ((c1 (string-ref str i))
+                 (c2 (string-ref str (+ i 1)))
+                 (c3 (string-ref str (+ i 2)))
+                 (c4 (string-ref str (+ i 3))))
+             ;; TODO: be more clever than string-index
+             (let ((i1 (string-index alphabet c1))
+                   (i2 (string-index alphabet c2))
+                   (i3 (string-index alphabet c3))
+                   (i4 (string-index alphabet c4)))
+               (cond ((and i1 i2 i3 i4)
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6)
+                                      i4)))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))
+                        (put-u8 p (fxbit-field x 0 8))))
+                     ((and i1 i2 i3 (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6))))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))))
+                     ((and i1 i2 (char=? c3 #\=) (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12))))
+                        (put-u8 p (fxbit-field x 16 24))))
+                     (else
+                      (error 'base64-decode "invalid input"
+                             (list c1 c2 c3 c4)))))))))))
+
+  (define (get-line-comp f port)
+    (if (port-eof? port)
+        (eof-object)
+        (f (get-line port))))
+
+  ;; Reads the common -----BEGIN/END type----- delimited format from
+  ;; the given port. Returns two values: a string with the type and a
+  ;; bytevector containing the base64 decoded data. The second value
+  ;; is the eof object if there is an eof before the BEGIN delimiter.
+  (define (get-delimited-base64 port)
+    (define (get-first-data-line port)
+      ;; Some MIME data has header fields in the same format as mail
+      ;; or http. These are ignored.
+      (let ((line (get-line-comp string-trim-both port)))
+        (cond ((eof-object? line) line)
+              ((string-index line #\:)
+               (let lp ()               ;read until empty line
+                 (let ((line (get-line-comp string-trim-both port)))
+                   (if (string=? line "")
+                       (get-line-comp string-trim-both port)
+                       (lp)))))
+              (else line))))
+    (let ((line (get-line-comp string-trim-both port)))
+      (cond ((eof-object? line)
+             (values "" (eof-object)))
+            ((string=? line "")
+             (get-delimited-base64 port))
+            ((and (string-prefix? "-----BEGIN " line)
+                  (string-suffix? "-----" line))
+             (let* ((type (substring line 11 (- (string-length line) 5)))
+                    (endline (string-append "-----END " type "-----")))
+               (let-values (((outp extract) (open-bytevector-output-port)))
+                 (let lp ((line (get-first-data-line port)))
+                   (cond ((eof-object? line)
+                          (error 'get-delimited-base64
+                                 "unexpected end of file"))
+                         ((string-prefix? "-" line)
+                          (unless (string=? line endline)
+                            (error 'get-delimited-base64
+                                   "bad end delimiter" type line))
+                          (values type (extract)))
+                         (else
+                          (unless (and (= (string-length line) 5)
+                                       (string-prefix? "=" line)) ;Skip Radix-64 checksum
+                            (base64-decode line base64-alphabet outp))
+                          (lp (get-line-comp string-trim-both port))))))))
+            (else ;skip garbage (like in openssl x509 -in foo -text output).
+             (get-delimited-base64 port)))))
+
+  (define put-delimited-base64
+    (case-lambda
+      ((port type bv line-length)
+       (display (string-append "-----BEGIN " type "-----\n") port)
+       (base64-encode bv 0 (bytevector-length bv)
+                      line-length #f base64-alphabet port)
+       (display (string-append "\n-----END " type "-----\n") port))
+      ((port type bv)
+       (put-delimited-base64 port type bv 76)))))
\ No newline at end of file
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 3aaa1c4..6fd2d02 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,9 @@
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module (guix nar)
+  #:use-module (guix base64)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix build download)
                 #:select (progress-proc uri-abbreviation))
@@ -33,6 +37,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
@@ -40,7 +45,8 @@
   #:use-module (srfi srfi-26)
   #:use-module (web uri)
   #:use-module (guix http-client)
-  #:export (guix-substitute-binary))
+  #:export (parse-signature
+            guix-substitute-binary))
 
 ;;; Comment:
 ;;;
@@ -185,7 +191,7 @@ failure."
 
 (define-record-type <narinfo>
   (%make-narinfo path uri compression file-hash file-size nar-hash nar-size
-                 references deriver system)
+                 references deriver system signature)
   narinfo?
   (path         narinfo-path)
   (uri          narinfo-uri)
@@ -196,12 +202,58 @@ failure."
   (nar-size     narinfo-size)
   (references   narinfo-references)
   (deriver      narinfo-deriver)
-  (system       narinfo-system))
+  (system       narinfo-system)
+  (signature    narinfo-signature))
+
+(define-record-type <signature>
+  ;; See the last paragraph of this commit message:
+  ;; <https://github.com/NixOS/nix/commit/0fdf4da0e979f992db75cc17376e455ddc5a96d8>,
+  ;; but keep in mind that Guix uses Libgcrypt (which uses the canonical
+  ;; S-expressions format) instead of OpenSSL.
+  (%make-signature version key-id body)
+  signature?
+  (version signature-version)
+  (key-id  signature-key-id)
+  ;; The base64-encoded signature of the SHA-256 hash of the contents of the
+  ;; NAR info file up to but not including the Signature line.
+  (body    signature-body))
+
+;;; XXX: Is it reasonable to parse and verify at the same time?
+(define* (parse-signature str #:optional (acl (current-acl)))
+  "Parse the Signature field of a NAR info file."
+  (let ((lst (string-split str #\;)))
+    (match lst
+      ((version id body)
+       (let* ((maybe-number (string->number version))
+              ;; XXX: Can we assume UTF-8 here?  Probably not.
+              (body* (string->canonical-sexp
+                      (utf8->string (base64-decode body))))
+              (key   (signature-subject body*)))
+         ;; XXX: All these checks are subject to TOCTOU, can we do anything
+         ;; about it?  Should we use file locking or 'catch'?  I'm not sure.
+         ;; We are already screwed if someone can alter files owned by root,
+         ;; aren't we?
+         (cond ((not (number? maybe-number))
+                (leave (_ "signature version must be a number: ~a~%")
+                       maybe-number))
+               ((not (= 1 maybe-number))
+                (leave (_ "unsupported signature version: ~a~%")
+                       maybe-number))
+               ((not (authorized-key? key acl))
+                (leave (_ "unauthorized public key: ~a~%")
+                       (canonical-sexp->string key)))
+               ((not (valid-signature? body*))
+                (leave (_ "invalid signature: ~a~%")
+                       (canonical-sexp->string body*)))
+               (else
+                (%make-signature maybe-number id body*)))))
+      (x
+       (leave (_ "invalid format of the signature field: ~a~%") x)))))
 
 (define (narinfo-maker cache-url)
   "Return a narinfo constructor for narinfos originating from CACHE-URL."
   (lambda (path url compression file-hash file-size nar-hash nar-size
-                references deriver system)
+                references deriver system signature)
     "Return a new <narinfo> object."
     (%make-narinfo path
 
@@ -217,7 +269,8 @@ failure."
                    (match deriver
                      ((or #f "") #f)
                      (_ deriver))
-                   system)))
+                   system
+                   (parse-signature signature))))
 
 (define* (read-narinfo port #:optional url)
   "Read a narinfo from PORT in its standard external form.  If URL is true, it
@@ -227,7 +280,7 @@ reading PORT."
                  (narinfo-maker url)
                  '("StorePath" "URL" "Compression"
                    "FileHash" "FileSize" "NarHash" "NarSize"
-                   "References" "Deriver" "System")))
+                   "References" "Deriver" "System" "Signature")))
 
 (define (write-narinfo narinfo port)
   "Write NARINFO to PORT."
@@ -254,7 +307,19 @@ reading PORT."
                     ("References" . ,(compose string-join narinfo-references))
                     ("Deriver" . ,(compose empty-string-if-false
                                            narinfo-deriver))
-                    ("System" . ,narinfo-system))
+                    ("System" . ,narinfo-system)
+                    ("Signature" . ,(lambda (narinfo)
+                                      (let ((sig (narinfo-signature narinfo)))
+                                        (string-append
+                                         (number->string (signature-version sig))
+                                         ";"
+                                         (signature-key-id sig)
+                                         ";"
+                                         (base64-encode
+                                          ;; XXX: Can we assume UTF-8 here?
+                                          (string->utf8
+                                           (canonical-sexp->string
+                                            (signature-body sig)))))))))
                   port))
 
 (define (narinfo->string narinfo)
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
new file mode 100644
index 0000000..1d3ceec
--- /dev/null
+++ b/tests/substitute-binary.scm
@@ -0,0 +1,117 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.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 (test-substitute-binary)
+  #:use-module (guix scripts substitute-binary)
+  #:use-module (guix base64)
+  #:use-module (guix hash)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
+  #:use-module (rnrs bytevectors)
+  #:use-module ((srfi srfi-64) #:hide (test-error)))
+
+;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allows to catch
+;; specific exceptions.
+(define (test-error name key thunk val)
+  "Test whether THUNK throws a particular error KEY, e.g., 'misc-error, by
+comparing the expected VAL and the one returned by the handler.  This
+procedure assumes that THUNK itself will never return VAL, which is
+error-prone but better than catching everything with 'test-error' from
+SRFI-64."
+  (test-equal name val
+              (catch key
+                     thunk
+                     (const val))))
+
+(define (test-error* name thunk)
+  ;; XXX: This catches all calls to 'exit', which is also error-prone, so it
+  ;; should be replaced in the future.
+  (test-error name 'quit thunk #t))
+
+(define 1024-bit-rsa
+  (string->canonical-sexp "(genkey (rsa (nbits 4:1024)))"))
+
+(define %keypair
+  (generate-key 1024-bit-rsa))
+
+(define %public-key
+  (find-sexp-token %keypair 'public-key))
+
+(define %private-key
+  (find-sexp-token %keypair 'private-key))
+
+(define %signature-body
+  ;; XXX: Can we assume UTF-8 here?
+  (base64-encode
+   (string->utf8
+    (canonical-sexp->string
+     (signature-sexp (bytevector->hash-data (sha256 (string->utf8 "secret")))
+                     %private-key
+                     %public-key)))))
+
+(define %wrong-public-key
+  (find-sexp-token (generate-key 1024-bit-rsa) 'public-key))
+
+(define %wrong-signature
+  (let* ((body (string->canonical-sexp
+                (utf8->string
+                 (base64-decode %signature-body))))
+         (data       (canonical-sexp->string (find-sexp-token body 'data)))
+         (sig-val    (canonical-sexp->string (find-sexp-token body 'sig-val)))
+         (public-key (canonical-sexp->string %wrong-public-key))
+         ;; XXX: Can we assume UTF-8 here?
+         (body*      (base64-encode
+                      (string->utf8
+                       (string-append "(signature \n" data sig-val
+                                      public-key " )\n")))))
+    (string-append "1;irrelevant;" body*)))
+
+(define (signature str)
+  (string-append str ";irrelevant;" %signature-body))
+
+(define %acl
+  (public-keys->acl (list %public-key)))
+
+(test-begin "parse-signature")
+
+(test-error* "not a number"
+  (lambda ()
+    (parse-signature (signature "not-a-number") %acl)))
+
+(test-error* "wrong version number"
+  (lambda ()
+    (parse-signature (signature "2") %acl)))
+
+(test-error* "unauthorized key"
+  (lambda ()
+    (parse-signature (signature "1") (public-keys->acl '()))))
+
+(test-error* "invalid signature"
+  (lambda ()
+    (parse-signature %wrong-signature
+                     (public-keys->acl (list %wrong-public-key)))))
+
+(test-assert "valid"
+  (lambda ()
+    (parse-signature (signature "1") %acl)))
+
+(test-error* "invalid signature format"
+  (lambda ()
+    (parse-signature "no signature here" %acl)))
+
+(test-end "parse-signature")
\ No newline at end of file

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

Thanks for working on it.  Some preliminary comments:

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> --- /dev/null
> +++ b/guix/base64.scm
> @@ -0,0 +1,212 @@
> +;; -*- mode: scheme; coding: utf-8 -*-
> +;;
> +;; This module was renamed from (weinholt text base64 (1 0 20100612)) to
> +;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
> +;; February 12, 2014.

Cool.

> +(define-record-type <signature>
> +  ;; See the last paragraph of this commit message:
> +  ;; <https://github.com/NixOS/nix/commit/0fdf4da0e979f992db75cc17376e455ddc5a96d8>,
> +  ;; but keep in mind that Guix uses Libgcrypt (which uses the canonical
> +  ;; S-expressions format) instead of OpenSSL.
> +  (%make-signature version key-id body)
> +  signature?
> +  (version signature-version)
> +  (key-id  signature-key-id)
> +  ;; The base64-encoded signature of the SHA-256 hash of the contents of the
> +  ;; NAR info file up to but not including the Signature line.
> +  (body    signature-body))

Once the Signature field has been parsed, I think we can discard the
‘version’ and ‘key-id’ items: the original version number doesn’t matter
as long as it’s one we know how to parse, and the ‘key-id’ is pretty
much useless.

The ‘key-id’ as envisioned in Hydra is useless notably because with our
SPKIsh approach, the ultimate identifier is the public key, which should
be embedded in BODY (like ‘signature-sexp’ does.)

So I think we can get rid of the <signature> record.

> +;;; XXX: Is it reasonable to parse and verify at the same time?
> +(define* (parse-signature str #:optional (acl (current-acl)))
> +  "Parse the Signature field of a NAR info file."

Indeed I think it’d be better to separate parsing and verification.

Also, that file generally reads “narinfo”, not “NAR info”, so I think we
should stick to that name.

> +  (let ((lst (string-split str #\;)))
> +    (match lst
> +      ((version id body)

For simplicity, change this pattern to ("1" id body).  That will allow
the inner ‘cond’ to be simplified.

> +       (let* ((maybe-number (string->number version))
> +              ;; XXX: Can we assume UTF-8 here?  Probably not.

Yes we can.  Narinfos are ASCII in practice.

> +              (body* (string->canonical-sexp
> +                      (utf8->string (base64-decode body))))
> +              (key   (signature-subject body*)))
> +         ;; XXX: All these checks are subject to TOCTOU, can we do anything
> +         ;; about it?  Should we use file locking or 'catch'?  I'm not sure.
> +         ;; We are already screwed if someone can alter files owned by root,
> +         ;; aren't we?

You mean if someone changes the ACL?  Actually at this point the ACL
file has already been loaded in memory, so if it changes that’s no
problem.

> +               ((not (authorized-key? key acl))
> +                (leave (_ "unauthorized public key: ~a~%")
> +                       (canonical-sexp->string key)))
> +               ((not (valid-signature? body*))
> +                (leave (_ "invalid signature: ~a~%")
> +                       (canonical-sexp->string body*)))

There’s an important check missing here: the code verifies that BODY* is
a valid signature, but it doesn’t check whether what it signs
corresponds to this narinfo up to but excluding the ‘Signature’ field.

The check should look like ‘assert-valid-signature’ in nar.scm:

        (if (authorized-key? subject)
            (if (equal? (hash-data->bytevector data) hash)
                (unless (valid-signature? signature)
                  (raise (condition
                          (&message (message "invalid signature"))
                          (&nar-signature-error
                           (file file) (signature signature) (port port)))))

(Probably this should be factorized eventually.)

The difficulty here will be to compute the hash up to the Signature
field.  To do that, ‘read-narinfo’ should probably:

  1. read everything from PORT with ‘get-string-all’ in a string (make
     sure PORT’s encoding is UTF-8);

  2. isolate the lines before the ^[[:blank:]]*Signature[[:blank:]]:
     line;

  3. compute the hash of those lines;

  4. do (fields->alist (open-input-string the-whole-string));

  5. pass the hash to the signature verification procedure.

Does that make sense?

>  (define (write-narinfo narinfo port)
>    "Write NARINFO to PORT."
> @@ -254,7 +307,19 @@ reading PORT."
>                      ("References" . ,(compose string-join narinfo-references))
>                      ("Deriver" . ,(compose empty-string-if-false
>                                             narinfo-deriver))
> -                    ("System" . ,narinfo-system))
> +                    ("System" . ,narinfo-system)
> +                    ("Signature" . ,(lambda (narinfo)
> +                                      (let ((sig (narinfo-signature narinfo)))
> +                                        (string-append
> +                                         (number->string (signature-version sig))
> +                                         ";"
> +                                         (signature-key-id sig)
> +                                         ";"
> +                                         (base64-encode
> +                                          ;; XXX: Can we assume UTF-8 here?
> +                                          (string->utf8
> +                                           (canonical-sexp->string
> +                                            (signature-body sig)))))))))

‘write-narinfo’ is used in particular when writing narinfos to the local
cache.

It’s important to keep the original signatures intact.  Since the
narinfo format is “sloppy” (included non-significant characters, field
ordering isn’t signficant, etc.), that means we must also keep the exact
narinfo as delivered by Hydra.  We can no longer rebuild that string
after the fact like ‘write-narinfo’ currently does because we could
build a string that slightly differs from the initial one and thus
doesn’t pass the signature check.

To fix this, the <narinfo> record must include an additional field to
contain the original narinfo string.  Then ‘write-narinfo’ just needs to
write it out as UTF-8.

> +(define-module (test-substitute-binary)
> +  #:use-module (guix scripts substitute-binary)
> +  #:use-module (guix base64)
> +  #:use-module (guix hash)
> +  #:use-module (guix pk-crypto)
> +  #:use-module (guix pki)
> +  #:use-module (rnrs bytevectors)
> +  #:use-module ((srfi srfi-64) #:hide (test-error)))
> +
> +;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allows to catch
> +;; specific exceptions.
> +(define (test-error name key thunk val)
> +  "Test whether THUNK throws a particular error KEY, e.g., 'misc-error, by
> +comparing the expected VAL and the one returned by the handler.  This
> +procedure assumes that THUNK itself will never return VAL, which is
> +error-prone but better than catching everything with 'test-error' from
> +SRFI-64."
> +  (test-equal name val
> +              (catch key
> +                     thunk
> +                     (const val))))

This should use ‘test-eq’, and VAL should be eq?-unique.

> +(define %keypair
> +  (generate-key 1024-bit-rsa))

Don’t generate a key pair in the test: it’s slow and may fail due to
insufficient entropy.  Instead, keep the key pair inline (as in
tests/pk-crypto.scm), or load it from signing-key.{pub,sec}.

> +(define %signature-body
> +  ;; XXX: Can we assume UTF-8 here?

Yes.

> +(test-begin "parse-signature")
> +
> +(test-error* "not a number"
> +  (lambda ()
> +    (parse-signature (signature "not-a-number") %acl)))
> +
> +(test-error* "wrong version number"
> +  (lambda ()
> +    (parse-signature (signature "2") %acl)))
> +
> +(test-error* "unauthorized key"
> +  (lambda ()
> +    (parse-signature (signature "1") (public-keys->acl '()))))
> +
> +(test-error* "invalid signature"
> +  (lambda ()
> +    (parse-signature %wrong-signature
> +                     (public-keys->acl (list %wrong-public-key)))))
> +
> +(test-assert "valid"
> +  (lambda ()
> +    (parse-signature (signature "1") %acl)))
> +
> +(test-error* "invalid signature format"
> +  (lambda ()
> +    (parse-signature "no signature here" %acl)))
> +
> +(test-end "parse-signature")

OK.

I think we need black-box tests in tests/store.scm (there are already a
couple of substituter tests there.)

WDYT?

Looks like this is getting concrete, thanks! :-)

Ludo’.

Re: Signed archives (preliminary patch)

[Mark H Weaver]

ludo@gnu.org (Ludovic Courtès) writes:

> The difficulty here will be to compute the hash up to the Signature
> field.  To do that, ‘read-narinfo’ should probably:
>
>   1. read everything from PORT with ‘get-string-all’ in a string (make
>      sure PORT’s encoding is UTF-8);
>
>   2. isolate the lines before the ^[[:blank:]]*Signature[[:blank:]]:
>      line;
>
>   3. compute the hash of those lines;
>
>   4. do (fields->alist (open-input-string the-whole-string));
>
>   5. pass the hash to the signature verification procedure.
>
> Does that make sense?

Apologies in advance if I'm failing to understand, but I'm concerned
about bundling a single principal signature into the narinfo file.
Not only does it cause the complications discussed above, but more
importantly, it seems to introduce an architectural bias toward an
authentication scheme where everyone is encouraged to place their
trust in a single centralized build system.

How do you envision the transition from this single-signature
architecture to one where other users and/or independent build farms
can add their signatures to hydra?  Will those signatures be treated
differently than the signatures created by hydra.gnu.org?  Will they
be stored and sent to users using a different mechanism?

    Regards,
      Mark

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> The difficulty here will be to compute the hash up to the Signature
>> field.  To do that, ‘read-narinfo’ should probably:
>>
>>   1. read everything from PORT with ‘get-string-all’ in a string (make
>>      sure PORT’s encoding is UTF-8);
>>
>>   2. isolate the lines before the ^[[:blank:]]*Signature[[:blank:]]:
>>      line;
>>
>>   3. compute the hash of those lines;
>>
>>   4. do (fields->alist (open-input-string the-whole-string));
>>
>>   5. pass the hash to the signature verification procedure.
>>
>> Does that make sense?
>
> Apologies in advance if I'm failing to understand, but I'm concerned
> about bundling a single principal signature into the narinfo file.
> Not only does it cause the complications discussed above, but more
> importantly, it seems to introduce an architectural bias toward an
> authentication scheme where everyone is encouraged to place their
> trust in a single centralized build system.

Well, narinfos are a protocol for Hydra, which is a centralized build
system.

Nevertheless, the signatures we use are canonical sexps, so we could
really put anything in there.  Currently it’s a single “signature sexp”
(which includes a public key) though; it could be that of the
hydra.gnu.org front-end, or that of a build slave, eventually.

> How do you envision the transition from this single-signature
> architecture to one where other users and/or independent build farms
> can add their signatures to hydra?  Will those signatures be treated
> differently than the signatures created by hydra.gnu.org?  Will they
> be stored and sent to users using a different mechanism?

Honestly I don’t know yet.  Partly because it’s unclear to me that
modifying Hydra to support such things is the right thing to do.

For the kind of operation you mention, I’d rather have some sort of
distributed store, where people can publish binaries they have produced.
Then users could look up specific store file names in there, check where
they originate from–i.e., who signed them–, compare their hash, etc.

This is pretty much related to the GNUnet software update idea.

Alternately, we could write a Guile web server that publishes a user’s
store using Hydra’s protocols, and from there gradually adjust
substitute-binary to intelligently handle multiple servers.  (That would
even make a good GSoC project, no?)

Thanks,
Ludo’.

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 743 bytes --]

> How do you envision the transition from this single-signature
> architecture to one where other users and/or independent build farms
> can add their signatures to hydra?  Will those signatures be treated
> differently than the signatures created by hydra.gnu.org?  Will they
> be stored and sent to users using a different mechanism?

Let’s not get ahead of ourselves.  The “single signature” solution is
far from being perfect, but it’s way better than nothing.  I suspect
that the “web of trust” thing would require a lot of effort.  So I
propose to postpone that until we implement the former since a bird in
the hand is worth two in the bush.  Even though that bird would be an
obvious target for an attacker.
c

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 1555 bytes --]

> There’s an important check missing here: the code verifies that BODY* is
> a valid signature, but it doesn’t check whether what it signs
> corresponds to this narinfo up to but excluding the ‘Signature’ field.

Oh, indeed.

>   5. pass the hash to the signature verification procedure.

Then, it should extract the other hash from the Signature line, compare
the hashes, and run the rest of the checks, right?

>> +                    ("Signature" . ,(lambda (narinfo)
>> +                                      (let ((sig (narinfo-signature narinfo)))
>> +                                        (string-append
>> +                                         (number->string (signature-version sig))
>> +                                         ";"
>> +                                         (signature-key-id sig)
>> +                                         ";"
>> +                                         (base64-encode
>> +                                          ;; XXX: Can we assume UTF-8 here?
>> +                                          (string->utf8
>> +                                           (canonical-sexp->string
>> +                                            (signature-body sig)))))))))

> It’s important to keep the original signatures intact.

Not sure I follow.  Can I simply use ("Signature" . ,narinfo-signature)?

> To fix this, the <narinfo> record must include an additional field to
> contain the original narinfo string.

Please elaborate.  Which string are you talking about?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> There’s an important check missing here: the code verifies that BODY* is
>> a valid signature, but it doesn’t check whether what it signs
>> corresponds to this narinfo up to but excluding the ‘Signature’ field.
>
> Oh, indeed.
>
>>   5. pass the hash to the signature verification procedure.
>
> Then, it should extract the other hash from the Signature line, compare
> the hashes, and run the rest of the checks, right?

The signature is computed over a hash of the narinfo up to the Signature
line, not included.

So the substituter must keep a string containing said lines, and compute
the hash of the UTF-8/ASCII representation of this string.

Then, for verification purposes, it must make sure that the hash found
in the signature sexp is the same as the hash computed as above.

>>> +                    ("Signature" . ,(lambda (narinfo)
>>> +                                      (let ((sig (narinfo-signature narinfo)))
>>> +                                        (string-append
>>> +                                         (number->string (signature-version sig))
>>> +                                         ";"
>>> +                                         (signature-key-id sig)
>>> +                                         ";"
>>> +                                         (base64-encode
>>> +                                          ;; XXX: Can we assume UTF-8 here?
>>> +                                          (string->utf8
>>> +                                           (canonical-sexp->string
>>> +                                            (signature-body sig)))))))))
>
>> It’s important to keep the original signatures intact.
>
> Not sure I follow.  Can I simply use ("Signature" . ,narinfo-signature)?
>
>> To fix this, the <narinfo> record must include an additional field to
>> contain the original narinfo string.
>
> Please elaborate.  Which string are you talking about?

The narinfo.

Suppose the signature is computed over a hash of this:

--8<---------------cut here---------------start------------->8---
StorePath: /nix/store/phw82pzgl32ygpaa1z2v3l04afni7f28-gdbm-1.10
URL: nar/phw82pzgl32ygpaa1z2v3l04afni7f28-gdbm-1.10
Compression: bzip2
NarHash: sha256:1mn4rm7gs71dsqdm1gilw3h3krgfgbjsmni9yz9dziw1jpcrk3x1
NarSize: 372720
References: 9fnjjsbarscbmakr44ixfv9yhg6z12mw-glibc-2.17 lwc6sygaglzfk17v3w15cc2xv97fjgci-gcc-4.7.2 phw82pzgl32ygpaa1z2v3l04afni7f28-gdbm-1.10
Deriver: ykf90hcbvn3nm9ai7ikpw992vdq6l95k-gdbm-1.10.drv
System: x86_64-linux
--8<---------------cut here---------------end--------------->8---

The following narinfo, although semantically equivalent, would fail
signature verification:

--8<---------------cut here---------------start------------->8---
NarSize:        372720
StorePath:      /nix/store/phw82pzgl32ygpaa1z2v3l04afni7f28-gdbm-1.10
References:     9fnjjsbarscbmakr44ixfv9yhg6z12mw-glibc-2.17 lwc6sygaglzfk17v3w15cc2xv97fjgci-gcc-4.7.2 phw82pzgl32ygpaa1z2v3l04afni7f28-gdbm-1.10
Deriver:        ykf90hcbvn3nm9ai7ikpw992vdq6l95k-gdbm-1.10.drv
System:         x86_64-linux
URL:            nar/phw82pzgl32ygpaa1z2v3l04afni7f28-gdbm-1.10
NarHash:        sha256:1mn4rm7gs71dsqdm1gilw3h3krgfgbjsmni9yz9dziw1jpcrk3x1
Compression:    bzip2
--8<---------------cut here---------------end--------------->8---

That’s why the <narinfo> must include a copy of the exact textual
representation of the narinfo that was signed.  Then, ‘write-narinfo’
must simply write out that string, unchanged (including the ‘Signature’
line.)

HTH,
Ludo’.

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 408 bytes --]

> For simplicity, change this pattern to ("1" id body).  That will allow
> the inner ‘cond’ to be simplified.

I like informative error messages, may I keep it please?  The attached
diff should address all the things you mentioned except this one.
Please review.

I’m planning to send a proper patch as soon as I test (guix base64) and
change a couple of things in (test-substitute-binary).


[-- Attachment #1.2: signature2.diff --]
[-- Type: text/x-diff, Size: 26046 bytes --]

diff --git a/guix/base64.scm b/guix/base64.scm
new file mode 100644
index 0000000..f7f7f5f
--- /dev/null
+++ b/guix/base64.scm
@@ -0,0 +1,212 @@
+;; -*- mode: scheme; coding: utf-8 -*-
+;;
+;; This module was renamed from (weinholt text base64 (1 0 20100612)) to
+;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
+;; February 12, 2014.
+;;
+;; Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
+;;
+;; This program 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.
+;;
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+#!r6rs
+
+;; RFC 4648 Base-N Encodings
+
+(library (guix base64)
+  (export base64-encode
+          base64-decode
+          base64-alphabet
+          base64url-alphabet
+          get-delimited-base64
+          put-delimited-base64)
+  (import (rnrs)
+          (only (srfi :13 strings)
+                string-index
+                string-prefix? string-suffix?
+                string-concatenate string-trim-both))
+
+  (define base64-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+
+  (define base64url-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
+
+  (define base64-encode
+    (case-lambda
+      ;; Simple interface. Returns a string containing the canonical
+      ;; base64 representation of the given bytevector.
+      ((bv)
+       (base64-encode bv 0 (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start)
+       (base64-encode bv start (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start end)
+       (base64-encode bv start end #f #f base64-alphabet #f))
+      ((bv start end line-length)
+       (base64-encode bv start end line-length #f base64-alphabet #f))
+      ((bv start end line-length no-padding)
+       (base64-encode bv start end line-length no-padding base64-alphabet #f))
+      ((bv start end line-length no-padding alphabet)
+       (base64-encode bv start end line-length no-padding alphabet #f))
+      ;; Base64 encodes the bytes [start,end[ in the given bytevector.
+      ;; Lines are limited to line-length characters (unless #f),
+      ;; which must be a multiple of four. To omit the padding
+      ;; characters (#\=) set no-padding to a true value. If port is
+      ;; #f, returns a string.
+      ((bv start end line-length no-padding alphabet port)
+       (assert (or (not line-length) (zero? (mod line-length 4))))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-string-output-port))))
+         (letrec ((put (if line-length
+                           (let ((chars 0))
+                             (lambda (p c)
+                               (when (fx=? chars line-length)
+                                 (set! chars 0)
+                                 (put-char p #\linefeed))
+                               (set! chars (fx+ chars 1))
+                               (put-char p c)))
+                           put-char)))
+           (let lp ((i start))
+             (cond ((= i end))
+                   ((<= (+ i 3) end)
+                    (let ((x (bytevector-uint-ref bv i (endianness big) 3)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (put p (string-ref alphabet (fxbit-field x 0 6)))
+                      (lp (+ i 3))))
+                   ((<= (+ i 2) end)
+                    (let ((x (fxarithmetic-shift-left (bytevector-u16-ref bv i (endianness big)) 8)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (unless no-padding
+                        (put p #\=))))
+                   (else
+                    (let ((x (fxarithmetic-shift-left (bytevector-u8-ref bv i) 16)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (unless no-padding
+                        (put p #\=)
+                        (put p #\=)))))))
+         (extract)))))
+
+  ;; Decodes a base64 string. The string must contain only pure
+  ;; unpadded base64 data.
+  (define base64-decode
+    (case-lambda
+      ((str)
+       (base64-decode str base64-alphabet #f))
+      ((str alphabet)
+       (base64-decode str alphabet #f))
+      ((str alphabet port)
+       (unless (zero? (mod (string-length str) 4))
+         (error 'base64-decode
+                "input string must be a multiple of four characters"))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-bytevector-output-port))))
+         (do ((i 0 (+ i 4)))
+             ((= i (string-length str))
+              (extract))
+           (let ((c1 (string-ref str i))
+                 (c2 (string-ref str (+ i 1)))
+                 (c3 (string-ref str (+ i 2)))
+                 (c4 (string-ref str (+ i 3))))
+             ;; TODO: be more clever than string-index
+             (let ((i1 (string-index alphabet c1))
+                   (i2 (string-index alphabet c2))
+                   (i3 (string-index alphabet c3))
+                   (i4 (string-index alphabet c4)))
+               (cond ((and i1 i2 i3 i4)
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6)
+                                      i4)))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))
+                        (put-u8 p (fxbit-field x 0 8))))
+                     ((and i1 i2 i3 (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6))))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))))
+                     ((and i1 i2 (char=? c3 #\=) (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12))))
+                        (put-u8 p (fxbit-field x 16 24))))
+                     (else
+                      (error 'base64-decode "invalid input"
+                             (list c1 c2 c3 c4)))))))))))
+
+  (define (get-line-comp f port)
+    (if (port-eof? port)
+        (eof-object)
+        (f (get-line port))))
+
+  ;; Reads the common -----BEGIN/END type----- delimited format from
+  ;; the given port. Returns two values: a string with the type and a
+  ;; bytevector containing the base64 decoded data. The second value
+  ;; is the eof object if there is an eof before the BEGIN delimiter.
+  (define (get-delimited-base64 port)
+    (define (get-first-data-line port)
+      ;; Some MIME data has header fields in the same format as mail
+      ;; or http. These are ignored.
+      (let ((line (get-line-comp string-trim-both port)))
+        (cond ((eof-object? line) line)
+              ((string-index line #\:)
+               (let lp ()               ;read until empty line
+                 (let ((line (get-line-comp string-trim-both port)))
+                   (if (string=? line "")
+                       (get-line-comp string-trim-both port)
+                       (lp)))))
+              (else line))))
+    (let ((line (get-line-comp string-trim-both port)))
+      (cond ((eof-object? line)
+             (values "" (eof-object)))
+            ((string=? line "")
+             (get-delimited-base64 port))
+            ((and (string-prefix? "-----BEGIN " line)
+                  (string-suffix? "-----" line))
+             (let* ((type (substring line 11 (- (string-length line) 5)))
+                    (endline (string-append "-----END " type "-----")))
+               (let-values (((outp extract) (open-bytevector-output-port)))
+                 (let lp ((line (get-first-data-line port)))
+                   (cond ((eof-object? line)
+                          (error 'get-delimited-base64
+                                 "unexpected end of file"))
+                         ((string-prefix? "-" line)
+                          (unless (string=? line endline)
+                            (error 'get-delimited-base64
+                                   "bad end delimiter" type line))
+                          (values type (extract)))
+                         (else
+                          (unless (and (= (string-length line) 5)
+                                       (string-prefix? "=" line)) ;Skip Radix-64 checksum
+                            (base64-decode line base64-alphabet outp))
+                          (lp (get-line-comp string-trim-both port))))))))
+            (else ;skip garbage (like in openssl x509 -in foo -text output).
+             (get-delimited-base64 port)))))
+
+  (define put-delimited-base64
+    (case-lambda
+      ((port type bv line-length)
+       (display (string-append "-----BEGIN " type "-----\n") port)
+       (base64-encode bv 0 (bytevector-length bv)
+                      line-length #f base64-alphabet port)
+       (display (string-append "\n-----END " type "-----\n") port))
+      ((port type bv)
+       (put-delimited-base64 port type bv 76)))))
\ No newline at end of file
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 3aaa1c4..90251dd 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,10 @@
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module (guix nar)
+  #:use-module (guix hash)
+  #:use-module (guix base64)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix build download)
                 #:select (progress-proc uri-abbreviation))
@@ -33,6 +38,8 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
@@ -40,7 +47,11 @@
   #:use-module (srfi srfi-26)
   #:use-module (web uri)
   #:use-module (guix http-client)
-  #:export (guix-substitute-binary))
+  #:export (parse-signature
+            verify-signature
+            read-narinfo
+            write-narinfo
+            guix-substitute-binary))
 
 ;;; Comment:
 ;;;
@@ -185,7 +196,7 @@ failure."
 
 (define-record-type <narinfo>
   (%make-narinfo path uri compression file-hash file-size nar-hash nar-size
-                 references deriver system)
+                 references deriver system signature contents)
   narinfo?
   (path         narinfo-path)
   (uri          narinfo-uri)
@@ -196,15 +207,49 @@ failure."
   (nar-size     narinfo-size)
   (references   narinfo-references)
   (deriver      narinfo-deriver)
-  (system       narinfo-system))
-
-(define (narinfo-maker cache-url)
-  "Return a narinfo constructor for narinfos originating from CACHE-URL."
+  (system       narinfo-system)
+  (signature    narinfo-signature)
+  ;; The original contents of a narinfo file.  This field is needed because we
+  ;; want to preserve the initial order of fields for verification purposes.
+  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
+  ;; for more information.
+  (contents     narinfo-contents))
+
+(define (parse-signature str)
+  "Parse the Signature field of a narinfo file."
+  (match (string-split str #\;)
+    ((version _ sig)
+     (let ((maybe-number (string->number version)))
+       (cond ((not (number? maybe-number))
+              (leave (_ "signature version must be a number: ~a~%")
+                     version))
+             ;; Currently, there are no other versions.
+             ((not (= 1 maybe-number))
+              (leave (_ "unsupported signature version: ~a~%")
+                     maybe-number))
+             (else (string->canonical-sexp
+                    (utf8->string (base64-decode sig)))))))
+    (x
+     (leave (_ "invalid format of the signature field: ~a~%") x))))
+
+(define* (verify-signature sig #:optional (acl (current-acl)))
+  "Verify the signature (a canonical-sexp) of a narinfo file."
+  (let ((key (signature-subject sig)))
+    (cond ((not (authorized-key? key acl))
+           (leave (_ "unauthorized public key: ~a~%")
+                  (canonical-sexp->string key)))
+          ((not (valid-signature? sig))
+           (leave (_ "invalid signature: ~a~%")
+                  (canonical-sexp->string sig)))
+          (else sig))))
+
+(define (narinfo-maker str cache-url)
+  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
+must contain the original contents of a narinfo file."
   (lambda (path url compression file-hash file-size nar-hash nar-size
-                references deriver system)
+                references deriver system signature)
     "Return a new <narinfo> object."
     (%make-narinfo path
-
                    ;; Handle the case where URL is a relative URL.
                    (or (string->uri url)
                        (string->uri (string-append cache-url "/" url)))
@@ -217,45 +262,39 @@ failure."
                    (match deriver
                      ((or #f "") #f)
                      (_ deriver))
-                   system)))
+                   system
+                   (parse-signature signature)
+                   str)))
 
-(define* (read-narinfo port #:optional url)
+(define* (read-narinfo port #:optional url (acl (current-acl)))
   "Read a narinfo from PORT in its standard external form.  If URL is true, it
 must be a string used to build full URIs from relative URIs found while
 reading PORT."
-  (alist->record (fields->alist port)
-                 (narinfo-maker url)
-                 '("StorePath" "URL" "Compression"
-                   "FileHash" "FileSize" "NarHash" "NarSize"
-                   "References" "Deriver" "System")))
+  (let* ((str     (begin (set-port-encoding! port "UTF-8")
+                         (get-string-all port)))
+         (rx      (make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$"))
+         (res     (or (regexp-exec rx str)
+                      (leave (_ "cannot find the Signature line: ~a~%")
+                             str)))
+         (hash    (sha256 (string->utf8 (match:substring res 1))))
+         (narinfo (alist->record (fields->alist (open-input-string str))
+                                 (narinfo-maker str url)
+                                 '("StorePath" "URL" "Compression"
+                                   "FileHash" "FileSize" "NarHash" "NarSize"
+                                   "References" "Deriver" "System"
+                                   "Signature"))))
+    (let-values (((signed-hash __) (hash-data->bytevector
+                                     (narinfo-signature narinfo))))
+      (if (equal? hash signed-hash)
+          (begin (verify-signature (narinfo-signature narinfo) acl)
+                 narinfo)
+          (leave (_ "signed hash ~a differs from the narinfo hash ~a~%")
+                 signed-hash hash)))))
 
 (define (write-narinfo narinfo port)
   "Write NARINFO to PORT."
-  (define (empty-string-if-false x)
-    (or x ""))
-
-  (define (number-or-empty-string x)
-    (if (number? x)
-        (number->string x)
-        ""))
-
-  (object->fields narinfo
-                  `(("StorePath" . ,narinfo-path)
-                    ("URL" . ,(compose uri->string narinfo-uri))
-                    ("Compression" . ,narinfo-compression)
-                    ("FileHash" . ,(compose empty-string-if-false
-                                            narinfo-file-hash))
-                    ("FileSize" . ,(compose number-or-empty-string
-                                            narinfo-file-size))
-                    ("NarHash" . ,(compose empty-string-if-false
-                                           narinfo-hash))
-                    ("NarSize" . ,(compose number-or-empty-string
-                                           narinfo-size))
-                    ("References" . ,(compose string-join narinfo-references))
-                    ("Deriver" . ,(compose empty-string-if-false
-                                           narinfo-deriver))
-                    ("System" . ,narinfo-system))
-                  port))
+  (set-port-encoding! port "UTF-8")
+  (put-string port (narinfo-contents narinfo)))
 
 (define (narinfo->string narinfo)
   "Return the external representation of NARINFO."
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
new file mode 100644
index 0000000..db46f33
--- /dev/null
+++ b/tests/substitute-binary.scm
@@ -0,0 +1,197 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.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 (test-substitute-binary)
+  #:use-module (guix scripts substitute-binary)
+  #:use-module (guix base64)
+  #:use-module (guix hash)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
+  #:use-module (rnrs bytevectors)
+  #:use-module ((srfi srfi-64) #:hide (test-error)))
+
+;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allows to catch
+;; specific exceptions.
+(define (test-error name key thunk val)
+  "Test whether THUNK throws particular error KEY, e.g., 'misc-error, by
+comparing expected VAL and the one returned by the handler.  This procedure
+assumes that THUNK itself will never return VAL, which is error-prone but
+better than catching everything with 'test-error' from SRFI-64."
+  (test-eq name val
+           (catch key
+                  thunk
+                  (const val))))
+
+(define (test-error* name thunk)
+  ;; XXX: This catches all calls to 'exit', which is also error-prone, so it
+  ;; should be replaced in the future.
+  (test-error name 'quit thunk #t))
+
+(define %keypair
+  ;; (display (canonical-sexp->string
+  ;;           (generate-key "(genkey (rsa (nbits 4:1024)))")))
+  (string->canonical-sexp
+   "(key-data
+ (public-key
+  (rsa
+   (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#)
+   (e #010001#)
+   )
+  )
+ (private-key
+  (rsa
+   (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#)
+   (e #010001#)
+   (d #40E6D963EF143E9241BC10DE7A785C988C89EB1EC33253A5796AFB38FCC804D015500EC8CBCA0F5E318EE9D660DC19E7774E2E89BFD38379297EA87EFBDAC24BA32EE5339215382B2C89F5A817FD9131CA8E8A0A70D58E26E847AD0C447053671A6B2D7746087DE058A02B17701752B8A36EB414435921615AE7CAA8AC48E451#)
+   (p #00EA88C0C19FE83C09285EF49FF88A1159357FD870031C20F15EF5103FBEB10925299BCA197F7143D6792A1BA7044EDA572EC94FA6B00889F9857216CF5B984403#)
+   (q #00EAFE541EE9E0531255A85CADBEF64D5F679766D7209F521ADD131CF4B7DA9DF5414901342A146EE84FAA1E35EE0D0F6CE3F5F25989C0D1E9FA5B678D78C113C9#)
+   (u #59C80FA2C48181F6855691C9D443619BA46C7648056E081697C370D8096E8EF165122D5E55F8FD6A2DCC404FA8BDCDC1FD20B4D76A433F25E8FD6901EC2DBDAD#)
+   )
+  )
+ )"))
+
+(define %public-key
+  (find-sexp-token %keypair 'public-key))
+
+(define %private-key
+  (find-sexp-token %keypair 'private-key))
+
+(define (signature-body str)
+  (base64-encode
+   (string->utf8
+    (canonical-sexp->string
+     (signature-sexp (bytevector->hash-data (sha256 (string->utf8 str)))
+                     %private-key
+                     %public-key)))))
+
+(define %signature-body
+  (signature-body "secret"))
+
+(define %wrong-public-key
+  ;; (display
+  ;;  (canonical-sexp->string
+  ;;   (find-sexp-token (generate-key "(genkey (rsa (nbits 4:1024)))")
+  ;;                    'public-key)))
+  (string->canonical-sexp "(public-key
+ (rsa
+  (n #00E05873AC2B168760343145918E954EE9AB73C026355693B192E01EE835261AA689E9EF46642E895BCD65C648524059FC450E4BA77A68F4C52D0E39EF0CC9359709AB6AAB153B63782201871325B0FDA19CB401CD99FD0C31A91CA9000AA90A77E82B89E036FB63BC1D3961207469B3B12468977148D376F8012BB12A4B11A8F1#)
+  (e #010001#)
+  )
+ )"))
+
+(define %wrong-signature
+  (let* ((body (string->canonical-sexp
+                (utf8->string
+                 (base64-decode %signature-body))))
+         (data       (canonical-sexp->string (find-sexp-token body 'data)))
+         (sig-val    (canonical-sexp->string (find-sexp-token body 'sig-val)))
+         (public-key (canonical-sexp->string %wrong-public-key))
+         (body*      (base64-encode
+                      (string->utf8
+                       (string-append "(signature \n" data sig-val
+                                      public-key " )\n")))))
+    (string-append "1;irrelevant;" body*)))
+
+(define* (signature str #:optional (body %signature-body))
+  (string-append str ";irrelevant;" body))
+
+(define %signature
+  (signature "1" %signature-body))
+
+(define %acl
+  (public-keys->acl (list %public-key)))
+
+(test-begin "parse-signature")
+
+(test-error* "not a number"
+  (lambda ()
+    (parse-signature (signature "not a number"))))
+
+(test-error* "wrong version number"
+  (lambda ()
+    (parse-signature (signature "2"))))
+
+(test-assert "valid"
+  (lambda ()
+    (parse-signature %signature)))
+
+(test-end "parse-signature")
+
+(test-begin "verify-signature")
+
+(test-error* "unauthorized key"
+  (lambda ()
+    (verify-signature (parse-signature %signature)
+                      (public-keys->acl '()))))
+
+(test-error* "invalid signature"
+  (lambda ()
+    (verify-signature (parse-signature %wrong-signature)
+                      (public-keys->acl (list %wrong-public-key)))))
+
+(test-error* "invalid signature format"
+  (lambda ()
+    (verify-signature (parse-signature "no signature here") %acl)))
+
+(test-assert "valid"
+  (lambda ()
+    (verify-signature (parse-signature %signature) %acl)))
+
+(test-end "verify-signature")
+
+(define %narinfo
+  "StorePath: /nix/store/foo
+URL: nar/foo
+Compression: bzip2
+NarHash: sha256:7
+NarSize: 42
+References: bar baz
+Deriver: foo.drv
+System: mips64el-linux\n")
+
+(define (narinfo sig)
+  (format #f "~aSignature: ~a~%" %narinfo sig))
+
+(define %signed-narinfo
+  (narinfo (signature "1" (signature-body %narinfo))))
+
+(test-begin "read-narinfo")
+
+(test-error* "invalid hash"
+  (lambda ()
+    (read-narinfo (open-input-string (narinfo %signature))
+                  "https://example.com" %acl)))
+
+(test-assert "valid"
+  (lambda ()
+    (read-narinfo (open-input-string %signed-narinfo)
+                  "https://example.com" %acl)))
+
+(test-end "read-narinfo")
+
+(test-begin "write-narinfo")
+
+(let ((port (open-output-string)))
+  (test-equal "valid"
+    %signed-narinfo
+    (begin (write-narinfo (read-narinfo (open-input-string %signed-narinfo)
+                                        "https://example.com" %acl)
+                          port)
+           (get-output-string port))))
+
+(test-end "write-narinfo")

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

(Could you keep more context when replying, to make it easier to find
out what we’re referring to?)

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> For simplicity, change this pattern to ("1" id body).  That will allow
>> the inner ‘cond’ to be simplified.
>
> I like informative error messages, may I keep it please?  The attached
> diff should address all the things you mentioned except this one.
> Please review.

OK.

> I’m planning to send a proper patch as soon as I test (guix base64) and
> change a couple of things in (test-substitute-binary).

Cool, thanks!

> -(define (narinfo-maker cache-url)
> -  "Return a narinfo constructor for narinfos originating from CACHE-URL."
> +  (system       narinfo-system)
> +  (signature    narinfo-signature)

Add “canonical sexp” as a comment on the right.

> +  ;; The original contents of a narinfo file.  This field is needed because we
> +  ;; want to preserve the initial order of fields for verification purposes.
> +  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
> +  ;; for more information.
> +  (contents     narinfo-contents))

s/initial order of fields/exact textual representation/

> +(define (parse-signature str)
> +  "Parse the Signature field of a narinfo file."

Rather something like:

  "Return the as a canonical sexp the signature read from STR, the value
of a narinfo’s ‘Signature’ field."

> +(define* (verify-signature sig #:optional (acl (current-acl)))

I really prefer something like ‘assert-valid-signature’ (possibly
copy/pasted from nar.scm) because:

  1. The name reflects that it’s a check whose failure leads to a
     non-local exit, and that the return value doesn’t matter.

  2. ‘assert-valid-signature’ in nar.scm does all the checks, including
     the hash comparison, which IMO makes it easier to see that we’re
     not forgetting anything.

WDYT?

(In the light of Apple’s “goto fail” story, it makes sense to pay extra
attention to the way we write these things.)

>  (define (write-narinfo narinfo port)
>    "Write NARINFO to PORT."

[...]

> +  (set-port-encoding! port "UTF-8")
> +  (put-string port (narinfo-contents narinfo)))

I’d prefer:

  (put-bytevector port (string->utf8 (narinfo-contents narinfo)))

> +(define-module (test-substitute-binary)
> +  #:use-module (guix scripts substitute-binary)
> +  #:use-module (guix base64)
> +  #:use-module (guix hash)
> +  #:use-module (guix pk-crypto)
> +  #:use-module (guix pki)
> +  #:use-module (rnrs bytevectors)
> +  #:use-module ((srfi srfi-64) #:hide (test-error)))
> +
> +;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allows to catch
> +;; specific exceptions.

“allows us”

> +(define %wrong-public-key
> +  ;; (display
> +  ;;  (canonical-sexp->string
> +  ;;   (find-sexp-token (generate-key "(genkey (rsa (nbits 4:1024)))")
> +  ;;                    'public-key)))

You can remove the comment here.

> +(test-begin "parse-signature")

Actually there should be only one ‘test-begin’ per file, and it should
be (test-begin "file-name-without-extension").  That’s because that is
then used as the base of the .log file name.

> +(test-assert "valid"
> +  (lambda ()
> +    (parse-signature %signature)))

This test will always pass because (lambda () ...) is true.
Instead it should read:

  (test-assert "valid"
    (canonical-sexp? (parse-signature %signature)))

For consistency, I would write test-error* like:

  (define-syntax-rule (test-error* name exp)
    (test-assert name
      (catch 'quit
        (lambda ()
          exp
          #f)
        (lambda args
          #t))))

because then “(lambda () ...)” can be omitted.

> +(test-error* "invalid hash"
> +  (lambda ()
> +    (read-narinfo (open-input-string (narinfo %signature))
> +                  "https://example.com" %acl)))

For these tests, could you add one-line comments specifying why they
should fail?  I’m asking because I got lost as to why %SIGNATURE here
should have a hash mismatch.

> +(test-assert "valid"
> +  (lambda ()
> +    (read-narinfo (open-input-string %signed-narinfo)
> +                  "https://example.com" %acl)))

Same as above: remove (lambda () ...).

> +(let ((port (open-output-string)))
> +  (test-equal "valid"
> +    %signed-narinfo
> +    (begin (write-narinfo (read-narinfo (open-input-string %signed-narinfo)
> +                                        "https://example.com" %acl)
> +                          port)
> +           (get-output-string port))))

Rather:

  (test-equal "valid"
    %signed-narinfo
    (call-with-output-string
      (lambda (port)
        ...)))

Thank you for the great work!

Ludo’.

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 487 bytes --]

Still WIP, sorry.   Please take a look anyway.

I think the current docstring of ‘assert-valid-signature’ is not correct
since ‘signature’ must be a string (as produced by
‘canonical-sexp->string’), not an sexp.

Similarly, the “signature is not a valid s-expression” and “corrupt
signature data” messages are a bit confusing due to the way
‘string->canonical-sexp’ works (try ‘string->canonical-sexp "foo"’).
But I may be wrong about the latter.


[-- Attachment #1.2: signature2.diff4 --]
[-- Type: text/plain, Size: 33113 bytes --]

diff --git a/guix/base64.scm b/guix/base64.scm
new file mode 100644
index 0000000..f7f7f5f
--- /dev/null
+++ b/guix/base64.scm
@@ -0,0 +1,212 @@
+;; -*- mode: scheme; coding: utf-8 -*-
+;;
+;; This module was renamed from (weinholt text base64 (1 0 20100612)) to
+;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
+;; February 12, 2014.
+;;
+;; Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
+;;
+;; This program 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.
+;;
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+#!r6rs
+
+;; RFC 4648 Base-N Encodings
+
+(library (guix base64)
+  (export base64-encode
+          base64-decode
+          base64-alphabet
+          base64url-alphabet
+          get-delimited-base64
+          put-delimited-base64)
+  (import (rnrs)
+          (only (srfi :13 strings)
+                string-index
+                string-prefix? string-suffix?
+                string-concatenate string-trim-both))
+
+  (define base64-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+
+  (define base64url-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
+
+  (define base64-encode
+    (case-lambda
+      ;; Simple interface. Returns a string containing the canonical
+      ;; base64 representation of the given bytevector.
+      ((bv)
+       (base64-encode bv 0 (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start)
+       (base64-encode bv start (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start end)
+       (base64-encode bv start end #f #f base64-alphabet #f))
+      ((bv start end line-length)
+       (base64-encode bv start end line-length #f base64-alphabet #f))
+      ((bv start end line-length no-padding)
+       (base64-encode bv start end line-length no-padding base64-alphabet #f))
+      ((bv start end line-length no-padding alphabet)
+       (base64-encode bv start end line-length no-padding alphabet #f))
+      ;; Base64 encodes the bytes [start,end[ in the given bytevector.
+      ;; Lines are limited to line-length characters (unless #f),
+      ;; which must be a multiple of four. To omit the padding
+      ;; characters (#\=) set no-padding to a true value. If port is
+      ;; #f, returns a string.
+      ((bv start end line-length no-padding alphabet port)
+       (assert (or (not line-length) (zero? (mod line-length 4))))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-string-output-port))))
+         (letrec ((put (if line-length
+                           (let ((chars 0))
+                             (lambda (p c)
+                               (when (fx=? chars line-length)
+                                 (set! chars 0)
+                                 (put-char p #\linefeed))
+                               (set! chars (fx+ chars 1))
+                               (put-char p c)))
+                           put-char)))
+           (let lp ((i start))
+             (cond ((= i end))
+                   ((<= (+ i 3) end)
+                    (let ((x (bytevector-uint-ref bv i (endianness big) 3)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (put p (string-ref alphabet (fxbit-field x 0 6)))
+                      (lp (+ i 3))))
+                   ((<= (+ i 2) end)
+                    (let ((x (fxarithmetic-shift-left (bytevector-u16-ref bv i (endianness big)) 8)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (unless no-padding
+                        (put p #\=))))
+                   (else
+                    (let ((x (fxarithmetic-shift-left (bytevector-u8-ref bv i) 16)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (unless no-padding
+                        (put p #\=)
+                        (put p #\=)))))))
+         (extract)))))
+
+  ;; Decodes a base64 string. The string must contain only pure
+  ;; unpadded base64 data.
+  (define base64-decode
+    (case-lambda
+      ((str)
+       (base64-decode str base64-alphabet #f))
+      ((str alphabet)
+       (base64-decode str alphabet #f))
+      ((str alphabet port)
+       (unless (zero? (mod (string-length str) 4))
+         (error 'base64-decode
+                "input string must be a multiple of four characters"))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-bytevector-output-port))))
+         (do ((i 0 (+ i 4)))
+             ((= i (string-length str))
+              (extract))
+           (let ((c1 (string-ref str i))
+                 (c2 (string-ref str (+ i 1)))
+                 (c3 (string-ref str (+ i 2)))
+                 (c4 (string-ref str (+ i 3))))
+             ;; TODO: be more clever than string-index
+             (let ((i1 (string-index alphabet c1))
+                   (i2 (string-index alphabet c2))
+                   (i3 (string-index alphabet c3))
+                   (i4 (string-index alphabet c4)))
+               (cond ((and i1 i2 i3 i4)
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6)
+                                      i4)))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))
+                        (put-u8 p (fxbit-field x 0 8))))
+                     ((and i1 i2 i3 (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6))))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))))
+                     ((and i1 i2 (char=? c3 #\=) (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12))))
+                        (put-u8 p (fxbit-field x 16 24))))
+                     (else
+                      (error 'base64-decode "invalid input"
+                             (list c1 c2 c3 c4)))))))))))
+
+  (define (get-line-comp f port)
+    (if (port-eof? port)
+        (eof-object)
+        (f (get-line port))))
+
+  ;; Reads the common -----BEGIN/END type----- delimited format from
+  ;; the given port. Returns two values: a string with the type and a
+  ;; bytevector containing the base64 decoded data. The second value
+  ;; is the eof object if there is an eof before the BEGIN delimiter.
+  (define (get-delimited-base64 port)
+    (define (get-first-data-line port)
+      ;; Some MIME data has header fields in the same format as mail
+      ;; or http. These are ignored.
+      (let ((line (get-line-comp string-trim-both port)))
+        (cond ((eof-object? line) line)
+              ((string-index line #\:)
+               (let lp ()               ;read until empty line
+                 (let ((line (get-line-comp string-trim-both port)))
+                   (if (string=? line "")
+                       (get-line-comp string-trim-both port)
+                       (lp)))))
+              (else line))))
+    (let ((line (get-line-comp string-trim-both port)))
+      (cond ((eof-object? line)
+             (values "" (eof-object)))
+            ((string=? line "")
+             (get-delimited-base64 port))
+            ((and (string-prefix? "-----BEGIN " line)
+                  (string-suffix? "-----" line))
+             (let* ((type (substring line 11 (- (string-length line) 5)))
+                    (endline (string-append "-----END " type "-----")))
+               (let-values (((outp extract) (open-bytevector-output-port)))
+                 (let lp ((line (get-first-data-line port)))
+                   (cond ((eof-object? line)
+                          (error 'get-delimited-base64
+                                 "unexpected end of file"))
+                         ((string-prefix? "-" line)
+                          (unless (string=? line endline)
+                            (error 'get-delimited-base64
+                                   "bad end delimiter" type line))
+                          (values type (extract)))
+                         (else
+                          (unless (and (= (string-length line) 5)
+                                       (string-prefix? "=" line)) ;Skip Radix-64 checksum
+                            (base64-decode line base64-alphabet outp))
+                          (lp (get-line-comp string-trim-both port))))))))
+            (else ;skip garbage (like in openssl x509 -in foo -text output).
+             (get-delimited-base64 port)))))
+
+  (define put-delimited-base64
+    (case-lambda
+      ((port type bv line-length)
+       (display (string-append "-----BEGIN " type "-----\n") port)
+       (base64-encode bv 0 (bytevector-length bv)
+                      line-length #f base64-alphabet port)
+       (display (string-append "\n-----END " type "-----\n") port))
+      ((port type bv)
+       (put-delimited-base64 port type bv 76)))))
\ No newline at end of file
diff --git a/guix/nar.scm b/guix/nar.scm
index 5bf1745..d896c7f 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,6 +53,7 @@
             write-file
             restore-file
 
+            assert-valid-signature
             restore-file-set))
 
 ;;; Comment:
@@ -345,6 +347,46 @@ protected from garbage collection."
           template)
         (temporary-store-directory))))
 
+(define* (assert-valid-signature signature hash port
+                                 #:optional (acl (current-acl)))
+  ;; Bail out if SIGNATURE, a string, doesn't match HASH, a bytevector
+  ;; containing the expected hash for PORT.
+  (let* ((file      (port-filename port))
+         (signature (catch 'gcry-error
+                      (lambda ()
+                        (string->canonical-sexp signature))
+                      (lambda (err . _)
+                        (raise (condition
+                                (&message
+                                 (message "signature is not a valid \
+s-expression"))
+                                (&nar-signature-error
+                                 (file file)
+                                 (signature signature) (port port)))))))
+         (subject   (signature-subject signature))
+         (data      (signature-signed-data signature)))
+    (if (and data subject)
+        (if (authorized-key? subject acl)
+            (if (equal? (hash-data->bytevector data) hash)
+                (unless (valid-signature? signature)
+                  (raise (condition
+                          (&message (message "invalid signature"))
+                          (&nar-signature-error
+                           (file file) (signature signature) (port port)))))
+                (raise (condition (&message (message "invalid hash"))
+                                  (&nar-invalid-hash-error
+                                   (port port) (file file)
+                                   (signature signature)
+                                   (expected (hash-data->bytevector data))
+                                   (actual hash)))))
+            (raise (condition (&message (message "unauthorized public key"))
+                              (&nar-signature-error
+                               (signature signature) (file file) (port port)))))
+        (raise (condition
+                (&message (message "corrupt signature data"))
+                (&nar-signature-error
+                 (signature signature) (file file) (port port)))))))
+
 (define* (restore-file-set port
                            #:key (verify-signature? #t) (lock? #t)
                            (log-port (current-error-port)))
@@ -368,44 +410,6 @@ while the locks are held."
     ;; Keep that one around, for error conditions.
     port)
 
-  (define (assert-valid-signature signature hash file)
-    ;; Bail out if SIGNATURE, an sexp, doesn't match HASH, a bytevector
-    ;; containing the expected hash for FILE.
-    (let* ((signature (catch 'gcry-error
-                        (lambda ()
-                          (string->canonical-sexp signature))
-                        (lambda (err . _)
-                          (raise (condition
-                                  (&message
-                                   (message "signature is not a valid \
-s-expression"))
-                                  (&nar-signature-error
-                                   (file file)
-                                   (signature signature) (port port)))))))
-           (subject   (signature-subject signature))
-           (data      (signature-signed-data signature)))
-      (if (and data subject)
-          (if (authorized-key? subject)
-              (if (equal? (hash-data->bytevector data) hash)
-                  (unless (valid-signature? signature)
-                    (raise (condition
-                            (&message (message "invalid signature"))
-                            (&nar-signature-error
-                             (file file) (signature signature) (port port)))))
-                  (raise (condition (&message (message "invalid hash"))
-                                    (&nar-invalid-hash-error
-                                     (port port) (file file)
-                                     (signature signature)
-                                     (expected (hash-data->bytevector data))
-                                     (actual hash)))))
-              (raise (condition (&message (message "unauthorized public key"))
-                                (&nar-signature-error
-                                 (signature signature) (file file) (port port)))))
-          (raise (condition
-                  (&message (message "corrupt signature data"))
-                  (&nar-signature-error
-                   (signature signature) (file file) (port port)))))))
-
   (let loop ((n     (read-long-long port))
              (files '()))
     (case n
@@ -436,7 +440,7 @@ s-expression"))
                (when verify-signature?
                  (if sig
                      (begin
-                       (assert-valid-signature sig hash file)
+                       (assert-valid-signature sig hash port)
                        (format log-port
                                (_ "found valid signature for '~a'~%")
                                file)
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 3aaa1c4..d7f546c 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,10 @@
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module (guix nar)
+  #:use-module (guix hash)
+  #:use-module (guix base64)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix build download)
                 #:select (progress-proc uri-abbreviation))
@@ -33,6 +38,8 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
@@ -40,7 +47,10 @@
   #:use-module (srfi srfi-26)
   #:use-module (web uri)
   #:use-module (guix http-client)
-  #:export (guix-substitute-binary))
+  #:export (parse-signature
+            read-narinfo
+            write-narinfo
+            guix-substitute-binary))
 
 ;;; Comment:
 ;;;
@@ -185,7 +195,7 @@ failure."
 
 (define-record-type <narinfo>
   (%make-narinfo path uri compression file-hash file-size nar-hash nar-size
-                 references deriver system)
+                 references deriver system signature contents)
   narinfo?
   (path         narinfo-path)
   (uri          narinfo-uri)
@@ -196,15 +206,38 @@ failure."
   (nar-size     narinfo-size)
   (references   narinfo-references)
   (deriver      narinfo-deriver)
-  (system       narinfo-system))
-
-(define (narinfo-maker cache-url)
-  "Return a narinfo constructor for narinfos originating from CACHE-URL."
+  (system       narinfo-system)
+  (signature    narinfo-signature)      ; canonical sexp
+  ;; The original contents of a narinfo file.  This field is needed because we
+  ;; want to preserve the exact textual representation for verification purposes.
+  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
+  ;; for more information.
+  (contents     narinfo-contents))
+
+(define (parse-signature str)
+  "Return the value of a narinfo's 'Signature' field as a canonical sexp."
+  (match (string-split str #\;)
+    ((version _ sig)
+     (let ((maybe-number (string->number version)))
+       (cond ((not (number? maybe-number))
+              (leave (_ "signature version must be a number: ~a~%")
+                     version))
+             ;; Currently, there are no other versions.
+             ((not (= 1 maybe-number))
+              (leave (_ "unsupported signature version: ~a~%")
+                     maybe-number))
+             (else (string->canonical-sexp
+                    (utf8->string (base64-decode sig)))))))
+    (x
+     (leave (_ "invalid format of the signature field: ~a~%") x))))
+
+(define (narinfo-maker str cache-url)
+  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
+must contain the original contents of a narinfo file."
   (lambda (path url compression file-hash file-size nar-hash nar-size
-                references deriver system)
+                references deriver system signature)
     "Return a new <narinfo> object."
     (%make-narinfo path
-
                    ;; Handle the case where URL is a relative URL.
                    (or (string->uri url)
                        (string->uri (string-append cache-url "/" url)))
@@ -217,45 +250,33 @@ failure."
                    (match deriver
                      ((or #f "") #f)
                      (_ deriver))
-                   system)))
-
-(define* (read-narinfo port #:optional url)
-  "Read a narinfo from PORT in its standard external form.  If URL is true, it
-must be a string used to build full URIs from relative URIs found while
-reading PORT."
-  (alist->record (fields->alist port)
-                 (narinfo-maker url)
-                 '("StorePath" "URL" "Compression"
-                   "FileHash" "FileSize" "NarHash" "NarSize"
-                   "References" "Deriver" "System")))
+                   system
+                   (parse-signature signature)
+                   str)))
+
+(define* (read-narinfo port #:optional url (acl (current-acl)))
+  "Read a narinfo from PORT.  If URL is true, it must be a string used to
+build full URIs from relative URIs found while reading PORT."
+  (let* ((str       (begin (set-port-encoding! port "UTF-8")
+                           (get-string-all port)))
+         (rx        (make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$"))
+         (res       (or (regexp-exec rx str)
+                        (leave (_ "cannot find the Signature line: ~a~%")
+                               str)))
+         (hash      (sha256 (string->utf8 (match:substring res 1))))
+         (narinfo   (alist->record (fields->alist (open-input-string str))
+                                   (narinfo-maker str url)
+                                   '("StorePath" "URL" "Compression"
+                                     "FileHash" "FileSize" "NarHash" "NarSize"
+                                     "References" "Deriver" "System"
+                                     "Signature")))
+         (signature (canonical-sexp->string (narinfo-signature narinfo))))
+    (assert-valid-signature signature hash port acl)
+    narinfo))
 
 (define (write-narinfo narinfo port)
   "Write NARINFO to PORT."
-  (define (empty-string-if-false x)
-    (or x ""))
-
-  (define (number-or-empty-string x)
-    (if (number? x)
-        (number->string x)
-        ""))
-
-  (object->fields narinfo
-                  `(("StorePath" . ,narinfo-path)
-                    ("URL" . ,(compose uri->string narinfo-uri))
-                    ("Compression" . ,narinfo-compression)
-                    ("FileHash" . ,(compose empty-string-if-false
-                                            narinfo-file-hash))
-                    ("FileSize" . ,(compose number-or-empty-string
-                                            narinfo-file-size))
-                    ("NarHash" . ,(compose empty-string-if-false
-                                           narinfo-hash))
-                    ("NarSize" . ,(compose number-or-empty-string
-                                           narinfo-size))
-                    ("References" . ,(compose string-join narinfo-references))
-                    ("Deriver" . ,(compose empty-string-if-false
-                                           narinfo-deriver))
-                    ("System" . ,narinfo-system))
-                  port))
+  (put-bytevector port (string->utf8 (narinfo-contents narinfo))))
 
 (define (narinfo->string narinfo)
   "Return the external representation of NARINFO."
diff --git a/tests/base64.scm b/tests/base64.scm
new file mode 100644
index 0000000..99c02b5
--- /dev/null
+++ b/tests/base64.scm
@@ -0,0 +1,59 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.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 (test-base64)
+  #:use-module (guix base64)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-64))
+
+(define (string->base64 str)
+  (base64-encode (string->utf8 str)))
+
+;;; Test vectors from <https://tools.ietf.org/rfc/rfc4648.txt>.
+
+(test-begin "base64")
+
+(test-equal "empty string"
+  (string->base64 "")
+  "")
+
+(test-equal "f"
+  (string->base64 "f")
+  "Zg==")
+
+(test-equal "fo"
+  (string->base64 "fo")
+  "Zm8=")
+
+(test-equal "foo"
+  (string->base64 "foo")
+  "Zm9v")
+
+(test-equal "foob"
+  (string->base64 "foob")
+  "Zm9vYg==")
+
+(test-equal "fooba"
+  (string->base64 "fooba")
+  "Zm9vYmE=")
+
+(test-equal "foobar"
+  (string->base64 "foobar")
+  "Zm9vYmFy")
+
+(test-end "base64")
\ No newline at end of file
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
new file mode 100644
index 0000000..457fa56
--- /dev/null
+++ b/tests/substitute-binary.scm
@@ -0,0 +1,189 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 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 (test-substitute-binary)
+  #:use-module (guix scripts substitute-binary)
+  #:use-module (guix base64)
+  #:use-module (guix hash)
+  #:use-module (guix nar)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-34)
+  #:use-module ((srfi srfi-64) #:hide (test-error)))
+
+;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to catch
+;; specific exceptions.
+(define-syntax-rule (test-error* name exp)
+  (test-assert name
+    (catch 'quit
+      (lambda ()
+        exp
+        #f)
+      (const #t))))
+
+(define %keypair
+  ;; (display (canonical-sexp->string
+  ;;           (generate-key "(genkey (rsa (nbits 4:1024)))")))
+  (string->canonical-sexp
+   "(key-data
+ (public-key
+  (rsa
+   (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#)
+   (e #010001#)
+   )
+  )
+ (private-key
+  (rsa
+   (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#)
+   (e #010001#)
+   (d #40E6D963EF143E9241BC10DE7A785C988C89EB1EC33253A5796AFB38FCC804D015500EC8CBCA0F5E318EE9D660DC19E7774E2E89BFD38379297EA87EFBDAC24BA32EE5339215382B2C89F5A817FD9131CA8E8A0A70D58E26E847AD0C447053671A6B2D7746087DE058A02B17701752B8A36EB414435921615AE7CAA8AC48E451#)
+   (p #00EA88C0C19FE83C09285EF49FF88A1159357FD870031C20F15EF5103FBEB10925299BCA197F7143D6792A1BA7044EDA572EC94FA6B00889F9857216CF5B984403#)
+   (q #00EAFE541EE9E0531255A85CADBEF64D5F679766D7209F521ADD131CF4B7DA9DF5414901342A146EE84FAA1E35EE0D0F6CE3F5F25989C0D1E9FA5B678D78C113C9#)
+   (u #59C80FA2C48181F6855691C9D443619BA46C7648056E081697C370D8096E8EF165122D5E55F8FD6A2DCC404FA8BDCDC1FD20B4D76A433F25E8FD6901EC2DBDAD#)
+   )
+  )
+ )"))
+
+(define %public-key
+  (find-sexp-token %keypair 'public-key))
+
+(define %private-key
+  (find-sexp-token %keypair 'private-key))
+
+(define (signature-body str)
+  (base64-encode
+   (string->utf8
+    (canonical-sexp->string
+     (signature-sexp (bytevector->hash-data (sha256 (string->utf8 str)))
+                     %private-key
+                     %public-key)))))
+
+(define %signature-body
+  (signature-body "secret"))
+
+(define %wrong-public-key
+  (string->canonical-sexp "(public-key
+ (rsa
+  (n #00E05873AC2B168760343145918E954EE9AB73C026355693B192E01EE835261AA689E9EF46642E895BCD65C648524059FC450E4BA77A68F4C52D0E39EF0CC9359709AB6AAB153B63782201871325B0FDA19CB401CD99FD0C31A91CA9000AA90A77E82B89E036FB63BC1D3961207469B3B12468977148D376F8012BB12A4B11A8F1#)
+  (e #010001#)
+  )
+ )"))
+
+(define %wrong-signature
+  (let* ((body (string->canonical-sexp
+                (utf8->string
+                 (base64-decode %signature-body))))
+         (data       (canonical-sexp->string (find-sexp-token body 'data)))
+         (sig-val    (canonical-sexp->string (find-sexp-token body 'sig-val)))
+         (public-key (canonical-sexp->string %wrong-public-key))
+         (body*      (base64-encode
+                      (string->utf8
+                       (string-append "(signature \n" data sig-val
+                                      public-key " )\n")))))
+    (string-append "1;irrelevant;" body*)))
+
+(define* (signature str #:optional (body %signature-body))
+  (string-append str ";irrelevant;" body))
+
+(define %signature
+  (signature "1" %signature-body))
+
+(define %acl
+  (public-keys->acl (list %public-key)))
+
+(test-begin "substitute-binary")
+
+(test-error* "not a number"
+  (parse-signature (signature "not a number")))
+
+(test-error* "wrong version number"
+  (parse-signature (signature "2")))
+
+(test-assert "valid parse-signature"
+  (canonical-sexp? (parse-signature %signature)))
+
+;;; XXX: Fight boilerplate with a macro.
+;;; XXX: Do we need a better predicate hierarchy for these tests?
+(test-assert "corrupt signature data"
+  (guard (condition
+          ((nar-signature-error? condition) #t)
+          (else #f))
+    (assert-valid-signature "invalid sexp" "irrelevant"
+                            (open-input-string "irrelevant")
+                            %acl)))
+
+(test-assert "unauthorized public key"
+  (guard (condition
+          ((nar-signature-error? condition) #t)
+          (else #f))
+    (assert-valid-signature (canonical-sexp->string
+                             (parse-signature %signature))
+                            "irrelevant"
+                            (open-input-string "irrelevant")
+                            (public-keys->acl '()))))
+
+(test-assert "invalid signature"
+  (guard (condition
+          ((nar-signature-error? condition) #t)
+          (else #f))
+    (assert-valid-signature (canonical-sexp->string
+                             (parse-signature %wrong-signature))
+                            (sha256 (string->utf8 "secret"))
+                            (open-input-string "irrelevant")
+                            (public-keys->acl (list %wrong-public-key)))))
+
+(define %narinfo
+  "StorePath: /nix/store/foo
+URL: nar/foo
+Compression: bzip2
+NarHash: sha256:7
+NarSize: 42
+References: bar baz
+Deriver: foo.drv
+System: mips64el-linux\n")
+
+(define (narinfo sig)
+  (format #f "~aSignature: ~a~%" %narinfo sig))
+
+(define %signed-narinfo
+  (narinfo (signature "1" (signature-body %narinfo))))
+
+(test-assert "invalid hash"
+  ;; The hash of '%signature' is computed over the word "secret", not
+  ;; '%narinfo'.
+  (guard (condition
+          ((nar-invalid-hash-error? condition))
+          (else #f))
+    (read-narinfo (open-input-string (narinfo %signature))
+                  "https://example.com" %acl)))
+
+(test-assert "valid read-narinfo"
+  (read-narinfo (open-input-string %signed-narinfo)
+                "https://example.com" %acl))
+
+(test-equal "valid write-narinfo"
+  %signed-narinfo
+  (call-with-output-string
+   (lambda (port)
+     (write-narinfo (read-narinfo (open-input-string %signed-narinfo)
+                                  "https://example.com" %acl)
+                    port))))
+
+(test-end "substitute-binary")

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 168 bytes --]

> +          ((nar-invalid-hash-error? condition))

Should be ((nar-invalid-hash-error? condition) #t), I guess.  Otherwise,
the procedure returns ‘undefined’.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> +          ((nar-invalid-hash-error? condition))
>
> Should be ((nar-invalid-hash-error? condition) #t), I guess.  Otherwise,
> the procedure returns ‘undefined’.

Sorry, what’s the context of the above code?

Ludo’.

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> I think the current docstring of ‘assert-valid-signature’ is not correct
> since ‘signature’ must be a string (as produced by
> ‘canonical-sexp->string’), not an sexp.

In guix/nar.scm, the comment is:

  (define (assert-valid-signature signature hash file)
    ;; Bail out if SIGNATURE, an sexp, doesn't match HASH, a bytevector
    ;; containing the expected hash for FILE.

and indeed, SIGNATURE must be a string here.

> Similarly, the “signature is not a valid s-expression” and “corrupt
> signature data” messages are a bit confusing due to the way
> ‘string->canonical-sexp’ works (try ‘string->canonical-sexp "foo"’).
> But I may be wrong about the latter.

Ah right, you could get “corrupt signature data” when
(string->canonical-sexp signature) returns the null canonical sexp,
whereas you’d want “not a valid s-expression”.

Well, we can fix that in a separate patch if you want.

> +(define* (assert-valid-signature signature hash port
> +                                 #:optional (acl (current-acl)))
> +  ;; Bail out if SIGNATURE, a string, doesn't match HASH, a bytevector
> +  ;; containing the expected hash for PORT.

Make it a docstring.

Also, please make this change a separate patch.

> +  (let* ((file      (port-filename port))

I don’t think this will work, because most of the time PORT is a pipe
(an input port), whereas FILE is supposed to be the name of the file
being restored.

> +                (raise (condition (&message (message "invalid hash"))
> +                                  (&nar-invalid-hash-error
> +                                   (port port) (file file)
> +                                   (signature signature)
> +                                   (expected (hash-data->bytevector data))
> +                                   (actual hash)))))
> +            (raise (condition (&message (message "unauthorized public key"))
> +                              (&nar-signature-error
> +                               (signature signature) (file file) (port port)))))
> +        (raise (condition
> +                (&message (message "corrupt signature data"))
> +                (&nar-signature-error
> +                 (signature signature) (file file) (port port)))))))

Actually, the problem with making ‘assert-valid-signature’ public is
that it raises &nar error conditions.

It could be changed to raise a more generic &signature-error, but then
‘restore-file-set’ would have to guard against it to re-throw it along
with a &nar-error (making a compound condition.)  And then ui.scm would
figure it out.  Blech.

It’s worth factorizing, but I don’t see how to do it nicely.  Thoughts?

> +(define (parse-signature str)
> +  "Return the value of a narinfo's 'Signature' field as a canonical sexp."

I don’t remember if I said it before, but I’d prefer a name like
‘narinfo-signature->canonical-sexp’.

> +(define* (read-narinfo port #:optional url (acl (current-acl)))
> +  "Read a narinfo from PORT.  If URL is true, it must be a string used to
> +build full URIs from relative URIs found while reading PORT."
> +  (let* ((str       (begin (set-port-encoding! port "UTF-8")
> +                           (get-string-all port)))

Rather set the encoding when PORT is created, or use

  (utf8->string (get-bytevector-all port))

That’s it.

Did I miss something?

Thanks,
Ludo’.

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 3110 bytes --]

>> I think the current docstring of ‘assert-valid-signature’ is not correct
>> since ‘signature’ must be a string (as produced by
>> ‘canonical-sexp->string’), not an sexp.

> In guix/nar.scm, the comment is:

>   (define (assert-valid-signature signature hash file)
>     ;; Bail out if SIGNATURE, an sexp, doesn't match HASH, a bytevector
>     ;; containing the expected hash for FILE.

> and indeed, SIGNATURE must be a string here.

>> Similarly, the “signature is not a valid s-expression” and “corrupt
>> signature data” messages are a bit confusing due to the way
>> ‘string->canonical-sexp’ works (try ‘string->canonical-sexp "foo"’).
>> But I may be wrong about the latter.

> Ah right, you could get “corrupt signature data” when
> (string->canonical-sexp signature) returns the null canonical sexp,
> whereas you’d want “not a valid s-expression”.

> Well, we can fix that in a separate patch if you want.

Do you have time for this?  I think it would be much easier for you than
for me because you wrote the bindings.

>> +(define* (assert-valid-signature signature hash port
>> +                                 #:optional (acl (current-acl)))
>> +  ;; Bail out if SIGNATURE, a string, doesn't match HASH, a bytevector
>> +  ;; containing the expected hash for PORT.

> Make it a docstring.

> Also, please make this change a separate patch.

OK.

>> +  (let* ((file      (port-filename port))

> I don’t think this will work, because most of the time PORT is a pipe
> (an input port), whereas FILE is supposed to be the name of the file
> being restored.

What can we do about it?  Should the function accept ‘file’ and ‘port’?

> > +                (raise (condition (&message (message "invalid hash"))
>> +                                  (&nar-invalid-hash-error
>> +                                   (port port) (file file)
>> +                                   (signature signature)
>> +                                   (expected (hash-data->bytevector data))
>> +                                   (actual hash)))))
>> +            (raise (condition (&message (message "unauthorized public key"))
>> +                              (&nar-signature-error
>> +                               (signature signature) (file file) (port port)))))
>> +        (raise (condition
>> +                (&message (message "corrupt signature data"))
>> +                (&nar-signature-error
>> +                 (signature signature) (file file) (port port)))))))

> Actually, the problem with making ‘assert-valid-signature’ public is
> that it raises &nar error conditions.

> It could be changed to raise a more generic &signature-error, but then
> ‘restore-file-set’ would have to guard against it to re-throw it along
> with a &nar-error (making a compound condition.)  And then ui.scm would
> figure it out.  Blech.

> It’s worth factorizing, but I don’t see how to do it nicely.  Thoughts?

Haven’t thought of it yet.  But I’ll try to take care of this one.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 691 bytes --]

>> Actually, the problem with making ‘assert-valid-signature’ public is
>> that it raises &nar error conditions.

I’ve looked through the code; now I need even more information.  Please
elaborate.

>> It could be changed to raise a more generic &signature-error, but then
>> ‘restore-file-set’ would have to guard against it to re-throw it along
>> with a &nar-error (making a compound condition.)  And then ui.scm would
>> figure it out.  Blech.

Why would it need a more generic error?  Why would ‘restore-file-set’
have to rethrow it along with an &nar-error?  How’s ‘ui.scm’ relevant?
It’d be great if you could paste the code you were talking about.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>>> Actually, the problem with making ‘assert-valid-signature’ public is
>>> that it raises &nar error conditions.
>
> I’ve looked through the code; now I need even more information.  Please
> elaborate.
>
>>> It could be changed to raise a more generic &signature-error, but then
>>> ‘restore-file-set’ would have to guard against it to re-throw it along
>>> with a &nar-error (making a compound condition.)  And then ui.scm would
>>> figure it out.  Blech.
>
> Why would it need a more generic error?  Why would ‘restore-file-set’
> have to rethrow it along with an &nar-error?  How’s ‘ui.scm’ relevant?
> It’d be great if you could paste the code you were talking about.

ui.scm is relevant because part of the reason why structured exceptions
à la SRFI-35 are interesting is that it allows you to provide users with
detailed error reports (like “invalid hash while restoring file FOO from
PORT”.)

Here’s a proposal: just copy/paste ‘assert-valid-signature’, adjust it
to your needs, and I’ll see how we can factorize that later.

Works for you?

Thanks,
Ludo’.

[PATCH 2/2] guix substitute-binary: Support the Signature field of a narinfo file. (was: Signed archives (preliminary patch))

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 262 bytes --]

> Here’s a proposal: just copy/paste ‘assert-valid-signature’, adjust it
> to your needs, and I’ll see how we can factorize that later.

> Works for you?

The perfect is the enemy of the good.  So, may I push both patches to
‘core-updates’?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-nar-Clarify-that-assert-valid-signature-accepts-a-st.patch --]
[-- Type: text/x-diff, Size: 1105 bytes --]

From 26e98465deac592cbcdb9891f091d997e00eda9d Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Wed, 12 Mar 2014 21:21:39 +0000
Subject: [PATCH 1/2] nar: Clarify that 'assert-valid-signature' accepts a
 string.

* guix/nar.scm (assert-valid-signature): Turn a comment into a
  docstring and improve the wording.
---
 guix/nar.scm |    4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/guix/nar.scm b/guix/nar.scm
index 5bf1745..63b10dc 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -369,8 +369,8 @@ while the locks are held."
     port)
 
   (define (assert-valid-signature signature hash file)
-    ;; Bail out if SIGNATURE, an sexp, doesn't match HASH, a bytevector
-    ;; containing the expected hash for FILE.
+    "Bail out if SIGNATURE, a string (as produced by 'canonical-sexp->string'),
+doesn't match HASH, a bytevector containing the expected hash for FILE."
     (let* ((signature (catch 'gcry-error
                         (lambda ()
                           (string->canonical-sexp signature))
-- 
1.7.9.5


[-- Attachment #1.3: 0002-guix-substitute-binary-Support-the-Signature-field-o.patch --]
[-- Type: text/x-diff, Size: 32068 bytes --]

From e1a00a6d691ad9d73fb5162cd3e9bdf8863d152f Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Wed, 12 Mar 2014 23:04:04 +0000
Subject: [PATCH 2/2] guix substitute-binary: Support the Signature field of a
 narinfo file.

* guix/scripts/substitute-binary.scm (<narinfo>): Add the 'signature'
  and 'contents' fields.
  (narinfo-signature->canonical-sexp): New function.
  (narinfo-maker): Add the 'signature' argument and use it.
  (assert-valid-signature): New function.
  (read-narinfo): Support the Signature field.
  (write-narinfo): Use 'narinfo-contents'.
* guix/base64.scm, tests/base64.scm, tests/substitute-binary.scm: New files.
* Makefile.am (SCM_TESTS): Add the test files.
---
 Makefile.am                        |    2 +
 guix/base64.scm                    |  212 ++++++++++++++++++++++++++++++++++++
 guix/scripts/substitute-binary.scm |  157 ++++++++++++++++++--------
 tests/base64.scm                   |   59 ++++++++++
 tests/substitute-binary.scm        |  193 ++++++++++++++++++++++++++++++++
 5 files changed, 579 insertions(+), 44 deletions(-)
 create mode 100644 guix/base64.scm
 create mode 100644 tests/base64.scm
 create mode 100644 tests/substitute-binary.scm

diff --git a/Makefile.am b/Makefile.am
index 764332a..111f1c5 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -120,9 +120,11 @@ clean-go:
 
 SCM_TESTS =					\
   tests/base32.scm				\
+  tests/base64.scm				\
   tests/hash.scm				\
   tests/pk-crypto.scm				\
   tests/pki.scm					\
+  tests/substitute-binary.scm			\
   tests/builders.scm				\
   tests/derivations.scm				\
   tests/ui.scm					\
diff --git a/guix/base64.scm b/guix/base64.scm
new file mode 100644
index 0000000..f7f7f5f
--- /dev/null
+++ b/guix/base64.scm
@@ -0,0 +1,212 @@
+;; -*- mode: scheme; coding: utf-8 -*-
+;;
+;; This module was renamed from (weinholt text base64 (1 0 20100612)) to
+;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
+;; February 12, 2014.
+;;
+;; Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
+;;
+;; This program 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.
+;;
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+#!r6rs
+
+;; RFC 4648 Base-N Encodings
+
+(library (guix base64)
+  (export base64-encode
+          base64-decode
+          base64-alphabet
+          base64url-alphabet
+          get-delimited-base64
+          put-delimited-base64)
+  (import (rnrs)
+          (only (srfi :13 strings)
+                string-index
+                string-prefix? string-suffix?
+                string-concatenate string-trim-both))
+
+  (define base64-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+
+  (define base64url-alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
+
+  (define base64-encode
+    (case-lambda
+      ;; Simple interface. Returns a string containing the canonical
+      ;; base64 representation of the given bytevector.
+      ((bv)
+       (base64-encode bv 0 (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start)
+       (base64-encode bv start (bytevector-length bv) #f #f base64-alphabet #f))
+      ((bv start end)
+       (base64-encode bv start end #f #f base64-alphabet #f))
+      ((bv start end line-length)
+       (base64-encode bv start end line-length #f base64-alphabet #f))
+      ((bv start end line-length no-padding)
+       (base64-encode bv start end line-length no-padding base64-alphabet #f))
+      ((bv start end line-length no-padding alphabet)
+       (base64-encode bv start end line-length no-padding alphabet #f))
+      ;; Base64 encodes the bytes [start,end[ in the given bytevector.
+      ;; Lines are limited to line-length characters (unless #f),
+      ;; which must be a multiple of four. To omit the padding
+      ;; characters (#\=) set no-padding to a true value. If port is
+      ;; #f, returns a string.
+      ((bv start end line-length no-padding alphabet port)
+       (assert (or (not line-length) (zero? (mod line-length 4))))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-string-output-port))))
+         (letrec ((put (if line-length
+                           (let ((chars 0))
+                             (lambda (p c)
+                               (when (fx=? chars line-length)
+                                 (set! chars 0)
+                                 (put-char p #\linefeed))
+                               (set! chars (fx+ chars 1))
+                               (put-char p c)))
+                           put-char)))
+           (let lp ((i start))
+             (cond ((= i end))
+                   ((<= (+ i 3) end)
+                    (let ((x (bytevector-uint-ref bv i (endianness big) 3)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (put p (string-ref alphabet (fxbit-field x 0 6)))
+                      (lp (+ i 3))))
+                   ((<= (+ i 2) end)
+                    (let ((x (fxarithmetic-shift-left (bytevector-u16-ref bv i (endianness big)) 8)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (put p (string-ref alphabet (fxbit-field x 6 12)))
+                      (unless no-padding
+                        (put p #\=))))
+                   (else
+                    (let ((x (fxarithmetic-shift-left (bytevector-u8-ref bv i) 16)))
+                      (put p (string-ref alphabet (fxbit-field x 18 24)))
+                      (put p (string-ref alphabet (fxbit-field x 12 18)))
+                      (unless no-padding
+                        (put p #\=)
+                        (put p #\=)))))))
+         (extract)))))
+
+  ;; Decodes a base64 string. The string must contain only pure
+  ;; unpadded base64 data.
+  (define base64-decode
+    (case-lambda
+      ((str)
+       (base64-decode str base64-alphabet #f))
+      ((str alphabet)
+       (base64-decode str alphabet #f))
+      ((str alphabet port)
+       (unless (zero? (mod (string-length str) 4))
+         (error 'base64-decode
+                "input string must be a multiple of four characters"))
+       (let-values (((p extract) (if port
+                                     (values port (lambda () (values)))
+                                     (open-bytevector-output-port))))
+         (do ((i 0 (+ i 4)))
+             ((= i (string-length str))
+              (extract))
+           (let ((c1 (string-ref str i))
+                 (c2 (string-ref str (+ i 1)))
+                 (c3 (string-ref str (+ i 2)))
+                 (c4 (string-ref str (+ i 3))))
+             ;; TODO: be more clever than string-index
+             (let ((i1 (string-index alphabet c1))
+                   (i2 (string-index alphabet c2))
+                   (i3 (string-index alphabet c3))
+                   (i4 (string-index alphabet c4)))
+               (cond ((and i1 i2 i3 i4)
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6)
+                                      i4)))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))
+                        (put-u8 p (fxbit-field x 0 8))))
+                     ((and i1 i2 i3 (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12)
+                                      (fxarithmetic-shift-left i3 6))))
+                        (put-u8 p (fxbit-field x 16 24))
+                        (put-u8 p (fxbit-field x 8 16))))
+                     ((and i1 i2 (char=? c3 #\=) (char=? c4 #\=)
+                           (= i (- (string-length str) 4)))
+                      (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                      (fxarithmetic-shift-left i2 12))))
+                        (put-u8 p (fxbit-field x 16 24))))
+                     (else
+                      (error 'base64-decode "invalid input"
+                             (list c1 c2 c3 c4)))))))))))
+
+  (define (get-line-comp f port)
+    (if (port-eof? port)
+        (eof-object)
+        (f (get-line port))))
+
+  ;; Reads the common -----BEGIN/END type----- delimited format from
+  ;; the given port. Returns two values: a string with the type and a
+  ;; bytevector containing the base64 decoded data. The second value
+  ;; is the eof object if there is an eof before the BEGIN delimiter.
+  (define (get-delimited-base64 port)
+    (define (get-first-data-line port)
+      ;; Some MIME data has header fields in the same format as mail
+      ;; or http. These are ignored.
+      (let ((line (get-line-comp string-trim-both port)))
+        (cond ((eof-object? line) line)
+              ((string-index line #\:)
+               (let lp ()               ;read until empty line
+                 (let ((line (get-line-comp string-trim-both port)))
+                   (if (string=? line "")
+                       (get-line-comp string-trim-both port)
+                       (lp)))))
+              (else line))))
+    (let ((line (get-line-comp string-trim-both port)))
+      (cond ((eof-object? line)
+             (values "" (eof-object)))
+            ((string=? line "")
+             (get-delimited-base64 port))
+            ((and (string-prefix? "-----BEGIN " line)
+                  (string-suffix? "-----" line))
+             (let* ((type (substring line 11 (- (string-length line) 5)))
+                    (endline (string-append "-----END " type "-----")))
+               (let-values (((outp extract) (open-bytevector-output-port)))
+                 (let lp ((line (get-first-data-line port)))
+                   (cond ((eof-object? line)
+                          (error 'get-delimited-base64
+                                 "unexpected end of file"))
+                         ((string-prefix? "-" line)
+                          (unless (string=? line endline)
+                            (error 'get-delimited-base64
+                                   "bad end delimiter" type line))
+                          (values type (extract)))
+                         (else
+                          (unless (and (= (string-length line) 5)
+                                       (string-prefix? "=" line)) ;Skip Radix-64 checksum
+                            (base64-decode line base64-alphabet outp))
+                          (lp (get-line-comp string-trim-both port))))))))
+            (else ;skip garbage (like in openssl x509 -in foo -text output).
+             (get-delimited-base64 port)))))
+
+  (define put-delimited-base64
+    (case-lambda
+      ((port type bv line-length)
+       (display (string-append "-----BEGIN " type "-----\n") port)
+       (base64-encode bv 0 (bytevector-length bv)
+                      line-length #f base64-alphabet port)
+       (display (string-append "\n-----END " type "-----\n") port))
+      ((port type bv)
+       (put-delimited-base64 port type bv 76)))))
\ No newline at end of file
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 54f4aaa..e063e3b 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,10 @@
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module (guix nar)
+  #:use-module (guix hash)
+  #:use-module (guix base64)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix build download)
                 #:select (progress-proc uri-abbreviation))
@@ -33,15 +38,21 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (web uri)
   #:use-module (guix http-client)
-  #:export (guix-substitute-binary))
+  #:export (narinfo-signature->canonical-sexp
+            read-narinfo
+            write-narinfo
+            guix-substitute-binary))
 
 ;;; Comment:
 ;;;
@@ -191,7 +202,7 @@ failure."
 
 (define-record-type <narinfo>
   (%make-narinfo path uri compression file-hash file-size nar-hash nar-size
-                 references deriver system)
+                 references deriver system signature contents)
   narinfo?
   (path         narinfo-path)
   (uri          narinfo-uri)
@@ -202,15 +213,38 @@ failure."
   (nar-size     narinfo-size)
   (references   narinfo-references)
   (deriver      narinfo-deriver)
-  (system       narinfo-system))
-
-(define (narinfo-maker cache-url)
-  "Return a narinfo constructor for narinfos originating from CACHE-URL."
+  (system       narinfo-system)
+  (signature    narinfo-signature)      ; canonical sexp
+  ;; The original contents of a narinfo file.  This field is needed because we
+  ;; want to preserve the exact textual representation for verification purposes.
+  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
+  ;; for more information.
+  (contents     narinfo-contents))
+
+(define (narinfo-signature->canonical-sexp str)
+  "Return the value of a narinfo's 'Signature' field as a canonical sexp."
+  (match (string-split str #\;)
+    ((version _ sig)
+     (let ((maybe-number (string->number version)))
+       (cond ((not (number? maybe-number))
+              (leave (_ "signature version must be a number: ~a~%")
+                     version))
+             ;; Currently, there are no other versions.
+             ((not (= 1 maybe-number))
+              (leave (_ "unsupported signature version: ~a~%")
+                     maybe-number))
+             (else (string->canonical-sexp
+                    (utf8->string (base64-decode sig)))))))
+    (x
+     (leave (_ "invalid format of the signature field: ~a~%") x))))
+
+(define (narinfo-maker str cache-url)
+  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
+must contain the original contents of a narinfo file."
   (lambda (path url compression file-hash file-size nar-hash nar-size
-                references deriver system)
+                references deriver system signature)
     "Return a new <narinfo> object."
     (%make-narinfo path
-
                    ;; Handle the case where URL is a relative URL.
                    (or (string->uri url)
                        (string->uri (string-append cache-url "/" url)))
@@ -223,45 +257,80 @@ failure."
                    (match deriver
                      ((or #f "") #f)
                      (_ deriver))
-                   system)))
-
-(define* (read-narinfo port #:optional url)
-  "Read a narinfo from PORT in its standard external form.  If URL is true, it
-must be a string used to build full URIs from relative URIs found while
-reading PORT."
-  (alist->record (fields->alist port)
-                 (narinfo-maker url)
-                 '("StorePath" "URL" "Compression"
-                   "FileHash" "FileSize" "NarHash" "NarSize"
-                   "References" "Deriver" "System")))
+                   system
+                   (narinfo-signature->canonical-sexp signature)
+                   str)))
+
+;;; XXX: The following function is nearly an exact copy of the one from
+;;; 'guix/nar.scm'.  Factorize as soon as we know how to make the latter
+;;; public (see <https://lists.gnu.org/archive/html/guix-devel/2014-03/msg00097.html>).
+;;; Keep this one private to avoid confusion.
+(define* (assert-valid-signature signature hash port
+                                 #:optional (acl (current-acl)))
+  "Bail out if SIGNATURE, a string (as produced by 'canonical-sexp->string'),
+doesn't match HASH, a bytevector containing the expected hash for FILE."
+  (let* ((&nar-signature-error    (@@ (guix nar) &nar-signature-error))
+         (&nar-invalid-hash-error (@@ (guix nar) &nar-invalid-hash-error))
+         ;; XXX: This is just to keep the errors happy; get a sensible
+         ;; filename.
+         (file      #f)
+         (signature (catch 'gcry-error
+                      (lambda ()
+                        (string->canonical-sexp signature))
+                      (lambda (err . _)
+                        (raise (condition
+                                (&message
+                                 (message "signature is not a valid \
+s-expression"))
+                                (&nar-signature-error
+                                 (file file)
+                                 (signature signature) (port port)))))))
+         (subject   (signature-subject signature))
+         (data      (signature-signed-data signature)))
+    (if (and data subject)
+        (if (authorized-key? subject acl)
+            (if (equal? (hash-data->bytevector data) hash)
+                (unless (valid-signature? signature)
+                  (raise (condition
+                          (&message (message "invalid signature"))
+                          (&nar-signature-error
+                           (file file) (signature signature) (port port)))))
+                (raise (condition (&message (message "invalid hash"))
+                                  (&nar-invalid-hash-error
+                                   (port port) (file file)
+                                   (signature signature)
+                                   (expected (hash-data->bytevector data))
+                                   (actual hash)))))
+            (raise (condition (&message (message "unauthorized public key"))
+                              (&nar-signature-error
+                               (signature signature) (file file) (port port)))))
+        (raise (condition
+                (&message (message "corrupt signature data"))
+                (&nar-signature-error
+                 (signature signature) (file file) (port port)))))))
+
+(define* (read-narinfo port #:optional url (acl (current-acl)))
+  "Read a narinfo from PORT.  If URL is true, it must be a string used to
+build full URIs from relative URIs found while reading PORT."
+  (let* ((str       (utf8->string (get-bytevector-all port)))
+         (rx        (make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$"))
+         (res       (or (regexp-exec rx str)
+                        (leave (_ "cannot find the Signature line: ~a~%")
+                               str)))
+         (hash      (sha256 (string->utf8 (match:substring res 1))))
+         (narinfo   (alist->record (fields->alist (open-input-string str))
+                                   (narinfo-maker str url)
+                                   '("StorePath" "URL" "Compression"
+                                     "FileHash" "FileSize" "NarHash" "NarSize"
+                                     "References" "Deriver" "System"
+                                     "Signature")))
+         (signature (canonical-sexp->string (narinfo-signature narinfo))))
+    (assert-valid-signature signature hash port acl)
+    narinfo))
 
 (define (write-narinfo narinfo port)
   "Write NARINFO to PORT."
-  (define (empty-string-if-false x)
-    (or x ""))
-
-  (define (number-or-empty-string x)
-    (if (number? x)
-        (number->string x)
-        ""))
-
-  (object->fields narinfo
-                  `(("StorePath" . ,narinfo-path)
-                    ("URL" . ,(compose uri->string narinfo-uri))
-                    ("Compression" . ,narinfo-compression)
-                    ("FileHash" . ,(compose empty-string-if-false
-                                            narinfo-file-hash))
-                    ("FileSize" . ,(compose number-or-empty-string
-                                            narinfo-file-size))
-                    ("NarHash" . ,(compose empty-string-if-false
-                                           narinfo-hash))
-                    ("NarSize" . ,(compose number-or-empty-string
-                                           narinfo-size))
-                    ("References" . ,(compose string-join narinfo-references))
-                    ("Deriver" . ,(compose empty-string-if-false
-                                           narinfo-deriver))
-                    ("System" . ,narinfo-system))
-                  port))
+  (put-bytevector port (string->utf8 (narinfo-contents narinfo))))
 
 (define (narinfo->string narinfo)
   "Return the external representation of NARINFO."
diff --git a/tests/base64.scm b/tests/base64.scm
new file mode 100644
index 0000000..99c02b5
--- /dev/null
+++ b/tests/base64.scm
@@ -0,0 +1,59 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.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 (test-base64)
+  #:use-module (guix base64)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-64))
+
+(define (string->base64 str)
+  (base64-encode (string->utf8 str)))
+
+;;; Test vectors from <https://tools.ietf.org/rfc/rfc4648.txt>.
+
+(test-begin "base64")
+
+(test-equal "empty string"
+  (string->base64 "")
+  "")
+
+(test-equal "f"
+  (string->base64 "f")
+  "Zg==")
+
+(test-equal "fo"
+  (string->base64 "fo")
+  "Zm8=")
+
+(test-equal "foo"
+  (string->base64 "foo")
+  "Zm9v")
+
+(test-equal "foob"
+  (string->base64 "foob")
+  "Zm9vYg==")
+
+(test-equal "fooba"
+  (string->base64 "fooba")
+  "Zm9vYmE=")
+
+(test-equal "foobar"
+  (string->base64 "foobar")
+  "Zm9vYmFy")
+
+(test-end "base64")
\ No newline at end of file
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
new file mode 100644
index 0000000..089620b
--- /dev/null
+++ b/tests/substitute-binary.scm
@@ -0,0 +1,193 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 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 (test-substitute-binary)
+  #:use-module (guix scripts substitute-binary)
+  #:use-module (guix base64)
+  #:use-module (guix hash)
+  #:use-module (guix nar)
+  #:use-module (guix pk-crypto)
+  #:use-module (guix pki)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-34)
+  #:use-module ((srfi srfi-64) #:hide (test-error)))
+
+(define assert-valid-signature
+  ;; (guix scripts substitute-binary) does not export this function in order to
+  ;; avoid misuse.
+  (@@ (guix scripts substitute-binary) assert-valid-signature))
+
+;;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to
+;;; catch specific exceptions.
+(define-syntax-rule (test-error* name exp)
+  (test-assert name
+    (catch 'quit
+      (lambda ()
+        exp
+        #f)
+      (const #t))))
+
+(define %keypair
+  ;; (display (canonical-sexp->string
+  ;;           (generate-key "(genkey (rsa (nbits 4:1024)))")))
+  (string->canonical-sexp
+   "(key-data
+ (public-key
+  (rsa
+   (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#)
+   (e #010001#)
+   )
+  )
+ (private-key
+  (rsa
+   (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#)
+   (e #010001#)
+   (d #40E6D963EF143E9241BC10DE7A785C988C89EB1EC33253A5796AFB38FCC804D015500EC8CBCA0F5E318EE9D660DC19E7774E2E89BFD38379297EA87EFBDAC24BA32EE5339215382B2C89F5A817FD9131CA8E8A0A70D58E26E847AD0C447053671A6B2D7746087DE058A02B17701752B8A36EB414435921615AE7CAA8AC48E451#)
+   (p #00EA88C0C19FE83C09285EF49FF88A1159357FD870031C20F15EF5103FBEB10925299BCA197F7143D6792A1BA7044EDA572EC94FA6B00889F9857216CF5B984403#)
+   (q #00EAFE541EE9E0531255A85CADBEF64D5F679766D7209F521ADD131CF4B7DA9DF5414901342A146EE84FAA1E35EE0D0F6CE3F5F25989C0D1E9FA5B678D78C113C9#)
+   (u #59C80FA2C48181F6855691C9D443619BA46C7648056E081697C370D8096E8EF165122D5E55F8FD6A2DCC404FA8BDCDC1FD20B4D76A433F25E8FD6901EC2DBDAD#)
+   )
+  )
+ )"))
+
+(define %public-key
+  (find-sexp-token %keypair 'public-key))
+
+(define %private-key
+  (find-sexp-token %keypair 'private-key))
+
+(define (signature-body str)
+  (base64-encode
+   (string->utf8
+    (canonical-sexp->string
+     (signature-sexp (bytevector->hash-data (sha256 (string->utf8 str)))
+                     %private-key
+                     %public-key)))))
+
+(define %signature-body
+  (signature-body "secret"))
+
+(define %wrong-public-key
+  (string->canonical-sexp "(public-key
+ (rsa
+  (n #00E05873AC2B168760343145918E954EE9AB73C026355693B192E01EE835261AA689E9EF46642E895BCD65C648524059FC450E4BA77A68F4C52D0E39EF0CC9359709AB6AAB153B63782201871325B0FDA19CB401CD99FD0C31A91CA9000AA90A77E82B89E036FB63BC1D3961207469B3B12468977148D376F8012BB12A4B11A8F1#)
+  (e #010001#)
+  )
+ )"))
+
+(define %wrong-signature
+  (let* ((body (string->canonical-sexp
+                (utf8->string
+                 (base64-decode %signature-body))))
+         (data       (canonical-sexp->string (find-sexp-token body 'data)))
+         (sig-val    (canonical-sexp->string (find-sexp-token body 'sig-val)))
+         (public-key (canonical-sexp->string %wrong-public-key))
+         (body*      (base64-encode
+                      (string->utf8
+                       (string-append "(signature \n" data sig-val
+                                      public-key " )\n")))))
+    (string-append "1;irrelevant;" body*)))
+
+(define* (signature str #:optional (body %signature-body))
+  (string-append str ";irrelevant;" body))
+
+(define %signature
+  (signature "1" %signature-body))
+
+(define %acl
+  (public-keys->acl (list %public-key)))
+
+(test-begin "substitute-binary")
+
+(test-error* "not a number"
+  (narinfo-signature->canonical-sexp (signature "not a number")))
+
+(test-error* "wrong version number"
+  (narinfo-signature->canonical-sexp (signature "2")))
+
+(test-assert "valid narinfo-signature->canonical-sexp"
+  (canonical-sexp? (narinfo-signature->canonical-sexp %signature)))
+
+(define-syntax-rule (test-error-condition name pred exp)
+  (test-assert name
+    (guard (condition
+            ((pred condition) #t)
+            (else #f))
+      exp)))
+
+;;; XXX: Do we need a better predicate hierarchy for these tests?
+(test-error-condition "corrupt signature data"
+  nar-signature-error?
+  (assert-valid-signature "invalid sexp" "irrelevant"
+                          (open-input-string "irrelevant")
+                          %acl))
+
+(test-error-condition "unauthorized public key"
+  nar-signature-error?
+  (assert-valid-signature (canonical-sexp->string
+                           (narinfo-signature->canonical-sexp %signature))
+                          "irrelevant"
+                          (open-input-string "irrelevant")
+                          (public-keys->acl '())))
+
+(test-error-condition "invalid signature"
+  nar-signature-error?
+  (assert-valid-signature (canonical-sexp->string
+                           (narinfo-signature->canonical-sexp
+                            %wrong-signature))
+                          (sha256 (string->utf8 "secret"))
+                          (open-input-string "irrelevant")
+                          (public-keys->acl (list %wrong-public-key))))
+
+(define %narinfo
+  "StorePath: /nix/store/foo
+URL: nar/foo
+Compression: bzip2
+NarHash: sha256:7
+NarSize: 42
+References: bar baz
+Deriver: foo.drv
+System: mips64el-linux\n")
+
+(define (narinfo sig)
+  (format #f "~aSignature: ~a~%" %narinfo sig))
+
+(define %signed-narinfo
+  (narinfo (signature "1" (signature-body %narinfo))))
+
+(test-error-condition "invalid hash"
+  ;; The hash of '%signature' is computed over the word "secret", not
+  ;; '%narinfo'.
+  nar-invalid-hash-error?
+  (read-narinfo (open-input-string (narinfo %signature))
+                "https://example.com" %acl))
+
+(test-assert "valid read-narinfo"
+  (read-narinfo (open-input-string %signed-narinfo)
+                "https://example.com" %acl))
+
+(test-equal "valid write-narinfo"
+  %signed-narinfo
+  (call-with-output-string
+   (lambda (port)
+     (write-narinfo (read-narinfo (open-input-string %signed-narinfo)
+                                  "https://example.com" %acl)
+                    port))))
+
+(test-end "substitute-binary")
-- 
1.7.9.5


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH 2/2] guix substitute-binary: Support the Signature field of a narinfo file.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> The perfect is the enemy of the good.  So, may I push both patches to
> ‘core-updates’?

Yes, looks good to me!

I was about to say you could push to master, but since the new
substitute-binary will refuse any unsigned archives[*], it may be wiser
to push to a special branch so we can test it in real life before
merging into master.

WDYT?

We also need to adjust Hydra to use our ‘guix authenticate’.

[*] Actually, ‘alist->record’ will simply bork if the ‘Signature’ field
    is missing.  Eventually we may want graceful handling.

> From 26e98465deac592cbcdb9891f091d997e00eda9d Mon Sep 17 00:00:00 2001
> From: Nikita Karetnikov <nikita@karetnikov.org>
> Date: Wed, 12 Mar 2014 21:21:39 +0000
> Subject: [PATCH 1/2] nar: Clarify that 'assert-valid-signature' accepts a
>  string.
>
> * guix/nar.scm (assert-valid-signature): Turn a comment into a
>   docstring and improve the wording.

Actually docstrings are useless for internal defines, because they
cannot be accessed, so I usually use comments in those cases.

The wording fix is OK.

Thank you!

Ludo’.

Re: [PATCH 2/2] guix substitute-binary: Support the Signature field of a narinfo file.

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 311 bytes --]

> I was about to say you could push to master, but since the new
> substitute-binary will refuse any unsigned archives[*], it may be wiser
> to push to a special branch so we can test it in real life before
> merging into master.

Should the special branch be based on ‘master’ or ‘core-updates’?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH 2/2] guix substitute-binary: Support the Signature field of a narinfo file.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> I was about to say you could push to master, but since the new
>> substitute-binary will refuse any unsigned archives[*], it may be wiser
>> to push to a special branch so we can test it in real life before
>> merging into master.
>
> Should the special branch be based on ‘master’ or ‘core-updates’?

On ‘master’.

Ludo’.

Re: [PATCH 2/2] guix substitute-binary: Support the Signature field of a narinfo file.

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 479 bytes --]

>>> I was about to say you could push to master, but since the new
>>> substitute-binary will refuse any unsigned archives[*], it may be wiser
>>> to push to a special branch so we can test it in real life before
>>> merging into master.

>> Should the special branch be based on ‘master’ or ‘core-updates’?

> On ‘master’.

Done.  Since some tests on ‘master’ fail for me, could you run ‘make
check’ to make sure that it doesn’t break anything?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: Signed archives (preliminary patch)

[Ludovic Courtès]

ludo@gnu.org (Ludovic Courtès) skribis:

> Nikita Karetnikov <nikita@karetnikov.org> skribis:

[...]

>> +                (raise (condition (&message (message "invalid hash"))
>> +                                  (&nar-invalid-hash-error
>> +                                   (port port) (file file)
>> +                                   (signature signature)
>> +                                   (expected (hash-data->bytevector data))
>> +                                   (actual hash)))))
>> +            (raise (condition (&message (message "unauthorized public key"))
>> +                              (&nar-signature-error
>> +                               (signature signature) (file file) (port port)))))
>> +        (raise (condition
>> +                (&message (message "corrupt signature data"))
>> +                (&nar-signature-error
>> +                 (signature signature) (file file) (port port)))))))
>
> Actually, the problem with making ‘assert-valid-signature’ public is
> that it raises &nar error conditions.
>
> It could be changed to raise a more generic &signature-error, but then
> ‘restore-file-set’ would have to guard against it to re-throw it along
> with a &nar-error (making a compound condition.)  And then ui.scm would
> figure it out.  Blech.
>
> It’s worth factorizing, but I don’t see how to do it nicely.  Thoughts?

I ended up introducing a ‘signature-case’ macro in 81deef2.  It
simplifies code, and fails to compile unless all the cases are covered.

In (guix scripts substitute-binary), the result looks like this:

  (define* (assert-valid-signature narinfo signature hash
                                   #:optional (acl (current-acl)))
    (let ((uri (uri->string (narinfo-uri narinfo))))
      (signature-case (signature hash acl)
        (valid-signature #t)
        (invalid-signature
         (leave (_ "invalid signature for '~a'~%") uri))
        (hash-mismatch
         (leave (_ "hash mismatch for '~a'~%") uri))
        (unauthorized-key
         (leave (_ "'~a' is signed with an unauthorized key~%") uri))
        (corrupt-signature
         (leave (_ "signature on '~a' is corrupt~%") uri)))))

Ludo’.

Applying the GPG web-of-trust to Guix (was Re: Signed archives)

[Mark H Weaver]

Nikita Karetnikov <nikita@karetnikov.org> writes:

> 3. How does a user get Hydra’s public key?
>
> 4. Will the entire cache be signed with a single key?  (Mark, would you
>    like to add something?)

FWIW, I think it's a mistake to have Hydra sign all binaries.  Doing
this would make Hydra a single-point of failure, and therefore a very
worthwhile machine for someone to hack into.

Instead, the binaries should be signed by the build machine that
produced them.  Hydra's job should simply be to collect the set of
signatures that have been made on a given binary.  Initially, the build
machine's signature would be the only one, but then users should be able
to upload their own signatures to Hydra, after they have independently
verified that a given derivation produces a given binary.

I think that the design of the GPG web-of-trust is exactly applicable
here, in almost all respects.  Whereas the GPG web-of-trust is designed
to allow users to gain confidence that a public key was truly produced
by a given person, our Guix web-of-trust should be designed to give
confidence that a given binary was truly produced by a given derivation.

Just as GPG keyservers allow anyone to add their signatures to certify
that a public key was produced by a given person, and then distributes
all of the accumulated signatures to anyone who requests a key, Guix
hydra servers should allow anyone to add their signatures, and
distribute all of them to anyone who requests a binary.

Just as GPG allows users to specify how much they trust they place on a
given person to certify that other keys were produced by their owners,
Guix client software should allow users to specify their trust in a
given person or build machine to certify that a given binary was
produced by a given derivation.

Finally, just as GPG computes a metric of how much confidence you should
have that a given key was produced by a given person, based on all of
the above information, Guix should also produce such a metric.

As far as I can tell, the trust metric algorithms are directly
applicable to Guix.  I think that we should simply copy all of the
concepts and algorithms from GPG.

What do you think?

    Mark

Re: Applying the GPG web-of-trust to Guix (was Re: Signed archives)

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> Nikita Karetnikov <nikita@karetnikov.org> writes:
>
>> 3. How does a user get Hydra’s public key?
>>
>> 4. Will the entire cache be signed with a single key?  (Mark, would you
>>    like to add something?)
>
> FWIW, I think it's a mistake to have Hydra sign all binaries.  Doing
> this would make Hydra a single-point of failure, and therefore a very
> worthwhile machine for someone to hack into.

Ah, agreed.  But I think here “Hydra” was understood as “the build
machine behind hydra.gnu.org”, not specifically the machine at
hydra.gnu.org.

I think the first milestone will be to have signatures at all, but I
agree that what you describe is the next one.

> Instead, the binaries should be signed by the build machine that
> produced them.  Hydra's job should simply be to collect the set of
> signatures that have been made on a given binary.  Initially, the build
> machine's signature would be the only one,

If there are several build slaves behind hydra.gnu.org, the offload hook
could also collect signatures from those machines.

> but then users should be able to upload their own signatures to Hydra,
> after they have independently verified that a given derivation
> produces a given binary.

Agreed.  (That would mean either modifying Hydra, or coming up with an
alternative system, I think.)

[...]

> As far as I can tell, the trust metric algorithms are directly
> applicable to Guix.  I think that we should simply copy all of the
> concepts and algorithms from GPG.

The analogies you make indeed show which concepts could be applicable.

Technically, I think SPKI is more appropriate than OpenPGP here, because
OpenPGP is really about certifying bindings between email addresses and
human beings.  (And ‘guix authenticate’ & co. already is very SPKI-like.)

In particular, as Niels mentioned recently, delegation in SPKI may help
address some of these issues: users could publish delegation
certificates for the ‘guix-import’ tag, meaning that A trusts B for the
purposes of importing archives signed by B.

From there, I think we should try to come up with a road map, because
it’ll be hard to address all of that at once.

Ludo’.