diff options
| -rwxr-xr-x | guix/scripts/substitute.scm | 77 |
1 files changed, 41 insertions, 36 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index dcedc609d20..601946277fe 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm | |||
| @@ -2,6 +2,7 @@ | |||
| 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> | 3 | ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> |
| 4 | ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> | 4 | ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> |
| 5 | ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> | ||
| 5 | ;;; | 6 | ;;; |
| 6 | ;;; This file is part of GNU Guix. | 7 | ;;; This file is part of GNU Guix. |
| 7 | ;;; | 8 | ;;; |
| @@ -375,38 +376,37 @@ No authentication and authorization checks are performed here!" | |||
| 375 | (define* (valid-narinfo? narinfo #:optional (acl (current-acl)) | 376 | (define* (valid-narinfo? narinfo #:optional (acl (current-acl)) |
| 376 | #:key verbose?) | 377 | #:key verbose?) |
| 377 | "Return #t if NARINFO's signature is not valid." | 378 | "Return #t if NARINFO's signature is not valid." |
| 378 | (or (%allow-unauthenticated-substitutes?) | 379 | (let ((hash (narinfo-sha256 narinfo)) |
| 379 | (let ((hash (narinfo-sha256 narinfo)) | 380 | (signature (narinfo-signature narinfo)) |
| 380 | (signature (narinfo-signature narinfo)) | 381 | (uri (uri->string (first (narinfo-uris narinfo))))) |
| 381 | (uri (uri->string (first (narinfo-uris narinfo))))) | 382 | (and hash signature |
| 382 | (and hash signature | 383 | (signature-case (signature hash acl) |
| 383 | (signature-case (signature hash acl) | 384 | (valid-signature #t) |
| 384 | (valid-signature #t) | 385 | (invalid-signature |
| 385 | (invalid-signature | 386 | (when verbose? |
| 386 | (when verbose? | 387 | (format (current-error-port) |
| 387 | (format (current-error-port) | 388 | "invalid signature for substitute at '~a'~%" |
| 388 | "invalid signature for substitute at '~a'~%" | 389 | uri)) |
| 389 | uri)) | 390 | #f) |
| 390 | #f) | 391 | (hash-mismatch |
| 391 | (hash-mismatch | 392 | (when verbose? |
| 392 | (when verbose? | 393 | (format (current-error-port) |
| 393 | (format (current-error-port) | 394 | "hash mismatch for substitute at '~a'~%" |
| 394 | "hash mismatch for substitute at '~a'~%" | 395 | uri)) |
| 395 | uri)) | 396 | #f) |
| 396 | #f) | 397 | (unauthorized-key |
| 397 | (unauthorized-key | 398 | (when verbose? |
| 398 | (when verbose? | 399 | (format (current-error-port) |
| 399 | (format (current-error-port) | 400 | "substitute at '~a' is signed by an \ |
| 400 | "substitute at '~a' is signed by an \ | ||
| 401 | unauthorized party~%" | 401 | unauthorized party~%" |
| 402 | uri)) | 402 | uri)) |
| 403 | #f) | 403 | #f) |
| 404 | (corrupt-signature | 404 | (corrupt-signature |
| 405 | (when verbose? | 405 | (when verbose? |
| 406 | (format (current-error-port) | 406 | (format (current-error-port) |
| 407 | "corrupt signature for substitute at '~a'~%" | 407 | "corrupt signature for substitute at '~a'~%" |
| 408 | uri)) | 408 | uri)) |
| 409 | #f)))))) | 409 | #f))))) |
| 410 | 410 | ||
| 411 | (define (write-narinfo narinfo port) | 411 | (define (write-narinfo narinfo port) |
| 412 | "Write NARINFO to PORT." | 412 | "Write NARINFO to PORT." |
| @@ -917,11 +917,14 @@ expected by the daemon." | |||
| 917 | "Reply to COMMAND, a query as written by the daemon to this process's | 917 | "Reply to COMMAND, a query as written by the daemon to this process's |
| 918 | standard input. Use ACL as the access-control list against which to check | 918 | standard input. Use ACL as the access-control list against which to check |
| 919 | authorized substitutes." | 919 | authorized substitutes." |
| 920 | (define (valid? obj) | 920 | (define valid? |
| 921 | (valid-narinfo? obj acl)) | 921 | (if (%allow-unauthenticated-substitutes?) |
| 922 | (begin | ||
| 923 | (warn-about-missing-authentication) | ||
| 922 | 924 | ||
| 923 | (when (%allow-unauthenticated-substitutes?) | 925 | (const #t)) |
| 924 | (warn-about-missing-authentication)) | 926 | (lambda (obj) |
| 927 | (valid-narinfo? obj acl)))) | ||
| 925 | 928 | ||
| 926 | (match (string-tokenize command) | 929 | (match (string-tokenize command) |
| 927 | (("have" paths ..1) | 930 | (("have" paths ..1) |
| @@ -1081,7 +1084,9 @@ DESTINATION is in the store, deduplicate its files. Print a status line on | |||
| 1081 | the current output port." | 1084 | the current output port." |
| 1082 | (define narinfo | 1085 | (define narinfo |
| 1083 | (lookup-narinfo cache-urls store-item | 1086 | (lookup-narinfo cache-urls store-item |
| 1084 | (cut valid-narinfo? <> acl))) | 1087 | (if (%allow-unauthenticated-substitutes?) |
| 1088 | (const #t) | ||
| 1089 | (cut valid-narinfo? <> acl)))) | ||
| 1085 | 1090 | ||
| 1086 | (define destination-in-store? | 1091 | (define destination-in-store? |
| 1087 | (string-prefix? (string-append (%store-prefix) "/") | 1092 | (string-prefix? (string-append (%store-prefix) "/") |
