sodium.scm (5326B)
1 (define-module (sodium) 2 #:export (generate-key 3 encrypt 4 decrypt 5 hash-password 6 verify-password 7 base64-encode 8 base64-decode)) 9 (use-modules (rnrs bytevectors) 10 (system foreign)) 11 12 (define libsodium (dynamic-link "libsodium")) 13 14 (define sodium-init (pointer->procedure int 15 (dynamic-func "sodium_init" libsodium) 16 '())) 17 (if (equal? (sodium-init) -1) (begin 18 (display "Not enough entropy to be secure") 19 (quit))) 20 21 (define KEYBYTES 22 ((pointer->procedure size_t (dynamic-func "crypto_secretbox_keybytes" libsodium) '()))) 23 24 (define NONCEBYTES 25 ((pointer->procedure size_t (dynamic-func "crypto_secretbox_noncebytes" libsodium) '()))) 26 27 (define MACBYTES 28 ((pointer->procedure size_t (dynamic-func "crypto_secretbox_macbytes" libsodium) '()))) 29 30 (define SALTBYTES 31 ((pointer->procedure size_t (dynamic-func "crypto_pwhash_saltbytes" libsodium) '()))) 32 33 (define STRBYTES 34 ((pointer->procedure size_t (dynamic-func "crypto_pwhash_strbytes" libsodium) '()))) 35 36 (define OPSLIMIT 37 ((pointer->procedure size_t (dynamic-func "crypto_pwhash_opslimit_interactive" libsodium) '()))) 38 39 (define MEMLIMIT 40 ((pointer->procedure size_t (dynamic-func "crypto_pwhash_memlimit_interactive" libsodium) '()))) 41 42 (define (random-buffer size) 43 (let ((buffer (make-bytevector size)) 44 (f (pointer->procedure void 45 (dynamic-func "randombytes_buf" libsodium) 46 (list '* size_t)))) 47 (f (bytevector->pointer buffer) size) 48 buffer)) 49 50 (define (generate-key) 51 (random-buffer KEYBYTES)) 52 53 (define (pointer-add pointer offset) 54 (make-pointer (+ (pointer-address pointer) offset))) 55 56 (define (encrypt message key) 57 (let ((buffer (random-buffer (+ (bytevector-length message) NONCEBYTES MACBYTES))) 58 (f (pointer->procedure int 59 (dynamic-func "crypto_secretbox_easy" libsodium) 60 (list '* '* size_t '* '*)))) 61 (f (pointer-add (bytevector->pointer buffer) NONCEBYTES) 62 (bytevector->pointer message) 63 (bytevector-length message) 64 (bytevector->pointer buffer) 65 (bytevector->pointer key)) 66 buffer)) 67 68 (define (decrypt message key) 69 (let* ((buffer (make-bytevector (- (bytevector-length message) NONCEBYTES MACBYTES))) 70 (f (pointer->procedure int 71 (dynamic-func "crypto_secretbox_open_easy" libsodium) 72 (list '* '* size_t '* '*))) 73 (res (f (bytevector->pointer buffer) 74 (pointer-add (bytevector->pointer message) NONCEBYTES) 75 (- (bytevector-length message) NONCEBYTES) 76 (bytevector->pointer message) 77 (bytevector->pointer key)))) 78 (if (equal? res 0) buffer #f))) 79 80 (define (hash-password password) 81 (let ((buffer (make-bytevector STRBYTES)) 82 (f (pointer->procedure int 83 (dynamic-func "crypto_pwhash_str" libsodium) 84 (list '* '* size_t size_t size_t)))) 85 (f (bytevector->pointer buffer) 86 (string->pointer password) 87 (string-length password) 88 OPSLIMIT 89 MEMLIMIT) 90 (pointer->string (bytevector->pointer buffer)))) 91 92 (define (verify-password password hash) 93 (let* ((f (pointer->procedure int 94 (dynamic-func "crypto_pwhash_str_verify" libsodium) 95 (list '* '* size_t))) 96 (res (f (string->pointer hash) 97 (string->pointer password) 98 (string-length password)))) 99 (equal? res 0))) 100 101 (define B64_VARIANT 7) 102 103 (define (base64-encode data) 104 (let* ((el (pointer->procedure size_t 105 (dynamic-func "sodium_base64_encoded_len" libsodium) 106 (list size_t int))) 107 (len (el (bytevector-length data) B64_VARIANT)) 108 (buffer (make-bytevector len)) 109 (f (pointer->procedure '* 110 (dynamic-func "sodium_bin2base64" libsodium) 111 (list '* size_t '* size_t int)))) 112 (f (bytevector->pointer buffer) 113 len 114 (bytevector->pointer data) 115 (bytevector-length data) 116 B64_VARIANT) 117 (pointer->string (bytevector->pointer buffer)))) 118 119 (define (base64-decode str) 120 (let* ((len (make-c-struct (list size_t) (list 0))) 121 (maxlen (ceiling (* (/ (string-length str) 4) 3))) 122 (buffer (make-bytevector maxlen)) 123 (f (pointer->procedure int 124 (dynamic-func "sodium_base642bin" libsodium) 125 (list '* size_t '* size_t '* '* '* int)))) 126 (f (bytevector->pointer buffer) 127 maxlen 128 (string->pointer str) 129 (string-length str) 130 %null-pointer 131 len 132 %null-pointer 133 B64_VARIANT) 134 (let ((outlen (car (parse-c-struct len (list size_t))))) 135 (if (> outlen 0) 136 (pointer->bytevector (bytevector->pointer buffer) outlen) 137 buffer))))