kasi.el

kasi-totp.el (5308B)

---

 ;; 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 (string-as-unibyte (concat key (make-string (- blocksize (length key)) 0)))))
         (let* ((key-list (string-to-list key))
                (o-key-pad (apply #'unibyte-string
                                  (cl-map 'list #'logxor
                                           key-list
                                           (string-to-list (make-string blocksize #x5c)))))
                (i-key-pad (apply #'unibyte-string
                                  (cl-map 'list #'logxor
                                           key-list
                                           (string-to-list (make-string blocksize #x36)))))
                (inner (secure-hash algorithm (concat i-key-pad message) nil nil t)))
           (secure-hash algorithm (concat o-key-pad inner) 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."
   (setq string (upcase string))
   (let* ((trimmed-array (string-trim-right string "=+"))
          (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 (base32-hex-decode 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 t))
          (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)