changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/cry/hotp.lisp

changeset 698: 96958d3eb5b0
parent: 7120877e0453
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; crypto/hotp.lisp --- HMAC-Based One-Time Passwords
     2 
     3 ;; see https://github.com/bhyde/cl-one-time-passwords/hotp.lisp
     4 
     5 ;; RFC 4226
     6 
     7 ;;; Code:
     8 (in-package :cry/hotp)
     9 
    10 (defvar *digits* 6)
    11 
    12 (defvar *hmac-sha-mode* :sha3)
    13 
    14 (defun hmac-sha-n (key-string counter)
    15   (loop
    16     with counter-bytes = (make-array 8 :element-type '(unsigned-byte 8))
    17     with hmac = (ironclad:make-hmac
    18                  (ironclad:hex-string-to-byte-array key-string)
    19                  *hmac-sha-mode*)
    20     finally
    21        (ironclad:update-hmac hmac counter-bytes)
    22        (return (ironclad:hmac-digest hmac))
    23     for i from 7 downto 0
    24     for offset from 0 by 8
    25     do (setf (aref counter-bytes i) (ldb (byte 8 offset) counter))))
    26 
    27 (defun hotp-truncate (20-bytes)
    28   (flet ((dt (ht)
    29            (let* ((byte19 (aref ht 19))
    30                   (byte-offset (ldb (byte 4 0) byte19))
    31                   (result 0))
    32              (setf (ldb (byte 7 24) result) (aref ht byte-offset))
    33              (setf (ldb (byte 8 16) result) (aref ht (+ 1 byte-offset)))
    34              (setf (ldb (byte 8  8) result) (aref ht (+ 2 byte-offset)))
    35              (setf (ldb (byte 8  0) result) (aref ht (+ 3 byte-offset)))
    36              result)))
    37     (let ((sbits (dt 20-bytes)))
    38       (mod sbits
    39            (svref #(1 10 100 1000 10000 100000 1000000 10000000 100000000)
    40                   *digits*)))))
    41 
    42 (defun hotp (key-string counter)
    43   (hotp-truncate (hmac-sha-n key-string counter)))