56 lines
1.6 KiB
Racket
56 lines
1.6 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
racket/runtime-path
|
|
(for-syntax racket/base))
|
|
|
|
(provide sha1
|
|
sha1-bytes
|
|
bytes->hex-string)
|
|
|
|
(define-runtime-path libcrypto-so
|
|
(case (system-type)
|
|
[(windows) '(so "libeay32")]
|
|
[else '(so "libcrypto")]))
|
|
|
|
(define libcrypto
|
|
(ffi-lib libcrypto-so '("" "0.9.8b" "0.9.8" "0.9.7")))
|
|
|
|
(define _SHA_CTX-pointer _pointer)
|
|
|
|
(define SHA1_Init
|
|
(get-ffi-obj 'SHA1_Init libcrypto (_fun _SHA_CTX-pointer -> _int)))
|
|
(define SHA1_Update
|
|
(get-ffi-obj 'SHA1_Update libcrypto (_fun _SHA_CTX-pointer _pointer _long -> _int)))
|
|
(define SHA1_Final
|
|
(get-ffi-obj 'SHA1_Final libcrypto (_fun _pointer _SHA_CTX-pointer -> _int)))
|
|
|
|
(define (sha1-bytes in)
|
|
(let ([ctx (malloc 256)]
|
|
[tmp (make-bytes 4096)]
|
|
[result (make-bytes 20)])
|
|
(SHA1_Init ctx)
|
|
(let loop ()
|
|
(let ([n (read-bytes-avail! tmp in)])
|
|
(unless (eof-object? n)
|
|
(SHA1_Update ctx tmp n)
|
|
(loop))))
|
|
(SHA1_Final result ctx)
|
|
result))
|
|
|
|
(define (sha1 in)
|
|
(bytes->hex-string (sha1-bytes in)))
|
|
|
|
(define (bytes->hex-string bstr)
|
|
(let* ([len (bytes-length bstr)]
|
|
[bstr2 (make-bytes (* len 2))]
|
|
[digit
|
|
(lambda (v)
|
|
(if (v . < . 10)
|
|
(+ v (char->integer #\0))
|
|
(+ v (- (char->integer #\a) 10))))])
|
|
(for ([i (in-range len)])
|
|
(let ([c (bytes-ref bstr i)])
|
|
(bytes-set! bstr2 (* 2 i) (digit (arithmetic-shift c -4)))
|
|
(bytes-set! bstr2 (+ (* 2 i) 1) (digit (bitwise-and c #xF)))))
|
|
(bytes->string/latin-1 bstr2)))
|