dbo/.emacs.d
dbo
/
.emacs.d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add simple function for base45 decoding 

For playing around with EU Covid Certificates.
This commit is contained in:
Daniel - 2021-11-06 17:46:37 +01:00
parent ef2932fed7
commit a8cfeaf69f
No known key found for this signature in database
GPG Key ID: 1C7071A75BB72D64
1 changed files with 106 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
site-lisp/db-utils.el
View File

@ -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