├── .gitignore ├── README.md ├── cl-one-time-passwords-test.asd ├── cl-one-time-passwords.asd ├── hotp.lisp ├── packages.lisp ├── tests.lisp └── totp.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | #* 2 | *~ 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Introduction 2 | 3 | One time passwords provide a way to do authentication based on a 4 | shared secret without revealing that secret to spies on the 5 | communciation channel. 6 | 7 | Two well specified ways of generating OTPs are: 8 | * HOTP - An HMAC-Based One-Time Password Algorithm, i.e. RFC 4226 9 | * TOTP - Time-Based One-Time Password Algorithm , i.e. RFC 6238 10 | 11 | These are commonly used as one factor in two factor authentication 12 | systems. For example Google uses these. For example Google's 13 | Authenticator App for most smart phones will generate one time 14 | passwords once it has been configured with the shared secret(s) for 15 | your account(s). 16 | 17 | Cl-one-time-passwords implements HOTP and TOTP in Common Lisp. 18 | 19 | # Example 20 | 21 | 1. Load the code into your lisp image. 22 | 2. Share a secret with Google's Authenticator App on your smart phone by scanning this QDR code:
23 | ![QR Code](http://bhyde.github.io/cl-one-time-passwords/example-otp-qdr.png) 24 | 25 | 3. Compair the values that Authenticator is generating with the ones this code generates: 26 | ```common-lisp 27 | (totp:totp "48656C6C6F21DEADBEEF48656C6C6F21DEADBEEF") 28 | ``` 29 | 30 | They ought to be the same, but if your phone and computer clock are out of sync by a N seconds then every 30 seconds for N seconds they won't be the same. 31 | 32 | That QR encodes this URL otpauth://totp/test@example.com?secret=jbswy3dpehpk3pxpjbswy3dpehpk3pxp 33 | where the secret is the base32 encoding of the secret we passed to totp:totp in step 3, there the value was a 40 character hex number, i.e. 20 bytes. 34 | 35 | # API 36 | 37 | ```common-lisp 38 | hotp:*digits* 39 | ``` 40 | The number of digits to return in the htop values, defaults to six. See the RFC for details. 41 | 42 | ```common-lisp 43 | hotp:*hmac-sha-mode* 44 | ``` 45 | The kind of hmac to use. This defaults to :sha1. You can set other values 46 | ironclad supports; but my testing currrently indicates it doesn't work. This 47 | isn't part of the HOTP spec, but the TOTP spec extends HOTP ... even if nobody 48 | usest this extension. 49 | 50 | ```common-lisp 51 | (hotp:hotp ) 52 | ``` 53 | is a string of 20 characters hex digits; more if your using a different hmac sha. 54 | ```common-lisp 55 | totp:*time-zero* 56 | ``` 57 | Defaults to zero, a unix time. See the RFC for details. 58 | ```common-lisp 59 | totp:*time-step-in-seconds* 60 | ``` 61 | Defaults to 30, a unix time interval. See the RFC for details. 62 | 63 | ```common-lisp 64 | (totp:totp &optional offset unix-time) 65 | ``` 66 | as in hotp:hotp. The offset defaults to zero. The unix-time defaults 67 | to the current unix-time. The offset is used to get totp values nearby times 68 | slots, it is in seconds. 69 | 70 | # See also: 71 | + HOTP RFC4226 http://tools.ietf.org/html/rfc4226 72 | + TOTP RFC6238 http://tools.ietf.org/html/rfc6238 73 | + Code for Google's Authenticator App is available: https://code.google.com/p/google-authenticator/ 74 | + Check your app store for the actual application: http://support.google.com/accounts/bin/answer.py?hl=en&answer=1066447 75 | + Wikipedia is accumulating a list of places totp and hotp are used here: http://en.wikipedia.org/wiki/Time-based_One-time_Password_Algorithm 76 | + Open issues: https://github.com/bhyde/cl-one-time-passwords/issues 77 | 78 | # Warning 79 | This code as not yet been used in production. I look forward to reports back from the field. :) 80 | -------------------------------------------------------------------------------- /cl-one-time-passwords-test.asd: -------------------------------------------------------------------------------- 1 | ; -*- mode:common-lisp -*- 2 | (defsystem cl-one-time-passwords-test 3 | :author "Ben Hyde " 4 | :license "Apache 2.0" 5 | :description "Test cl-one-time-passwords" 6 | :depends-on (cl-one-time-passwords fiveam) 7 | :serial t 8 | :components ((:file "tests"))) 9 | -------------------------------------------------------------------------------- /cl-one-time-passwords.asd: -------------------------------------------------------------------------------- 1 | (defsystem cl-one-time-passwords 2 | :author "Ben Hyde " 3 | :license "Apache 2.0" 4 | :description 5 | "One time passwords (hotp rfc4226, totp rfc6238) as used in two factor authentication systems such as Google's." 6 | :depends-on (ironclad) 7 | :serial t 8 | :components ((:file "packages") 9 | (:file "hotp") 10 | (:file "totp"))) 11 | -------------------------------------------------------------------------------- /hotp.lisp: -------------------------------------------------------------------------------- 1 | (in-package "CL-HOTP") 2 | 3 | ; see: http://tools.ietf.org/html/rfc4226 4 | 5 | (defvar *digits* 6) 6 | 7 | (defvar *hmac-sha-mode* :sha1) 8 | 9 | (defun hotp (key-string counter) 10 | (hotp-truncate (hmac-sha-n key-string counter))) 11 | 12 | (defun hotp-truncate (20-bytes) 13 | (flet ((dt (ht) 14 | (let* ((byte19 (aref ht 19)) 15 | (byte-offset (ldb (byte 4 0) byte19)) 16 | (result 0)) 17 | (setf (ldb (byte 7 24) result) (aref ht byte-offset)) 18 | (setf (ldb (byte 8 16) result) (aref ht (+ 1 byte-offset))) 19 | (setf (ldb (byte 8 8) result) (aref ht (+ 2 byte-offset))) 20 | (setf (ldb (byte 8 0) result) (aref ht (+ 3 byte-offset))) 21 | result))) 22 | (let ((sbits (dt 20-bytes))) 23 | (mod sbits 24 | (svref #(1 10 100 1000 10000 100000 1000000 10000000 100000000) 25 | *digits*))))) 26 | 27 | (defun hmac-sha-n (key-string counter) 28 | (loop 29 | with counter-bytes = (make-array 8 :element-type '(unsigned-byte 8)) 30 | with hmac = (ironclad:make-hmac 31 | (ironclad:hex-string-to-byte-array key-string) 32 | *hmac-sha-mode*) 33 | finally 34 | (ironclad:update-hmac hmac counter-bytes) 35 | (return (ironclad:hmac-digest hmac)) 36 | for i from 7 downto 0 37 | for offset from 0 by 8 38 | do (setf (aref counter-bytes i) (ldb (byte 8 offset) counter)))) 39 | -------------------------------------------------------------------------------- /packages.lisp: -------------------------------------------------------------------------------- 1 | (in-package "COMMON-LISP-USER") 2 | 3 | (defpackage "CL-HOTP" 4 | (:nicknames "HOTP") 5 | (:use "COMMON-LISP") 6 | (:export "*DIGITS*" 7 | "*HMAC-SHA-MODE*" 8 | "HOTP")) 9 | 10 | (defpackage "CL-TOTP" 11 | (:nicknames "TOTP") 12 | (:use "COMMON-LISP") 13 | (:export "*TIME-ZERO*" 14 | "*TIME-STEP-IN-SECONDS*" 15 | "TOTP")) 16 | -------------------------------------------------------------------------------- /tests.lisp: -------------------------------------------------------------------------------- 1 | ; -*- mode:common-lisp -*- 2 | 3 | (defpackage "TEST-CL-ONE-TIME-PASSWORDS" 4 | (:use "COMMON-LISP" "FIVEAM")) 5 | 6 | (in-package "TEST-CL-ONE-TIME-PASSWORDS") 7 | 8 | (defvar *verbose* nil) 9 | 10 | (def-suite test-cl-one-time-passwords) 11 | 12 | (in-suite test-cl-one-time-passwords) 13 | 14 | (test hotp-truncate 15 | "rfc4226's truncate, example on page 7" 16 | (is 17 | (= 18 | (hotp::hotp-truncate 19 | (ironclad:hex-string-to-byte-array 20 | "1f8698690e02ca16618550ef7f19da8e945b555a")) 21 | 872921))) 22 | 23 | 24 | (test hmac-sha-n 25 | (is 26 | (loop 27 | with key = "3132333435363738393031323334353637383930" 28 | for (counter . expected) 29 | in '((0 . "cc93cf18508d94934c64b65d8ba7667fb7cde4b0") 30 | (1 . "75a48a19d4cbe100644e8ac1397eea747a2d33ab") 31 | (2 . "0bacb7fa082fef30782211938bc1c5e70416ff44") 32 | (3 . "66c28227d03a2d5529262ff016a1e6ef76557ece") 33 | (4 . "a904c900a64b35909874b33e61c5938a8e15ed1c") 34 | (5 . "a37e783d7b7233c083d4f62926c7a25f238d0316") 35 | (6 . "bc9cd28561042c83f219324d3c607256c03272ae") 36 | (7 . "a4fb960c0bc06e1eabb804e5b397cdc4b45596fa") 37 | (8 . "1b3c89f65e6c9e883012052823443f048b4332db") 38 | (9 . "1637409809a679dc698207310c8c7fc07290d9e5")) 39 | as test = (coerce (hotp::hmac-sha-n key counter) 'list) 40 | as test-out = (format nil "~{~2,'0x~}" test) 41 | when *verbose* do (format t "~2&~S~&~S" expected test-out) 42 | always (string-equal expected test-out)))) 43 | 44 | (test hotp 45 | "Test hotp, via example from page 31 of http://tools.ietf.org/html/rfc4226" 46 | (is 47 | (loop 48 | initially (when *verbose* (format t "~&# got want ?")) 49 | with key = "3132333435363738393031323334353637383930" 50 | for (counter . expected-hotp) in '((0 . 755224) 51 | (1 . 287082) 52 | (2 . 359152) 53 | (3 . 969429) 54 | (4 . 338314) 55 | (5 . 254676) 56 | (6 . 287922) 57 | (7 . 162583) 58 | (8 . 399871) 59 | (9 . 520489)) 60 | as test-hotp = (hotp:hotp key counter) 61 | when *verbose* 62 | do (format t "~&~d ~d ~d ~a" 63 | counter test-hotp expected-hotp 64 | (if (= test-hotp expected-hotp) "ok" "ko")) 65 | always (= test-hotp expected-hotp)))) 66 | 67 | 68 | (test totp-working 69 | "based on examples in the RFC" 70 | (loop 71 | with hotp:*digits* = 8 72 | with key-stuff = (let ((x "31323334353637383930")) ;; 10 bytes in hex 73 | (concatenate 'string x x x x x x x x x x x x x)) ;; 130 bytes 74 | with sha1-key = (subseq key-stuff 0 40) ; 20 bytes 75 | with sha256-key = (subseq key-stuff 0 64) 76 | with sha512-key = (subseq key-stuff 0 128) 77 | for (time nil expected-timestep expected-totp hotp:*hmac-sha-mode*) 78 | in '((59 "1970-01-01 00:00:59" #x0000000000000001 94287082 :SHA1) 79 | (59 "1970-01-01 00:00:59" #x0000000000000001 46119246 :SHA256) 80 | (59 "1970-01-01 00:00:59" #x0000000000000001 90693936 :SHA512) 81 | (1111111109 "2005-03-18 01:58:29" #x00000000023523EC 07081804 :SHA1) 82 | (1111111109 "2005-03-18 01:58:29" #x00000000023523EC 68084774 :SHA256) 83 | (1111111109 "2005-03-18 01:58:29" #x00000000023523EC 25091201 :SHA512) 84 | (1111111111 "2005-03-18 01:58:31" #x00000000023523ED 14050471 :SHA1) 85 | (1111111111 "2005-03-18 01:58:31" #x00000000023523ED 67062674 :SHA256) 86 | (1111111111 "2005-03-18 01:58:31" #x00000000023523ED 99943326 :SHA512) 87 | (1234567890 "2009-02-13 23:31:30" #x000000000273EF07 89005924 :SHA1) 88 | (1234567890 "2009-02-13 23:31:30" #x000000000273EF07 91819424 :SHA256) 89 | (1234567890 "2009-02-13 23:31:30" #x000000000273EF07 93441116 :SHA512) 90 | (2000000000 "2033-05-18 03:33:20" #x0000000003F940AA 69279037 :SHA1) 91 | (2000000000 "2033-05-18 03:33:20" #x0000000003F940AA 90698825 :SHA256) 92 | (2000000000 "2033-05-18 03:33:20" #x0000000003F940AA 38618901 :SHA512) 93 | (20000000000 "2603-10-11 11:33:20" #x0000000027BC86AA 65353130 :SHA1) 94 | (20000000000 "2603-10-11 11:33:20" #x0000000027BC86AA 77737706 :SHA256) 95 | (20000000000 "2603-10-11 11:33:20" #x0000000027BC86AA 47863826 :SHA512)) 96 | as test-timestep = (totp::time-step time) 97 | as key-hexstring = (ecase hotp:*hmac-sha-mode* 98 | (:sha1 sha1-key) 99 | (:sha256 sha256-key) 100 | (:sha512 sha512-key)) 101 | as not-expected-to-work = (not (eq :sha1 hotp:*hmac-sha-mode*)) 102 | as test-totp = (totp:totp key-hexstring 0 time) 103 | as ok? = (= expected-totp test-totp) 104 | when *verbose* do (format t "~&~A ~12D ~D/~D ~8,'0D/~8,'0D ~a" 105 | (if ok? ". " "KO") 106 | time 107 | expected-timestep test-timestep 108 | expected-totp test-totp 109 | hotp:*hmac-sha-mode*) 110 | always (or ok? not-expected-to-work))) 111 | 112 | #+nil 113 | (test totp-not-working 114 | "based on examples in the RFC" 115 | (loop 116 | with hotp:*digits* = 8 117 | with key-stuff = (let ((x "31323334353637383930")) ;; 10 bytes in hex 118 | (concatenate 'string x x x x x x x x x x x x x)) ;; 130 bytes 119 | with sha1-key = (subseq key-stuff 0 40) ; 20 bytes 120 | with sha256-key = (subseq key-stuff 0 64) 121 | with sha512-key = (subseq key-stuff 0 128) 122 | for (time nil expected-timestep expected-totp hotp:*hmac-sha-mode*) 123 | in '((59 "1970-01-01 00:00:59" #x0000000000000001 94287082 :SHA1) 124 | (59 "1970-01-01 00:00:59" #x0000000000000001 46119246 :SHA256) 125 | (59 "1970-01-01 00:00:59" #x0000000000000001 90693936 :SHA512) 126 | (1111111109 "2005-03-18 01:58:29" #x00000000023523EC 07081804 :SHA1) 127 | (1111111109 "2005-03-18 01:58:29" #x00000000023523EC 68084774 :SHA256) 128 | (1111111109 "2005-03-18 01:58:29" #x00000000023523EC 25091201 :SHA512) 129 | (1111111111 "2005-03-18 01:58:31" #x00000000023523ED 14050471 :SHA1) 130 | (1111111111 "2005-03-18 01:58:31" #x00000000023523ED 67062674 :SHA256) 131 | (1111111111 "2005-03-18 01:58:31" #x00000000023523ED 99943326 :SHA512) 132 | (1234567890 "2009-02-13 23:31:30" #x000000000273EF07 89005924 :SHA1) 133 | (1234567890 "2009-02-13 23:31:30" #x000000000273EF07 91819424 :SHA256) 134 | (1234567890 "2009-02-13 23:31:30" #x000000000273EF07 93441116 :SHA512) 135 | (2000000000 "2033-05-18 03:33:20" #x0000000003F940AA 69279037 :SHA1) 136 | (2000000000 "2033-05-18 03:33:20" #x0000000003F940AA 90698825 :SHA256) 137 | (2000000000 "2033-05-18 03:33:20" #x0000000003F940AA 38618901 :SHA512) 138 | (20000000000 "2603-10-11 11:33:20" #x0000000027BC86AA 65353130 :SHA1) 139 | (20000000000 "2603-10-11 11:33:20" #x0000000027BC86AA 77737706 :SHA256) 140 | (20000000000 "2603-10-11 11:33:20" #x0000000027BC86AA 47863826 :SHA512)) 141 | as test-timestep = (totp::time-step time) 142 | as key-hexstring = (ecase hotp:*hmac-sha-mode* 143 | (:sha1 sha1-key) 144 | (:sha256 sha256-key) 145 | (:sha512 sha512-key)) 146 | as test-totp = (totp:totp key-hexstring 0 time) 147 | as ok? = (= expected-totp test-totp) 148 | when *verbose* do (format t "~&~A ~12D ~D/~D ~8,'0D/~8,'0D ~a" 149 | (if ok? ". " "KO") 150 | time 151 | expected-timestep test-timestep 152 | expected-totp test-totp 153 | hotp:*hmac-sha-mode*) 154 | ;always ok? 155 | )) 156 | 157 | ;; Sadly only :sha1 is working :( 158 | ;; but then, google authenticator may only support sha1 159 | 160 | 161 | #+nil 162 | (test make-otpauth-url 163 | (string-equal 164 | "otpauth://totp/alice@google.com?secret=JBSWY3DPEHPK3PXP" 165 | (let ((secret (list (char-code #\H) (char-code #\e) (char-code #\l) (char-code #\l) (char-code #\o) (char-code #\!) 166 | #xDE #xAD #xBE #xEF))) 167 | (make-otpauth-url "alice@google.com" 168 | (make-array 10 :initial-contents secret))))) 169 | 170 | (run!) 171 | 172 | 173 | -------------------------------------------------------------------------------- /totp.lisp: -------------------------------------------------------------------------------- 1 | (in-package "CL-TOTP") 2 | 3 | (defconstant .unix-epoch-zero. 2208988800) 4 | ;; 00:00:00 UTC on 1 January 1970 5 | ;; (encode-universal-time 0 0 0 1 1 1970 0) 6 | ;; --> 2208988800 7 | 8 | (defvar *time-zero* 0) ; aka the unix epoch zero 9 | (defvar *time-step-in-seconds* 30) 10 | 11 | (defmacro time-step (unix-time) 12 | `(floor (- ,unix-time *time-zero*) *time-step-in-seconds*)) 13 | 14 | (defun totp (key-hexstring &optional (offset 0) (time (- (get-universal-time) .unix-epoch-zero. offset))) 15 | (hotp:hotp key-hexstring (time-step time))) 16 | 17 | 18 | ;;;; otpauth urls' you'd need to ahve cl-base32 loaded for these to work 19 | 20 | #+nil 21 | (defun make-otpauth-url (identity key-bytes) 22 | (declare (type key-bytes (array 20 '(unsigned-byte 8)))) 23 | (format nil "otpauth://totp/~a?secret=~a" 24 | identity 25 | (cl-base32:bytes-to-base32 key-bytes))) 26 | 27 | #+nil 28 | (defun test-make-otpauth-url () 29 | (string-equal 30 | "otpauth://totp/alice@google.com?secret=JBSWY3DPEHPK3PXP" 31 | (let ((secret (list (char-code #\H) (char-code #\e) (char-code #\l) (char-code #\l) (char-code #\o) (char-code #\!) 32 | #xDE #xAD #xBE #xEF))) 33 | (make-otpauth-url "alice@google.com" 34 | (make-array 10 :initial-contents secret))))) 35 | 36 | ;; A test url: otpauth://totp/test@example.com?secret=jbswy3dpehpk3pxpjbswy3dpehpk3pxp 37 | ;; you can make a QR code from that at and load it into 38 | ;; Google's Authenticator. The TOTP codes it starts generating can also be generated 39 | ;; via (totp "48656C6C6F21DEADBEEF48656C6C6F21DEADBEEF") 40 | ;; fyi (format t "~{~2,'0x~}" (coerce (cl-base32:base32-to-bytes "jbswy3dpehpk3pxpjbswy3dpehpk3pxp") 'list)) 41 | ;; is "48656C6C6F21DEADBEEF48656C6C6F21DEADBEEF" 42 | --------------------------------------------------------------------------------