1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
;; kasi-totp.el --- TOTP support for kasi -*- lexical-binding:t -*-
;; Copyright (C) 2026 Vineet K
;; Author: Vineet K <git@vineetk.net>
;; Keywords: processes
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; TOTP code taken from Mastering Emacs which took from Jürgen Hötzel's `totp.el'.
;; Base32 code taken from same Mastering Emacs article.
;; HMAC code taken from Sean McAfee.
;; https://www.masteringemacs.org/article/securely-generating-totp-tokens-emacs
;; https://github.com/juergenhoetzel/emacs-totp
;; https://github.com/grimnebulin/emacs-hmac
;;; Code:
(require 'bindat)
(require 'cl-lib)
(require 'hexl)
(require 'subr-x)
(defconst hmac-algorithm-blocksizes
'((md5 . 64)
(sha1 . 64)
(sha224 . 64)
(sha256 . 64)
(sha384 . 128)
(sha512 . 128))
"Mapping from HMAC algorithm to the algorithm's blocksize.")
(defun hmac (algorithm key message &optional binary)
"Compute the HMAC for a given message, private key and algorithm.
ALGORITHM is a symbol naming one of the algorithms recognized by
`secure-hash'. KEY is a the private key to use. MESSAGE, a
string, is the message to hash. If BINARY is non-nil, the hmac
will be returned as a binary string, otherwise as a hexadecimal
string."
(if-let (blocksize (alist-get algorithm hmac-algorithm-blocksizes))
(progn
(when (> (length key) blocksize)
(setq key (secure-hash algorithm key)))
(when (< (length key) blocksize)
(setq key (concat key (make-string (- blocksize (length key)) 0))))
(let ((o-key-pad (cl-map 'string #'logxor key (make-string blocksize #x5c)))
(i-key-pad (cl-map 'string #'logxor key (make-string blocksize #x36))))
(secure-hash algorithm (concat o-key-pad (secure-hash algorithm (concat i-key-pad message) nil nil t)) nil nil binary)))
(error "Unsupported hash algorithm %s" algorithm)))
(defconst base32-alphabet
(let ((tbl (make-char-table nil)))
(dolist (mapping '(("A" . 0) ("B" . 1) ("C" . 2) ("D" . 3)
("E" . 4) ("F" . 5) ("G" . 6)
("H" . 7) ("I" . 8) ("J" . 9) ("K" . 10)
("L" . 11) ("M" . 12) ("N" . 13)
("O" . 14) ("P" . 15) ("Q" . 16) ("R" . 17)
("S" . 18) ("T" . 19) ("U" . 20)
("V" . 21) ("W" . 22) ("X" . 23) ("Y" . 24)
("Z" . 25) ("2" . 26) ("3" . 27)
("4" . 28) ("5" . 29) ("6" . 30) ("7" . 31)))
(aset tbl (string-to-char (car mapping)) (cdr mapping)))
tbl)
"Base-32 mapping table, as defined in RFC 4648.")
(defun base32-hex-decode (string)
"The cheats' version of base-32 decode.
This is not a 100% faithful implementation of RFC 4648. The
concept of encoding partial quanta is not implemented fully."
(unless (zerop (mod (length string) 8))
(error "Padding is incorrect"))
(setq string (upcase string))
(let* ((trimmed-array (append (string-trim-right string "=+") nil))
(hex (format "%X" (seq-reduce
(lambda (acc char) (+ (ash acc 5) (aref base32-alphabet char)))
trimmed-array 0))))
(if (cl-oddp (length hex))
(concat "0" hex)
hex)))
(defun totp--hex-decode-string (string)
"Hex-decode STRING and return the result as a unibyte string."
(apply #'unibyte-string
(seq-map (lambda (s) (hexl-htoi (aref s 0) (aref s 1)))
(seq-partition string 2))))
(defun totp (string)
"Return a TOTP token using the secret hex STRING and current time."
(let* ((key-bytes (totp--hex-decode-string (upcase string)))
(counter (truncate (/ (time-to-seconds) 30)))
;; we have to manually split the 64 bit number (u64 not supported in Emacs 27.2)
(counter-bytes (bindat-pack '((:high u32) (:low u32))
`((:high . ,(ash counter -32)) (:low . ,(logand counter #xffffffff)))))
(mac (hmac 'sha1 key-bytes counter-bytes))
(offset (logand (bindat-get-field (bindat-unpack '((:offset u8)) mac 19) :offset) #xf)))
(format "%06d"
(mod
(logand (bindat-get-field (bindat-unpack '((:totp-pin u32)) mac offset) :totp-pin)
#x7fffffff)
(expt 10 6)))))
(provide 'kasi-totp)
|
