Autoload without #s! pasted by alaricsp on Mon Sep 19 12:44:36 2011

(use crypto-tools)

(define (autoload-aes!)
    (let ((real-bindings
	   (eval `(module ,(gensym) ()
	       (import scheme)
	       (require-extension aes)
	       (vector make-aes128-encryptor make-aes128-decryptor)))))
      (set! make-aes128-encryptor (vector-ref real-bindings 0))
      (set! make-aes128-decryptor (vector-ref real-bindings 1))))

(define make-aes128-encryptor
  (lambda args
    (autoload-aes!)
    (apply make-aes128-encryptor args)))

(define make-aes128-decryptor
  (lambda args
    (autoload-aes!)
    (apply make-aes128-decryptor args)))


(let*
   ((encryptor (make-aes128-encryptor (hexstring->blob "00010203050607080A0B0C0D0F101112")))
    (decryptor (make-aes128-decryptor (hexstring->blob "00010203050607080A0B0C0D0F101112")))
    (encrypted (encryptor (hexstring->blob "506812A45F08C889B97F5980038B8359")))
    (encrypted-string (blob->hexstring/uppercase encrypted))
    (decrypted (decryptor encrypted))
    (decrypted-string (blob->hexstring/uppercase decrypted)))
   
   (printf "Test vector 1a: ~A\n" encrypted-string)
   (printf "Test vector 1b: ~A\n" decrypted-string)
   (assert (string=? encrypted-string "D8F532538289EF7D06B506A4FD5BE9C9"))
   (assert (string=? decrypted-string "506812A45F08C889B97F5980038B8359")))

(let*
   ((encryptor (make-aes128-encryptor (hexstring->blob "E8E9EAEBEDEEEFF0F2F3F4F5F7F8F9FA")))
    (decryptor (make-aes128-decryptor (hexstring->blob "E8E9EAEBEDEEEFF0F2F3F4F5F7F8F9FA")))
    (encrypted (encryptor (hexstring->blob "014BAF2278A69D331D5180103643E99A")))
    (encrypted-string (blob->hexstring/uppercase encrypted))
    (decrypted (decryptor encrypted))
    (decrypted-string (blob->hexstring/uppercase decrypted)))
   
   (printf "Test vector 2a: ~A\n" encrypted-string)
   (printf "Test vector 2b: ~A\n" decrypted-string)
   (assert (string=? encrypted-string "6743C3D1519AB4F2CD9A78AB09A511BD"))
   (assert (string=? decrypted-string "014BAF2278A69D331D5180103643E99A")))

Now with added hygiene added by alaricsp on Mon Sep 19 13:15:16 2011


; require-extension is NOT HYGIENIC, so we need to also import quote from scheme :-(

(define (get-bindings-from-module module bindings)
  (let* ((vektor (gensym))
	 (rekuire-extension (gensym))
	 (expression
	  `(module ,(gensym) ()
		   (import
		    (rename
		     (only scheme vector require-extension quote) ; quote shouldn't need to be here
		     (vector ,vektor) (require-extension ,rekuire-extension)))
		   (,rekuire-extension ,module)
		   (,vektor ,@bindings))))
    (eval expression)))

(define (autoload-aes!)
    (let ((real-bindings
	   (get-bindings-from-module 'aes '(make-aes128-encryptor make-aes128-decryptor))))
      (set! make-aes128-encryptor (vector-ref real-bindings 0))
      (set! make-aes128-decryptor (vector-ref real-bindings 1))))

(define make-aes128-encryptor
  (lambda args
    (autoload-aes!)
    (apply make-aes128-encryptor args)))

(define make-aes128-decryptor
  (lambda args
    (autoload-aes!)
    (apply make-aes128-decryptor args)))


;; aes test suite:

(use crypto-tools)

(let*
   ((encryptor (make-aes128-encryptor (hexstring->blob "00010203050607080A0B0C0D0F101112")))
    (decryptor (make-aes128-decryptor (hexstring->blob "00010203050607080A0B0C0D0F101112")))
    (encrypted (encryptor (hexstring->blob "506812A45F08C889B97F5980038B8359")))
    (encrypted-string (blob->hexstring/uppercase encrypted))
    (decrypted (decryptor encrypted))
    (decrypted-string (blob->hexstring/uppercase decrypted)))
   
   (printf "Test vector 1a: ~A\n" encrypted-string)
   (printf "Test vector 1b: ~A\n" decrypted-string)
   (assert (string=? encrypted-string "D8F532538289EF7D06B506A4FD5BE9C9"))
   (assert (string=? decrypted-string "506812A45F08C889B97F5980038B8359")))

(let*
   ((encryptor (make-aes128-encryptor (hexstring->blob "E8E9EAEBEDEEEFF0F2F3F4F5F7F8F9FA")))
    (decryptor (make-aes128-decryptor (hexstring->blob "E8E9EAEBEDEEEFF0F2F3F4F5F7F8F9FA")))
    (encrypted (encryptor (hexstring->blob "014BAF2278A69D331D5180103643E99A")))
    (encrypted-string (blob->hexstring/uppercase encrypted))
    (decrypted (decryptor encrypted))
    (decrypted-string (blob->hexstring/uppercase decrypted)))
   
   (printf "Test vector 2a: ~A\n" encrypted-string)
   (printf "Test vector 2b: ~A\n" decrypted-string)
   (assert (string=? encrypted-string "6743C3D1519AB4F2CD9A78AB09A511BD"))
   (assert (string=? decrypted-string "014BAF2278A69D331D5180103643E99A")))