Browse Source

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.
gn-latest-20200428
Ludovic Courtès 7 years ago
parent
commit
045111e10c
2 changed files with 98 additions and 3 deletions
  1. +40
    -2
      guix/hash.scm
  2. +58
    -1
      tests/hash.scm

+ 40
- 2
guix/hash.scm View File

@@ -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

+ 58
- 1
tests/hash.scm View File

@@ -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)



Loading…
Cancel
Save