diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/hash.scm | 23 | ||||
-rw-r--r-- | guix/scripts/system.scm | 23 | ||||
-rw-r--r-- | guix/ui.scm | 8 |
3 files changed, 28 insertions, 26 deletions
diff --git a/guix/hash.scm b/guix/hash.scm index 773b9d4777..39834043e1 100644 --- a/guix/hash.scm +++ b/guix/hash.scm @@ -23,7 +23,9 @@ #:use-module (system foreign) #:use-module ((guix build utils) #:select (dump-port)) #:use-module (srfi srfi-11) - #:export (sha256 + #:use-module (srfi srfi-26) + #:export (sha1 + sha256 open-sha256-port port-sha256 file-sha256 @@ -44,17 +46,26 @@ ;; Value as of Libgcrypt 1.5.2. (identifier-syntax 8)) -(define sha256 +(define-syntax GCRY_MD_SHA1 + (identifier-syntax 2)) + +(define bytevector-hash (let ((hash (pointer->procedure void (libgcrypt-func "gcry_md_hash_buffer") `(,int * * ,size_t)))) - (lambda (bv) - "Return the SHA256 of BV as a bytevector." - (let ((digest (make-bytevector (/ 256 8)))) - (hash GCRY_MD_SHA256 (bytevector->pointer digest) + (lambda (bv type size) + "Return the hash TYPE, of SIZE bytes, of BV as a bytevector." + (let ((digest (make-bytevector size))) + (hash type (bytevector->pointer digest) (bytevector->pointer bv) (bytevector-length bv)) digest)))) +(define sha1 + (cut bytevector-hash <> GCRY_MD_SHA1 20)) + +(define sha256 + (cut bytevector-hash <> GCRY_MD_SHA256 (/ 256 8))) + (define open-sha256-md (let ((open (pointer->procedure int (libgcrypt-func "gcry_md_open") diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ff322ec785..acfccce96d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -43,8 +43,7 @@ (find-partition-by-label find-partition-by-uuid) #:autoload (gnu build linux-modules) (device-module-aliases matching-modules) - #:autoload (gnu system linux-initrd) - (base-initrd default-initrd-modules) + #:use-module (gnu system linux-initrd) #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) @@ -661,27 +660,15 @@ checking this by themselves in their 'check' procedure." ('uuid (find-partition-by-uuid device)) ('label (find-partition-by-label device))))) - (define (check-device device location) - (let ((modules (delete-duplicates - (append-map matching-modules - (device-module-aliases device))))) - (unless (every (cute member <> (operating-system-initrd-modules os)) - modules) - (raise (condition - (&message - (message (format #f (G_ "you need these modules \ -in the initrd for ~a:~{ ~a~}") - device modules))) - (&error-location (location location))))))) - (define file-systems (filter file-system-needed-for-boot? (operating-system-file-systems os))) (for-each (lambda (fs) - (check-device (file-system-/dev fs) - (source-properties->location - (file-system-location fs)))) + (check-device-initrd-modules (file-system-/dev fs) + (operating-system-initrd-modules os) + (source-properties->location + (file-system-location fs)))) file-systems)) diff --git a/guix/ui.scm b/guix/ui.scm index a4943c2a7f..cb49a15c4d 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -299,8 +299,10 @@ VARIABLE and return it, or #f if none was found." "Display MESSAGE, a l10n message possibly containing Texinfo markup, to PORT." (format port (G_ "hint: ~a~%") - (fill-paragraph (texi->plain-text message) - (terminal-columns) 8))) + ;; XXX: We should arrange so that the initial indent is wider. + (parameterize ((%text-width (max 15 + (- (terminal-columns) 5)))) + (texi->plain-text message)))) (define* (report-load-error file args #:optional frame) "Report the failure to load FILE, a user-provided Scheme file. @@ -639,6 +641,8 @@ directories:~{ ~a~}~%") (G_ "~a: error: ~a~%") (location->string (error-location c)) (gettext (condition-message c) %gettext-domain)) + (when (fix-hint? c) + (display-hint (condition-fix-hint c))) (exit 1)) ((and (message-condition? c) (fix-hint? c)) (format (current-error-port) "~a: error: ~a~%" |