;;;; simple-sha1.scm


(declare
  (fixnum)
  #;(not safe))


(module simple-sha1 (sha1sum string->sha1sum)

(import scheme chicken foreign)
(use srfi-13 posix lolevel)

#>
#include "sha1-base.c"
<#

;;

(define-foreign-variable context-size int "sizeof(SHA1_CTX)")

(define starts (foreign-lambda void "SHA1Init" c-pointer))
(define update (foreign-lambda void "SHA1Update" c-pointer c-pointer int))
(define finish (foreign-lambda void "SHA1Final" c-pointer scheme-pointer))

(define-constant digest-length 20)

(define (string->sha1sum str)
  (let* ((str-size (string-length str))
         (ctxt (allocate context-size))
         (digest (make-string digest-length)))
    (starts ctxt)
    (unless (zero? str-size)
      (update ctxt (location str) str-size))
    (finish ctxt digest)
    (free ctxt)
    (string-concatenate
     (map (lambda (c)
            (string-pad (number->string (char->integer c) 16) 2 #\0))
          (string->list digest)))))

(define (sha1sum fname)
  (let* ((fd (file-open fname open/rdonly))
         (fsize (file-size fd))
         (ctxt (allocate context-size))
         (digest (make-string digest-length)))
    (starts ctxt)
    (unless (zero? fsize)
      (let* ((mmap (map-file-to-memory #f fsize prot/read map/shared fd))
             (ptr (memory-mapped-file-pointer mmap)))
        (update ctxt ptr fsize)
        (unmap-file-from-memory mmap)))
    (finish ctxt digest)
    (free ctxt)
    (file-close fd)
    (string-concatenate
     (map (lambda (c)
            (string-pad (number->string (char->integer c) 16) 2 #\0))
          (string->list digest)))))

)