[dynamic] Horrible one-off bindings to libnettle for AES encryption

1 files changed, 64 insertions, 0 deletions

diff --git a/haunt/jakob/dynamic/aes.scm b/haunt/jakob/dynamic/aes.scm
new file mode 100644
index 0000000..11d4819
--- /dev/null
+++ b/haunt/jakob/dynamic/aes.scm
@@ -0,0 +1,64 @@
+;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob dynamic aes)
+  #:use-module (gcrypt random)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  #:export (new-captcha))
+
+(define %libnettle (dynamic-link "libnettle"))
+(define %aes256-rounds 14)
+
+(define %aes-key-size (/ 256 8))
+(define %aes-block-size (/ 128 8))
+(define %tex-aes-key (gen-random-bv %aes-key-size))
+
+;; Assume `data' is a bytevector of length `%aes-block-size'.
+(define (aes-256-encrypt key data)
+  (let ((dest (make-bytevector %aes-block-size))
+        (%ctx (make-c-struct (map (lambda (_) uint32) (iota (* 4 (+ 1 %aes256-rounds))))
+                             (map (lambda (_) 0) (iota (* 4 (+ 1 %aes256-rounds))))))
+        (%aes-256-encrypt
+         (pointer->procedure void
+                             (dynamic-func "nettle_aes256_encrypt" %libnettle)
+                             (list '* size_t '* '*)))
+        (%aes-256-set-encrypt-key
+         (pointer->procedure void
+                             (dynamic-func "nettle_aes256_set_encrypt_key" %libnettle)
+                             (list '* '*))))
+    (%aes-256-set-encrypt-key %ctx (bytevector->pointer %tex-aes-key))
+    (%aes-256-encrypt %ctx %aes-block-size (bytevector->pointer dest) (bytevector->pointer data))
+    dest))
+
+(define (aes-256-decrypt key data)
+  (let ((dest (make-bytevector %aes-block-size))
+        (%ctx (make-c-struct (map (lambda (_) uint32) (iota (* 4 (+ 1 %aes256-rounds))))
+                             (map (lambda (_) 0) (iota (* 4 (+ 1 %aes256-rounds))))))
+        (%aes-256-decrypt
+         (pointer->procedure void
+                             (dynamic-func "nettle_aes256_decrypt" %libnettle)
+                             (list '* size_t '* '*)))
+        (%aes-256-set-decrypt-key
+         (pointer->procedure void
+                             (dynamic-func "nettle_aes256_set_decrypt_key" %libnettle)
+                             (list '* '*))))
+    (%aes-256-set-decrypt-key %ctx (bytevector->pointer %tex-aes-key))
+    (%aes-256-decrypt %ctx %aes-block-size (bytevector->pointer dest) (bytevector->pointer data))
+    dest))
+
+;; (utf8->string (aes-256-decrypt %tex-aes-key (aes-256-encrypt %tex-aes-key (string->utf8 "AAAABBBBC hello!"))))
+;; => "AAAABBBBC hello!"