summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-01-19 18:16:28 +0100
committerLudovic Courtès <ludo@gnu.org>2014-01-24 00:01:49 +0100
commit045111e10c0197f1a235bb886df2e446285a6f70 (patch)
tree78df65f724743cc75caad8749d796584b8e3ef17
parentd28684b5a5369ac87b0a2d3ae125a54d74826a2e (diff)
downloadpatches-045111e10c0197f1a235bb886df2e446285a6f70.tar
patches-045111e10c0197f1a235bb886df2e446285a6f70.tar.gz
hash: Add 'open-sha256-input-port', for Guile > 2.0.9.
* guix/hash.scm (open-sha256-input-port): New procedure. * tests/hash.scm (supports-unbuffered-cbip?): New procedure. ("open-sha256-input-port, empty", "open-sha256-input-port, hello", "open-sha256-input-port, hello, one two", "open-sha256-input-port, hello, read from wrapped port"): New tests.
-rw-r--r--guix/hash.scm42
-rw-r--r--tests/hash.scm59
2 files changed, 98 insertions, 3 deletions
diff --git a/guix/hash.scm b/guix/hash.scm
index 92ecaf78d5..fb85f47586 100644
--- a/guix/hash.scm
+++ b/guix/hash.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,7 +25,8 @@
#:use-module (srfi srfi-11)
#:export (sha256
open-sha256-port
- port-sha256))
+ port-sha256
+ open-sha256-input-port))
;;; Commentary:
;;;
@@ -128,4 +129,41 @@ output port."
(close-port out)
(get)))
+(define (open-sha256-input-port port)
+ "Return an input port that wraps PORT and a thunk to get the hash of all the
+data read from PORT. The thunk always returns the same value."
+ (define md
+ (open-sha256-md))
+
+ (define (read! bv start count)
+ (let ((n (get-bytevector-n! port bv start count)))
+ (if (eof-object? n)
+ 0
+ (begin
+ (unless digest
+ (let ((ptr (bytevector->pointer bv start)))
+ (md-write md ptr n)))
+ n))))
+
+ (define digest #f)
+
+ (define (finalize!)
+ (let ((ptr (md-read md 0)))
+ (set! digest (bytevector-copy (pointer->bytevector ptr 32)))
+ (md-close md)))
+
+ (define (get-hash)
+ (unless digest
+ (finalize!))
+ digest)
+
+ (define (unbuffered port)
+ ;; Guile <= 2.0.9 does not support 'setvbuf' on custom binary input ports.
+ ;; If you get a wrong-type-arg error here, the fix is to upgrade Guile. :-)
+ (setvbuf port _IONBF)
+ port)
+
+ (values (unbuffered (make-custom-binary-input-port "sha256" read! #f #f #f))
+ get-hash))
+
;;; hash.scm ends here
diff --git a/tests/hash.scm b/tests/hash.scm
index 27751023d3..9bcd69440b 100644
--- a/tests/hash.scm
+++ b/tests/hash.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,6 +37,14 @@
(base16-string->bytevector
"b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9"))
+(define (supports-unbuffered-cbip?)
+ "Return #t if unbuffered custom binary input ports (CBIPs) are supported.
+In Guile <= 2.0.9, CBIPs were always fully buffered, so the
+'open-sha256-input-port' does not work there."
+ (false-if-exception
+ (setvbuf (make-custom-binary-input-port "foo" pk #f #f #f) _IONBF)))
+
+
(test-begin "hash")
(test-equal "sha256, empty"
@@ -68,6 +76,55 @@
(equal? (sha256 contents)
(call-with-input-file file port-sha256))))
+(test-skip (if (supports-unbuffered-cbip?) 0 4))
+
+(test-equal "open-sha256-input-port, empty"
+ `("" ,%empty-sha256)
+ (let-values (((port get)
+ (open-sha256-input-port (open-string-input-port ""))))
+ (let ((str (get-string-all port)))
+ (list str (get)))))
+
+(test-equal "open-sha256-input-port, hello"
+ `("hello world" ,%hello-sha256)
+ (let-values (((port get)
+ (open-sha256-input-port
+ (open-bytevector-input-port
+ (string->utf8 "hello world")))))
+ (let ((str (get-string-all port)))
+ (list str (get)))))
+
+(test-equal "open-sha256-input-port, hello, one two"
+ (list (string->utf8 "hel") (string->utf8 "lo")
+ (base16-string->bytevector ; echo -n hello | sha256sum
+ "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824")
+ " world")
+ (let-values (((port get)
+ (open-sha256-input-port
+ (open-bytevector-input-port (string->utf8 "hello world")))))
+ (let* ((one (get-bytevector-n port 3))
+ (two (get-bytevector-n port 2))
+ (hash (get))
+ (three (get-string-all port)))
+ (list one two hash three))))
+
+(test-equal "open-sha256-input-port, hello, read from wrapped port"
+ (list (string->utf8 "hello")
+ (base16-string->bytevector ; echo -n hello | sha256sum
+ "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824")
+ " world")
+ (let*-values (((wrapped)
+ (open-bytevector-input-port (string->utf8 "hello world")))
+ ((port get)
+ (open-sha256-input-port wrapped)))
+ (let* ((hello (get-bytevector-n port 5))
+ (hash (get))
+
+ ;; Now read from WRAPPED to make sure its current position is
+ ;; correct.
+ (world (get-string-all wrapped)))
+ (list hello hash world))))
+
(test-end)