66 lines
2.2 KiB
Scheme
66 lines
2.2 KiB
Scheme
(module crypt mzscheme
|
|
|
|
(require (lib "foreign.ss")) (unsafe!)
|
|
|
|
(define libcrypt (ffi-lib "libcrypt"))
|
|
|
|
(provide crypt)
|
|
(define crypt
|
|
(get-ffi-obj "crypt" libcrypt (_fun _string _string -> _bytes)))
|
|
|
|
(define set-key*
|
|
(get-ffi-obj "setkey" libcrypt (_fun _bytes -> _void)))
|
|
(define encrypt*
|
|
(get-ffi-obj "encrypt" libcrypt (_fun _bytes _bool -> _void)))
|
|
|
|
;; see the encrypt(3) man page for the following
|
|
|
|
(define (*crypt str key flag)
|
|
(set-key* key)
|
|
(let ([str (string8->keystring str)])
|
|
(encrypt* str flag)
|
|
(keystring->string8 str)))
|
|
|
|
(provide encrypt decrypt)
|
|
(define (encrypt str key) (*crypt (string->bytes/utf-8 str) key #f))
|
|
(define (decrypt str key) (bytes->string/utf-8 (*crypt str key #t)))
|
|
|
|
(define (string8->keystring str)
|
|
(let* ([len (bytes-length str)]
|
|
[str (cond
|
|
[(> len 8) (subbytes str 0 8)]
|
|
[(< len 8) (bytes-append str (make-bytes (- 8 len) 32))]
|
|
[else str])]
|
|
[bin (apply string-append
|
|
(map (lambda (x)
|
|
(let* ([bin (format "~b" x)]
|
|
[len (string-length bin)])
|
|
(if (< (string-length bin) 8)
|
|
(string-append (make-string (- 8 len) #\0) bin)
|
|
bin)))
|
|
(bytes->list str)))])
|
|
(list->bytes
|
|
(map (lambda (x)
|
|
(case x
|
|
[(#\0) 0] [(#\1) 1]
|
|
[else (error 'string8->keystring "something bad happened")]))
|
|
(string->list bin)))))
|
|
|
|
(define (keystring->string8 bin)
|
|
(unless (= 64 (bytes-length bin))
|
|
(error 'keystring->string8 "bad input size: ~s" bin))
|
|
(let ([bin (apply string (map (lambda (x)
|
|
(case x
|
|
[(0) #\0] [(1) #\1]
|
|
[else (error 'keystring->string8
|
|
"something bad happened")]))
|
|
(bytes->list bin)))])
|
|
(apply bytes
|
|
(let loop ([n (- 64 8)] [r '()])
|
|
(if (< n 0)
|
|
r
|
|
(loop (- n 8) (cons (string->number (substring bin n (+ n 8)) 2)
|
|
r)))))))
|
|
|
|
)
|