diff options
Diffstat (limited to 'aws/cloudformation/utils/base32.scm')
-rw-r--r-- | aws/cloudformation/utils/base32.scm | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/aws/cloudformation/utils/base32.scm b/aws/cloudformation/utils/base32.scm new file mode 100644 index 0000000..4a01825 --- /dev/null +++ b/aws/cloudformation/utils/base32.scm @@ -0,0 +1,53 @@ +(define-module (aws cloudformation utils base32) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-60) + #:export (base32-encode)) + +;; Credit to Ludovic Courtes +(define bytevector-quintet-ref + (let* ((ref bytevector-u8-ref) + (ref+ (lambda (bv offset) + (let ((o (+ 1 offset))) + (if (>= o (bytevector-length bv)) + 0 + (bytevector-u8-ref bv o))))) + (ref0 (lambda (bv offset) + (bit-field (ref bv offset) 3 8))) + (ref1 (lambda (bv offset) + (logior (ash (bit-field (ref bv offset) 0 3) 2) + (bit-field (ref+ bv offset) 6 8)))) + (ref2 (lambda (bv offset) + (bit-field (ref bv offset) 1 6))) + (ref3 (lambda (bv offset) + (logior (ash (bit-field (ref bv offset) 0 1) 4) + (bit-field (ref+ bv offset) 4 8)))) + (ref4 (lambda (bv offset) + (logior (ash (bit-field (ref bv offset) 0 4) 1) + (bit-field (ref+ bv offset) 7 8)))) + (ref5 (lambda (bv offset) + (bit-field (ref bv offset) 2 7))) + (ref6 (lambda (bv offset) + (logior (ash (bit-field (ref bv offset) 0 2) 3) + (bit-field (ref+ bv offset) 5 8)))) + (ref7 (lambda (bv offset) + (bit-field (ref bv offset) 0 5))) + (refs (vector ref0 ref1 ref2 ref3 ref4 ref5 ref6 ref7))) + (lambda (bv index) + "Return the INDEXth quintet of BV." + (let ((p (vector-ref refs (modulo index 8)))) + (p bv (quotient (* index 5) 8)))))) + +(define (base32-encode bv) + ;; We are assuming that the bytevector length is divisible by 5, + ;; because that is the case for SHA-1 hashes. A general-purpose + ;; base32 encoder would need to pad the bytevector when this is not + ;; the case. + (let* ((alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ") + (n (/ (* (bytevector-length bv) 8) 5)) + (s (make-string n))) + (let loop ((i 0)) + (when (< i n) + (let ((x (bytevector-quintet-ref bv i))) + (string-set! s i (string-ref alphabet x)) + (loop (+ i 1))))) + s)) |