4 Commits 39d1894237 ... 4c316158a7

Author SHA1 Message Date
  Ludovic Courtès 4c316158a7 build: Add project URL, capitalize project name. 5 years ago
  Ludovic Courtès e8f40f0ad4 build: Remove redundant configure check for Guile. 5 years ago
  Ludovic Courtès 0e2da4bd48 hash: sha256 port now implements 'port-position'. 5 years ago
  Ludovic Courtès 3b28836cab hash: Add 'sha1'. 6 years ago
3 changed files with 35 additions and 12 deletions
  1. 2 3
      configure.ac
  2. 23 7
      gcrypt/hash.scm
  3. 10 2
      tests/hash.scm

+ 2 - 3
configure.ac

@@ -1,6 +1,5 @@
-AC_INIT([guile-gcrypt], [0.1.dev], [cwebber@dustycloud.org])
-
-PKG_CHECK_MODULES([GUILE], [guile-2.2])
+AC_INIT([Guile-Gcrypt], [0.1.dev], [cwebber@dustycloud.org],
+  [guile-gcrypt], [https://notabug.org/cwebber/guile-gcrypt])
 
 AC_CONFIG_AUX_DIR([build-aux])
 AC_CONFIG_MACRO_DIR([m4])

+ 23 - 7
gcrypt/hash.scm

@@ -23,7 +23,9 @@
   #:use-module (ice-9 binary-ports)
   #:use-module (system foreign)
   #: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")
@@ -90,6 +101,7 @@ output port."
     (open-sha256-md))
 
   (define digest #f)
+  (define position 0)
 
   (define (finalize!)
     (let ((ptr (md-read sha256-md 0)))
@@ -103,14 +115,18 @@ output port."
           0)
         (let ((ptr (bytevector->pointer bv offset)))
           (md-write sha256-md ptr len)
+          (set! position (+ position len))
           len)))
 
+  (define (get-position)
+    position)
+
   (define (close)
     (unless digest
       (finalize!)))
 
   (values (make-custom-binary-output-port "sha256"
-                                          write! #f #f
+                                          write! get-position #f
                                           close)
           (lambda ()
             (unless digest

+ 10 - 2
tests/hash.scm

@@ -47,6 +47,14 @@ In Guile <= 2.0.9, CBIPs were always fully buffered, so the
 
 (test-begin "hash")
 
+(test-equal "sha1, empty"
+  (base16-string->bytevector "da39a3ee5e6b4b0d3255bfef95601890afd80709")
+  (sha1 #vu8()))
+
+(test-equal "sha1, hello"
+  (base16-string->bytevector "2aae6c35c94fcfb415dbe95f408b9ce91ee846ed")
+  (sha1 (string->utf8 "hello world")))
+
 (test-equal "sha256, empty"
   %empty-sha256
   (sha256 #vu8()))
@@ -63,12 +71,12 @@ In Guile <= 2.0.9, CBIPs were always fully buffered, so the
     (get)))
 
 (test-equal "open-sha256-port, hello"
-  %hello-sha256
+  (list %hello-sha256 (string-length "hello world"))
   (let-values (((port get)
                 (open-sha256-port)))
     (put-bytevector port (string->utf8 "hello world"))
     (force-output port)
-    (get)))
+    (list (get) (port-position port))))
 
 (test-assert "port-sha256"
   (let* ((file     (search-path %load-path "ice-9/psyntax.scm"))