Changeset 27951 in project


Ignore:
Timestamp:
12/14/12 22:04:04 (7 years ago)
Author:
felix winkelmann
Message:

simple-sha1 0.4: sha1sum works now on windows (simply reads in the file into a static buffer)

Location:
release/4/simple-sha1
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/simple-sha1/tags/0.4/simple-sha1.scm

    r24645 r27951  
    1414#>
    1515#include "sha1-base.c"
     16#include <unistd.h>
    1617<#
    1718
     
    4041          (string->list digest)))))
    4142
     43(cond-expand
     44  ((and windows (not cygwin))
     45   (begin
     46     (define read-into-buffer
     47       (foreign-lambda* bool ((int fd) (c-pointer buffer) (integer size))
     48         "C_return(read(fd, buffer, size) == size);"))
     49     (define (mapped-pointer fname fd size k)
     50       (let ((buffer (allocate size)))
     51         (unless (read-into-buffer fd buffer size)
     52           (free buffer)
     53           (error 'sha1sum "can not read file" fname))
     54         (k buffer (cut free buffer))))))
     55  (else
     56   (define (mapped-pointer fname fd size k)
     57     (let* ((mmap (map-file-to-memory #f size prot/read map/shared fd))
     58            (ptr (memory-mapped-file-pointer mmap)))
     59       (k ptr (cut unmap-file-from-memory mmap))))))
     60
    4261(define (sha1sum fname)
    4362  (and (file-exists? fname)
    4463       (not (directory? fname))
    45   (let* ((fd (file-open fname open/rdonly))
    46          (fsize (file-size fd))
    47          (ctxt (allocate context-size))
    48          (digest (make-string digest-length)))
    49     (starts ctxt)
    50     (unless (zero? fsize)
    51       (let* ((mmap (map-file-to-memory #f fsize prot/read map/shared fd))
    52              (ptr (memory-mapped-file-pointer mmap)))
    53         (update ctxt ptr fsize)
    54         (unmap-file-from-memory mmap)))
    55     (finish ctxt digest)
    56     (free ctxt)
    57     (file-close fd)
    58     (string-concatenate
    59      (map (lambda (c)
    60             (string-pad (number->string (char->integer c) 16) 2 #\0))
    61           (string->list digest))))))
     64       (let* ((fd (file-open fname open/rdonly))
     65              (fsize (file-size fd))
     66              (ctxt (allocate context-size))
     67              (digest (make-string digest-length)))
     68         (starts ctxt)
     69         (unless (zero? fsize)
     70           (mapped-pointer
     71            fname fd fsize
     72            (lambda (buffer cleanup)
     73              (update ctxt buffer fsize)
     74              (cleanup))))
     75         (finish ctxt digest)
     76         (free ctxt)
     77         (file-close fd)
     78         (string-concatenate
     79          (map (lambda (c)
     80                 (string-pad (number->string (char->integer c) 16) 2 #\0))
     81               (string->list digest))))))
    6282
    6383)
  • release/4/simple-sha1/tags/0.4/simple-sha1.setup

    r24645 r27951  
    66(install-extension 'simple-sha1
    77                   '("simple-sha1.so" "simple-sha1.import.so")
    8                    '((version 0.3)))
     8                   '((version 0.4)))
  • release/4/simple-sha1/trunk/simple-sha1.scm

    r24645 r27951  
    1414#>
    1515#include "sha1-base.c"
     16#include <unistd.h>
    1617<#
    1718
     
    4041          (string->list digest)))))
    4142
     43(cond-expand
     44  ((and windows (not cygwin))
     45   (begin
     46     (define read-into-buffer
     47       (foreign-lambda* bool ((int fd) (c-pointer buffer) (integer size))
     48         "C_return(read(fd, buffer, size) == size);"))
     49     (define (mapped-pointer fname fd size k)
     50       (let ((buffer (allocate size)))
     51         (unless (read-into-buffer fd buffer size)
     52           (free buffer)
     53           (error 'sha1sum "can not read file" fname))
     54         (k buffer (cut free buffer))))))
     55  (else
     56   (define (mapped-pointer fname fd size k)
     57     (let* ((mmap (map-file-to-memory #f size prot/read map/shared fd))
     58            (ptr (memory-mapped-file-pointer mmap)))
     59       (k ptr (cut unmap-file-from-memory mmap))))))
     60
    4261(define (sha1sum fname)
    4362  (and (file-exists? fname)
    4463       (not (directory? fname))
    45   (let* ((fd (file-open fname open/rdonly))
    46          (fsize (file-size fd))
    47          (ctxt (allocate context-size))
    48          (digest (make-string digest-length)))
    49     (starts ctxt)
    50     (unless (zero? fsize)
    51       (let* ((mmap (map-file-to-memory #f fsize prot/read map/shared fd))
    52              (ptr (memory-mapped-file-pointer mmap)))
    53         (update ctxt ptr fsize)
    54         (unmap-file-from-memory mmap)))
    55     (finish ctxt digest)
    56     (free ctxt)
    57     (file-close fd)
    58     (string-concatenate
    59      (map (lambda (c)
    60             (string-pad (number->string (char->integer c) 16) 2 #\0))
    61           (string->list digest))))))
     64       (let* ((fd (file-open fname open/rdonly))
     65              (fsize (file-size fd))
     66              (ctxt (allocate context-size))
     67              (digest (make-string digest-length)))
     68         (starts ctxt)
     69         (unless (zero? fsize)
     70           (mapped-pointer
     71            fname fd fsize
     72            (lambda (buffer cleanup)
     73              (update ctxt buffer fsize)
     74              (cleanup))))
     75         (finish ctxt digest)
     76         (free ctxt)
     77         (file-close fd)
     78         (string-concatenate
     79          (map (lambda (c)
     80                 (string-pad (number->string (char->integer c) 16) 2 #\0))
     81               (string->list digest))))))
    6282
    6383)
  • release/4/simple-sha1/trunk/simple-sha1.setup

    r24645 r27951  
    66(install-extension 'simple-sha1
    77                   '("simple-sha1.so" "simple-sha1.import.so")
    8                    '((version 0.3)))
     8                   '((version 0.4)))
Note: See TracChangeset for help on using the changeset viewer.