Package: elpa;
Reported by: Stefan Kangas <stefankangas <at> gmail.com>
Date: Sat, 10 Feb 2024 11:17:01 UTC
Severity: normal
Message #8 received at 69013 <at> debbugs.gnu.org (full text, mbox):
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Stefan Kangas <stefankangas <at> gmail.com> Cc: 69013 <at> debbugs.gnu.org, Michael Albinus <michael.albinus <at> gmx.de>, Vivek Das Mohapatra <vivek <at> etla.org> Subject: Re: bug#69013: New package for NonGNU ELPA: totp-auth Date: Sat, 10 Feb 2024 12:28:53 -0500
[Message part 1 (text/plain, inline)]
> + (base32 :url "https://gitlab.com/fledermaus/totp.el"
> + :ignored-files ("totp-auth*.el" "Makefile" "*.md" "*.html" "tests" "README")
> + :version-map (("0.2" "1.0" "v1.0")))
Question about this one:
(defun base32-lsh (v c)
"Shift integer V by C bits to the left.
Shift rightwards if C is negative.
Any bits shifted in are 0.
Suppress opinionated (and in our case wrong) warning about ’lsh’."
(with-suppressed-warnings ((suspicious lsh))
(lsh v c)))
I replace the above with
(define-obsolete-function-alias 'base32-lsh #'ash "2024")
and the tests still go through just fine. Also tracing `base32-lsh`
suggests it's never called with a negative argument, which would explain
why `ash` works just as well.
Could point out where you rely on the unusual behavior of `lsh`, the one
described in the docstring as:
In this case, if VALUE is a negative fixnum treat it as unsigned,
i.e., subtract 2 * ‘most-negative-fixnum’ from VALUE before shifting it.
?
> (bash-completion :url "https://github.com/szermatt/emacs-bash-completion"
> :readme "README.md")
>
> @@ -760,6 +764,10 @@
> (toc-org :url "https://github.com/snosov1/toc-org.git"
> :ignored-files ("COPYING" ".travis.yml" "toc-org-test.el"))
>
> + (totp-auth :url "https://gitlab.com/fledermaus/totp.el"
> + :ignored-files ("base32.el" "Makefile" "*.md" "*.html" "tests")
> + :version-map (("0.4" "1.0" "v1.0")))
It would be better to put the shared ignored files (i.e. `*.html`,
`Makefile`, and `tests`) in `.elpaignore`, I think.
Also, I'm curious about the reason why you prefer keeping `README` over
`README.md`? If I were you, I'd get rid of `README`,
One more thing: AFAICT, you have signed the copyright paperwork and
you're the sole author of this code, so we could add it to GNU ELPA
instead of NonGNU ELPA. Is that indeed the case?
Would you be OK with that?
In any case, I pushed your patch, thanks.
See below a ptch with suggested changes (and a few FIXME questions).
Stefan
[totp-auth.patch (text/x-diff, inline)]
diff --git a/.gitignore b/.gitignore
index e0b9fbae6f..ad6f188387 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,8 @@
*.elc
*~
+
+# ELPA-generated files
+/totp-auth-autoloads.el
+/totp-auth-pkg.el
+/base32-autoloads.el
+/base32-pkg.el
diff --git a/README.md b/README.md
index 247dd04d77..9181648782 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-# totp-auth.el - Time-based One Time Password support for emacs
+# totp-auth.el - Time-based One Time Password support for Emacs
This package generates RFC6238 Time-based One Time Passwords
(in other words, what Google Authenticator implements)
diff --git a/base32.el b/base32.el
index 1e4304b214..48f4ec15d7 100644
--- a/base32.el
+++ b/base32.el
@@ -26,13 +26,7 @@ at index 32.")
"The default base32hex dictionary.
\nLike ‘base32-dictionary’ but for the base32hex encoding.")
-(defun base32-lsh (v c)
- "Shift integer V by C bits to the left.
-Shift rightwards if C is negative.
-Any bits shifted in are 0.
-Suppress opinionated (and in our case wrong) warning about ’lsh’."
- (with-suppressed-warnings ((suspicious lsh))
- (lsh v c)))
+(define-obsolete-function-alias 'base32-lsh #'ash "2024")
(defun base32-thesaurus (&optional dictionary)
"Make a reverse lookup base32 for DICTIONARY.
@@ -63,8 +57,8 @@ Dictionary should match ‘base32-dictionary’ in format."
;; discard the 0th and 1st bits).
;; then right shift by 3 bits so we have the highest 3
;; bits set to zero (since we want a 5-bit value):
- (setq result (logand #xff (base32-lsh op-char start-bit))
- result (logand #xff (base32-lsh result -3)))
+ (setq result (logand #xff (ash op-char start-bit))
+ result (logand #xff (ash result -3)))
;; now check to see if we need some bits from the next vyte:
(when (> end-bit 7)
(setq end-bit (- end-bit 7) ;; work out the first bit we don't want
@@ -73,7 +67,7 @@ Dictionary should match ‘base32-dictionary’ in format."
;; eg if we wanted 2 bits from byte 0 (rightmost bits 6 and 7)
;; then we want bits 8, 9, and 10, aka bits 0, 1, and 2
;; from byte 1. which means we discard 5 bits by right shifting:
- r2 (logand #xff (base32-lsh op-char (- end-bit 8)))
+ r2 (logand #xff (ash op-char (- end-bit 8)))
;; combine the wanted bits:
result (logior (logand result #x1f) (logand r2 #x1f))))
result))
@@ -90,8 +84,8 @@ Dictionary should match ‘base32-dictionary’ in format."
;; but lefwards by 3 bits because we're writing into the start
;; of an 8-bit slot.
;; mask is five contiguous set bits starting at the same offset
- (setq set-bits (logand #xff (base32-lsh value (- 0 -3 start-bit)))
- mask (logand #xff (base32-lsh #x1f (- 0 -3 start-bit)))
+ (setq set-bits (logand #xff (ash value (- 0 -3 start-bit)))
+ mask (logand #xff (ash #x1f (- 0 -3 start-bit)))
;; turn off the masked bits in the target
op-char (logand op-char (lognot mask))
;; set the target bits to set-bits
@@ -103,7 +97,7 @@ Dictionary should match ‘base32-dictionary’ in format."
;; number of bits from value we have dealt with
discard (- 12 end-bit)
;; discard the 3 dead bits and the dealt with bits
- set-bits (logand #xff (base32-lsh value (+ 3 discard)))
+ set-bits (logand #xff (ash value (+ 3 discard)))
op-char (logand #xff (aref str start-char))
op-char (logand op-char (lognot #xf8))
op-char (logior op-char set-bits))
diff --git a/tests/test-totp.el b/tests/test-totp.el
index 99fd061d28..95e56ca0a1 100644
--- a/tests/test-totp.el
+++ b/tests/test-totp.el
@@ -6,15 +6,19 @@
(eval-and-compile
(require 'loadhist)
(let ((load-path load-path)
- (this-file (or load-file-name
- byte-compile-current-file
- buffer-file-name)))
+ (this-file (if (fboundp 'macroexp-file-name) ;Emacs-28
+ (macroexp-file-name)
+ (or load-file-name
+ byte-compile-current-file
+ buffer-file-name))))
(setq test-totp-source-dir
(expand-file-name (concat (file-name-directory this-file) "/..")))
(message "running tests in %s" test-totp-source-dir)
(add-to-list 'load-path test-totp-source-dir)
(mapc #'require '(totp-auth-hmac totp-auth totp-auth-interop))
- (mapcar (lambda (F) (message "%S loaded from %S" F (feature-file F))) features)))
+ ;; FIXME: Annoying especially when compiling the file.
+ ;; Maybe do it only for those features that are newly loaded?
+ (dolist (F features) (message "%S loaded from %S" F (feature-file F)))))
(defun 0b (byte)
"Byte to 8-character string formatter."
@@ -27,9 +31,9 @@
(defun 0b4 (uint)
"Uint32 to spce-separated binary string formater."
(format "%8s %8s %8s %8s"
- (0b (logand #xff (lsh uint -24)))
- (0b (logand #xff (lsh uint -16)))
- (0b (logand #xff (lsh uint -8)))
+ (0b (logand #xff (ash uint -24)))
+ (0b (logand #xff (ash uint -16)))
+ (0b (logand #xff (ash uint -8)))
(0b (logand #xff uint))))
;; This is from RFC 6238
@@ -192,7 +196,7 @@ earlier ones, which would therefore not be returned by ‘assoc’)."
(while (and ok (< i (length a)))
(setq item-a (nth i a)
item-b (nth i b)
- key-lol (list (mapcar 'car item-a) (mapcar 'car item-b))
+ key-lol (list (mapcar #'car item-a) (mapcar #'car item-b))
i (1+ i)
j nil)
(dolist (key-list key-lol)
@@ -221,7 +225,7 @@ earlier ones, which would therefore not be returned by ‘assoc’)."
(message "%s imported OK" test-file)
(message "%s import FAILED" test-file)
(setq close-enough nil)))
- (mapcar 'car test-totp-import-expected-results))
+ (mapcar #'car test-totp-import-expected-results))
close-enough))
;; (totp-unwrap-otp-blob "otpauth://totp/Test%20QR%20import?secret=deadbeefdeadbeefdeadbeef&digits=7&algorithm=SHA256")
@@ -230,7 +234,9 @@ earlier ones, which would therefore not be returned by ‘assoc’)."
(defun test-totp ()
- (mapc 'test-totp-check-parameters test-totp-data)
+ (mapc #'test-totp-check-parameters test-totp-data)
(test-totp-import))
+;; FIXME: Loading a file should never have such side effects.
+;; Better ask the user to `emacs -l test-totp -f test-totp'.
(test-totp)
diff --git a/totp-auth-interop.el b/totp-auth-interop.el
index bb5a322eb2..afcd836057 100644
--- a/totp-auth-interop.el
+++ b/totp-auth-interop.el
@@ -9,22 +9,23 @@
;;; Code:
(eval-and-compile
(let ((load-path load-path)
- (this-file (or load-file-name
- byte-compile-current-file
- buffer-file-name)))
- (when (not (and (locate-library "base32")
- (locate-library "hmac")))
+ (this-file (if (fboundp 'macroexp-file-name) ;Emacs-28
+ (macroexp-file-name)
+ (or load-file-name
+ byte-compile-current-file
+ buffer-file-name))))
+ (when (not (locate-library "totp-auth"))
(add-to-list 'load-path (file-name-directory this-file)))
- (require 'totp-auth)
- (require 'epa-hook))
- ;; function declared obsolete in 29.x
- ;; do not use #' forms here as that will trigger a different warning
+ (require 'totp-auth)))
+(require 'epa-hook)
+(require 'mailcap)
+
+(defalias 'totp-auth-image-type-from-filename
(if (fboundp 'image-supported-file-p)
- (defalias 'totp-auth-image-type-from-filename
- 'image-supported-file-p)
- (defalias 'totp-auth-image-type-from-filename
- 'image-type-from-file-name))
- (require 'mailcap))
+ #'image-supported-file-p
+ ;; Function declared obsolete in 29.x
+ ;; do not use #' forms here as that will trigger a different warning.
+ 'image-type-from-file-name))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file implements import/export functionality for common OTP exchange
@@ -65,7 +66,7 @@ Returns a cons of (VALUE . BYTES-READ)"
;; only leaves 1 bit.
(setq b10 (aref collected 9)))
(dotimes (i (length collected))
- (setq u64 (+ u64 (base32-lsh (aref collected i) (* i 7)))))
+ (setq u64 (+ u64 (ash (aref collected i) (* i 7)))))
(if (and b10 (not (eq b10 1)))
(cons nil vbyte-count)
(cons u64 vbyte-count))) ))
@@ -78,7 +79,7 @@ Where TYPE should be :varint :i64 :len or :i32"
(let ((decoded (totp-auth-pb-read-varint buf pos)) type field)
(setq field (car decoded)
type (totp-auth-pb-type (logand #x7 field))
- field (base32-lsh field -3))
+ field (ash field -3))
(setcar decoded (cons field type))
decoded))
@@ -274,7 +275,7 @@ The return value will be the raw byte sequence encoding that secret."
(:algo 4 :varint)
(:digits 5 :varint 6)
(:type 6 :varint 2)))
- (mapconcat 'identity (nreverse encoded) "")))
+ (mapconcat #'identity (nreverse encoded) "")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun totp-auth-unwrap-otpauth-migration-url (u)
"Unpack an otpauth-migration url U and extract the parts we care about.
diff --git a/totp-auth.el b/totp-auth.el
index 4d42a2176f..89219cf490 100644
--- a/totp-auth.el
+++ b/totp-auth.el
@@ -40,22 +40,24 @@
;;; Code:
(eval-and-compile
(let ((load-path load-path)
- (this-file (or load-file-name
- byte-compile-current-file
- buffer-file-name)))
+ (this-file (if (fboundp 'macroexp-file-name) ;Emacs-28
+ (macroexp-file-name)
+ (or load-file-name
+ byte-compile-current-file
+ buffer-file-name))))
(when (not (and (locate-library "base32")
- (locate-library "hmac")))
+ (locate-library "totp-auth-hmac")))
(add-to-list 'load-path (file-name-directory this-file)))
(require 'base32)
- (require 'totp-auth-hmac))
- ;; this is to reduce warnings for melpa - it's not actually necessary
- (ignore-errors (require 'notifications))
- (require 'auth-source)
- (require 'secrets)
- (require 'bindat)
- (require 'url-parse)
- (require 'url-util)
- (require 'mailcap))
+ (require 'totp-auth-hmac)))
+;; this is to reduce warnings for melpa - it's not actually necessary
+(require 'notifications nil t)
+(require 'auth-source)
+(require 'secrets)
+(require 'bindat)
+(require 'url-parse)
+(require 'url-util)
+(require 'mailcap)
(defgroup totp-auth nil "Time-based One Time Passwords."
:prefix "totp"
@@ -67,8 +69,7 @@
'("com.github.bilelmoussaoui.Authenticator")
"A list of fallback XDG schemas which are associated with TOTP secrets.
This is used only to read TOTP secrets stored by other applications."
- :type '(repeat string)
- :group 'totp-auth)
+ :type '(repeat string))
(defcustom totp-auth-minimum-ui-grace 3
"The minimum time to expiry a TOTP must have for interactive use.
@@ -78,17 +79,15 @@ and wait until it is valid before giving it to the user.
Noninteractive TOTP code MUST return TOTP values along with their
lifespan (at the time of generation) and their absolute expiry time."
:type 'integer
- :group 'totp)
+ :group 'totp) ;; FIXME: Typo?
(defcustom totp-auth-max-tokens 1024
"The maximum number of tokens totp will try to fetch and process."
- :group 'totp-auth
:type 'integer)
(defcustom totp-auth-file-import-command '("zbarimg" "-q" "@file@")
"The command and parameters used to parse a QR code image.
@file@ is a placeholder for the file name."
- :group 'totp-auth
:type '(repeat string))
(defcustom totp-auth-file-export-command
@@ -97,7 +96,6 @@ lifespan (at the time of generation) and their absolute expiry time."
@file@ is a placeholder for the target filename.
@type@ is a placeholder for a supported output type and will be determined by
‘totp-auth-file-export-type-map’."
- :group 'totp-auth
:type '(repeat string))
(defcustom totp-auth-file-export-type-map '((png "-t" "PNG")
@@ -107,7 +105,6 @@ lifespan (at the time of generation) and their absolute expiry time."
Defaults to a map usable by qrencode (see ‘totp-auth-file-export-command’).
May also be a function, which should take one argument (the image type symbol)
and return a list of arguments to pass to the QR encoder."
- :group 'totp-auth
:type '(choice (alist :tag "Fixed type map"
:key-type symbol
:value-type (repeat string))
@@ -117,7 +114,6 @@ and return a list of arguments to pass to the QR encoder."
"Export byte size limit for otpauth-migration URLs.
The total size of any generated otpauth-migration scheme URL
will not exceed this size."
- :group 'totp-auth
:type 'integer)
(defcustom totp-auth-secrets-create-item-workaround t
@@ -126,7 +122,6 @@ If this option is on (the default) then we attempt
delete duplicated secrets when we save a secret via this API.\n
If it is off then you are likely to end up with multiple copies of
a secret if you ever re-import it."
- :group 'totp-auth
:type 'boolean)
(defcustom totp-auth-auto-copy-password '(PRIMARY CLIPBOARD)
@@ -135,7 +130,6 @@ The behaviour is implemented by ‘totp-auth-update-paste-buffers’ as follows:
- When the token is generated, it is placed in the selected copy areas
- If the copy area still contains the previous value when the token
expires and is regenerated it is replaced with the new value."
- :group 'totp-auth
:type '(choice
(const :tag "Off" nil)
(set :tag "Choose Copy Method(s)"
@@ -147,7 +141,6 @@ The behaviour is implemented by ‘totp-auth-update-paste-buffers’ as follows:
"Choose the TOTP token display mechanism.
A Custom function it must accept a ‘totp-auth-generate-otp’ SECRET
and optional LABEL as its first two arguments."
- :group 'totp-auth
:type '(choice
(const :tag "Notification if possible, otherwise TOTP buffer" nil)
(const :tag "Desktop notification"
@@ -160,7 +153,6 @@ and optional LABEL as its first two arguments."
If unset (the default) this will be initialised to a list
consisting of the contents of ‘auth-sources’ with the freedesktop
secrets service login session prepended to it, if it is available."
- :group 'totp-auth
:type `(repeat :tag "Authentication Sources"
(choice
(const :tag "TOTP Secrets Collection" "secrets:TOTP")
@@ -545,11 +537,13 @@ a structure conforming to ‘totp-auth-unwrap-otp-blob’."
(defun totp-auth-hmac-message (counter)
"Take COUNTER (an integer) and return its 8-byte big-endian representation."
- (let ((hi-4 (logand #xffffffff (base32-lsh counter -32)))
- (lo-4 (logand #xffffffff counter)))
- (bindat-pack '((:hi4 u32) (:lo4 u32))
- `((:hi4 . ,hi-4)
- (:lo4 . ,lo-4)))))
+ (if (eval-when-compile (fboundp 'bindat-type)) ;Emacs-28
+ (bindat-pack (bindat-type uint 64) counter)
+ (let ((hi-4 (logand #xffffffff (ash counter -32)))
+ (lo-4 (logand #xffffffff counter)))
+ (bindat-pack '((:hi4 u32) (:lo4 u32))
+ `((:hi4 . ,hi-4)
+ (:lo4 . ,lo-4))))))
(defun totp-auth-truncate-hash (hmac-hash)
"Given a 20 byte string or vector HMAC-HASH:
@@ -562,9 +556,9 @@ with the highest bit forced to 0 (ie a 31 bit integer)."
b1 (logand #xff (aref hmac-hash (+ 1 offset)))
b2 (logand #xff (aref hmac-hash (+ 2 offset)))
b3 (logand #xff (aref hmac-hash (+ 3 offset))))
- (logior (base32-lsh b0 24)
- (base32-lsh b1 16)
- (base32-lsh b2 8) b3)))
+ (logior (ash b0 24)
+ (ash b1 16)
+ (ash b2 8) b3)))
(defvar totp-auth-override-time nil
"This value is used instead of the seconds since epoch if it is set.")
@@ -671,21 +665,15 @@ OTP and TOKEN are used internally and need not be passed."
(defun totp-auth-display-token-buffer (secret &optional label)
"Display buffer with the current token for SECRET with label LABEL."
- (let (ui-buffer)
- (or label
- (setq label (totp-auth-secret-make-label secret)))
- (setq ui-buffer (get-buffer-create (format "*TOTP %s*" label)))
+ (or label
+ (setq label (totp-auth-secret-make-label secret)))
+ (let ((ui-buffer (get-buffer-create (format "*TOTP %s*" label))))
(set-buffer ui-buffer)
- (mapc 'make-local-variable '(totp-auth-display-ttl
- totp-auth-display-label
- totp-auth-display-expiry
- totp-auth-display-oldpwd
- totp-auth-display-secret))
- (setq totp-auth-display-label label
- totp-auth-display-secret (cdr (assq :secret secret))
- totp-auth-display-oldpwd nil
- totp-auth-display-ttl nil
- totp-auth-display-expiry nil)
+ (setq-local totp-auth-display-label label)
+ (setq-local totp-auth-display-secret (cdr (assq :secret secret)))
+ (setq-local totp-auth-display-oldpwd nil)
+ (setq-local totp-auth-display-ttl nil)
+ (setq-local totp-auth-display-expiry nil)
(pop-to-buffer ui-buffer)
(run-with-timer 0 1 #'totp-auth-update-token-display ui-buffer)))
@@ -700,6 +688,8 @@ SECRET is a suitable argument for ‘totp-auth-generate-otp’.
then close the notification.
\nIf the current token is about to expire (see ‘totp-auth-minimum-ui-grace’)
then wait until it is time to renew the token before doing anything."
+ ;; Presumably, if we're here, `notifications' has been loaded.
+ (declare-function notifications-close-notification "ext:notifications")
(when (equal "copy" key)
(let (otp ttl token)
(setq otp (totp-auth-generate-otp secret)
@@ -718,6 +708,8 @@ ID is the freedesktop notifications id (an unsigned 32 but integer).
LABEL is the descriptive label of the OTP secret.
SECRET is a suitable secret usable by ‘totp-auth-generate-otp’.
Usually called from a timer set by ‘totp-auth-display-token-notification’."
+ ;; Presumably, if we're here, `notifications' has been loaded.
+ (declare-function notifications-notify "ext:notifications")
(let (otp text ttl)
(setq otp (totp-auth-generate-otp secret)
ttl (nth 1 otp)
@@ -770,8 +762,8 @@ LABEL will be initialised by ‘totp-auth-secret-make-label’ if unset."
(setq label (totp-auth-secret-make-label secret)))
(if totp-auth-display-token-method
(funcall totp-auth-display-token-method secret label)
- (if (ignore-errors (and (require 'notifications)
- (notifications-get-server-information)))
+ (if (and (fboundp 'notifications-get-server-information)
+ (notifications-get-server-information))
(totp-auth-display-token-notification secret label)
(totp-auth-display-token-buffer secret label))))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.