summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-06-28 22:57:40 +0200
committerLudovic Courtès <ludo@gnu.org>2012-06-28 22:57:40 +0200
commitdba6b34bdd21c4c03895f6eddf461a440ee3b13a (patch)
treee1a6860e8db51c5cad15245699d9e5a0cac5b9ff
parent900f7267341da3281e937cb0b128b21975574867 (diff)
downloadpatches-dba6b34bdd21c4c03895f6eddf461a440ee3b13a.tar
patches-dba6b34bdd21c4c03895f6eddf461a440ee3b13a.tar.gz
Add a sha256 fallback that uses Coreutils instead of libchop.
* guix/utils.scm (compile-time-value): Move to the top. (sha256): Add an implementation that uses Coreutils, for when libchop is unavailable.
-rw-r--r--guix/utils.scm60
1 files changed, 45 insertions, 15 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index bcea0193d0..31046bf2f4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -23,15 +23,13 @@
#:use-module (srfi srfi-39)
#:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors)
+ #:use-module ((rnrs io ports) #:select (put-bytevector))
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
#:autoload (ice-9 popen) (open-pipe*)
#:autoload (ice-9 rdelim) (read-line)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
- #:use-module ((chop hash)
- #:select (bytevector-hash
- hash-method/sha256))
#:export (bytevector-quintet-length
bytevector->base32-string
bytevector->nix-base32-string
@@ -52,6 +50,22 @@
;;;
+;;; Compile-time computations.
+;;;
+
+(define-syntax compile-time-value
+ (syntax-rules ()
+ "Evaluate the given expression at compile time. The expression must
+evaluate to a simple datum."
+ ((_ exp)
+ (let-syntax ((v (lambda (s)
+ (let ((val exp))
+ (syntax-case s ()
+ (_ #`'#,(datum->syntax s val)))))))
+ v))))
+
+
+;;;
;;; Base 32.
;;;
@@ -369,7 +383,34 @@ starting from the right of S."
(define (sha256 bv)
"Return the SHA256 of BV as a bytevector."
- (bytevector-hash hash-method/sha256 bv))
+ (if (compile-time-value
+ (false-if-exception (resolve-interface '(chop hash))))
+ (let ((bytevector-hash (@ (chop hash) bytevector-hash))
+ (hash-method/sha256 (@ (chop hash) hash-method/sha256)))
+ (bytevector-hash hash-method/sha256 bv))
+ ;; XXX: Slow, poor programmer's implementation that uses Coreutils.
+ (let ((in (pipe))
+ (out (pipe))
+ (pid (primitive-fork)))
+ (if (= 0 pid)
+ (begin ; child
+ (close (cdr in))
+ (close (car out))
+ (close 0)
+ (close 1)
+ (dup2 (fileno (car in)) 0)
+ (dup2 (fileno (cdr out)) 1)
+ (execlp "sha256sum" "sha256sum"))
+ (begin ; parent
+ (close (car in))
+ (close (cdr out))
+ (put-bytevector (cdr in) bv)
+ (close (cdr in)) ; EOF
+ (let ((line (car (string-tokenize (read-line (car out))))))
+ (close (car out))
+ (and (and=> (status:exit-val (cdr (waitpid pid)))
+ zero?)
+ (base16-string->bytevector line))))))))
@@ -377,17 +418,6 @@ starting from the right of S."
;;; Nixpkgs.
;;;
-(define-syntax compile-time-value
- (syntax-rules ()
- "Evaluate the given expression at compile time. The expression must
-evaluate to a simple datum."
- ((_ exp)
- (let-syntax ((v (lambda (s)
- (let ((val exp))
- (syntax-case s ()
- (_ #`'#,(datum->syntax s val)))))))
- v))))
-
(define %nixpkgs-directory
(make-parameter
;; Capture the build-time value of $NIXPKGS.