Add simple function for base45 decoding

For playing around with EU Covid Certificates.

site-lisp/db-utils.el

@@ -451,6 +451,112 @@ Does not replace CRLF with CRCRLF, and so on."
               (file-exists-p (concat project "/.git"))))
           projectile-known-projects))))
 
+
+;; Base45 Decoding
+
+;; This is based on https://datatracker.ietf.org/doc/draft-faltstrom-base45/,
+;; which in turned may be used in data encoded for QR codes.
+
+(let ((translation-hash-table (make-hash-table)))
+  (puthash ?0 00 translation-hash-table)
+  (puthash ?1 01 translation-hash-table)
+  (puthash ?2 02 translation-hash-table)
+  (puthash ?3 03 translation-hash-table)
+  (puthash ?4 04 translation-hash-table)
+  (puthash ?5 05 translation-hash-table)
+  (puthash ?6 06 translation-hash-table)
+  (puthash ?7 07 translation-hash-table)
+  (puthash ?8 08 translation-hash-table)
+  (puthash ?9 09 translation-hash-table)
+  (puthash ?A 10 translation-hash-table)
+  (puthash ?B 11 translation-hash-table)
+  (puthash ?C 12 translation-hash-table)
+  (puthash ?D 13 translation-hash-table)
+  (puthash ?E 14 translation-hash-table)
+  (puthash ?F 15 translation-hash-table)
+  (puthash ?G 16 translation-hash-table)
+  (puthash ?H 17 translation-hash-table)
+  (puthash ?I 18 translation-hash-table)
+  (puthash ?J 19 translation-hash-table)
+  (puthash ?K 20 translation-hash-table)
+  (puthash ?L 21 translation-hash-table)
+  (puthash ?M 22 translation-hash-table)
+  (puthash ?N 23 translation-hash-table)
+  (puthash ?O 24 translation-hash-table)
+  (puthash ?P 25 translation-hash-table)
+  (puthash ?Q 26 translation-hash-table)
+  (puthash ?R 27 translation-hash-table)
+  (puthash ?S 28 translation-hash-table)
+  (puthash ?T 29 translation-hash-table)
+  (puthash ?U 30 translation-hash-table)
+  (puthash ?V 31 translation-hash-table)
+  (puthash ?W 32 translation-hash-table)
+  (puthash ?X 33 translation-hash-table)
+  (puthash ?Y 34 translation-hash-table)
+  (puthash ?Z 35 translation-hash-table)
+  (puthash ?\s 36 translation-hash-table)
+  (puthash ?$ 37 translation-hash-table)
+  (puthash ?% 38 translation-hash-table)
+  (puthash ?* 39 translation-hash-table)
+  (puthash ?+ 40 translation-hash-table)
+  (puthash ?- 41 translation-hash-table)
+  (puthash ?. 42 translation-hash-table)
+  (puthash ?/ 43 translation-hash-table)
+  (puthash ?: 44 translation-hash-table)
+
+  (defun db/base45--string-to-bytes (str)
+    "Translate base45 input string to list of numbers as per specification."
+    (-map (lambda (char)
+            (or (gethash char translation-hash-table)
+                (user-error "Invalid character in string for base45 decoding: %c" char)))
+          str)))
+
+(defun db/base45-decode-string (str)
+  "Decode base45 string STR and return the result as a string."
+
+  (when (= 1 (% (length str) 3))
+    (user-error "Input string has invalid length for base45 decoding; must be 0 or 2 modulo 3"))
+
+  (let* ((list-of-blocks (->> str
+                              db/base45--string-to-bytes
+                              (-partition-all 3)))
+
+         (list-of-numbers (-map (lambda (block)
+                                  (+ (* 45 45 (or (nth 2 block) 0))
+                                     (* 45 (nth 1 block))
+                                     (nth 0 block)))
+                                list-of-blocks))
+
+         (list-of-bytes (nconc (-mapcat (lambda (num)
+                                          (list (/ num 256)
+                                                (% num 256)))
+                                        (-butlast list-of-numbers))
+                               (let ((last-one (-last-item list-of-numbers)))
+                                 (if (< last-one 256)
+                                     ;; When the last element represents only
+                                     ;; one byte, discard the extra 0 that (/
+                                     ;; last-one 256) would produce …
+                                     (list last-one)
+                                   ;; … else handle the last element like all
+                                   ;; the others
+                                   (list (/ last-one 256)
+                                         (% last-one 256)))))))
+
+    (apply #'string list-of-bytes)))
+
+(defun db/base45-decode-region (beg end)
+  "Base45-decode region between BEG and END.
+
+Replaces the region by the result of the decoding."
+  (interactive "r")
+  (let ((replace-string (db/base45-decode-string (buffer-substring-no-properties beg end))))
+    (kill-region beg end)
+    ;; Using `insert' and `insert-char' directly uses character conversion and
+    ;; may scramble bytes with the eight bit set; let's try `insert-byte'
+    ;; instead.
+    (dolist (char (string-to-list replace-string))
+      (insert-byte char 1))))
+
 
 ;;; Extend Input Methods