me/guix
Archived
1
0
Fork 0
Code Activity

Add a sha256 fallback that uses Coreutils instead of libchop.

Browse source 
* guix/utils.scm (compile-time-value): Move to the top.
  (sha256): Add an implementation that uses Coreutils, for when libchop
  is unavailable.
This commit is contained in:
Ludovic Courtès 2012-06-28 22:57:40 +02:00
parent 900f726734
commit dba6b34bdd
1 changed files with 45 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
guix/utils.scm
View file

@ -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
@ -50,6 +48,22 @@
gnu-triplet->nix-system
%current-system))
;;;
;;; 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.