commit 879ac36898f0fb5ecec8bd8377a64c0f9a1d3ac8
Author: Hugo Thunnissen <devel@hugot.nl>
Date:   Wed May 31 19:11:03 2023 +0200

    Initial Commit: Implement random number generator

diff --git a/crypto-rand.el b/crypto-rand.el
new file mode 100644
index 0000000..0665d5f
--- /dev/null
+++ b/crypto-rand.el
@@ -0,0 +1,146 @@
+;; crypto-rand.el --- Cryptographic random values for emacs lisp  -*- lexical-binding: t; -*-
+
+(require 'bindat)
+(require 'seq)
+(require 'cl-lib)
+
+(defconst crypto-rand-uint64-bindat-spec
+  (bindat-type
+    (int uint 64))
+  "Bindat spec to read a uint64.")
+
+(defvar crypto-rand-strategy "openssl"
+  "Currently active cryptographic random number generation source.")
+
+(defvar crypto-rand-strategies '(("openssl" . crypto-rand-openssl-new)
+                                 ("kernel" . crypto-rand-kernel-new))
+  "List of available cryptographic random number generation sources.")
+
+(defvar crypto-rand nil
+  "The object urrently returned from `crypto-get-rand'")
+
+(defun crypto-make-rand-by-strategy (name)
+  (let ((strategy
+         (alist-get name crypto-rand-strategies nil nil #'string=)))
+    (unless strategy
+      (error "Crypto rand strategy \"%s\" not found" name))
+  (funcall strategy)))
+
+(defun crypto-set-rand-strategy (strategy)
+  "Set the strategy returned by `crypto-get-rand' to STRATEGY.
+
+For available strategies, see `crypto-rand-strategies'"
+  (interactive (list (completing-read "Strategy:" crypto-rand-strategies)))
+  (setq crypto-rand-strategy strategy)
+  (setq crypto-rand (crypto-make-rand-by-strategy strategy)))
+
+(defsubst crypto-get-rand ()
+  "Get an object that implements the preferred random strategy.
+
+See `crypto-set-rand-strategy' for preferred strategy
+congiguration."
+  (unless crypto-rand
+    (setq crypto-rand
+          (crypto-make-rand-by-strategy crypto-rand-strategy)))
+
+  crypto-rand)
+
+(cl-defstruct (crypto-rand-kernel (:constructor crypto-rand-kernel-new))
+  "crypto-rand-kernel reads random bytes from a kernel-provided
+random number device like linux' /dev/urandom. As of right now
+there are no facilities for emacs to read from such a device
+directly, so the command line utility `head` is required to be
+present on the host system for this strategy to work."
+  (rand-device "/dev/urandom"
+               :type string
+               :documentation "Path to random number device to read from."))
+
+(cl-defmethod crypto-rand-read ((rand crypto-rand-kernel) (buf array))
+  (crypto-rand--read-bytes buf (crypto-rand-kernel-rand-device rand)))
+
+(cl-defstruct (crypto-rand-openssl (:constructor crypto-rand-openssl-new))
+  "crypto-rand-openssl reads random bytes from the openssl command line utility."
+  (executable "openssl"
+              :type string
+              :documentation "Executable name or path to run openssl with"))
+
+(cl-defmethod crypto-rand-read ((rand crypto-rand-openssl) (buf array))
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (call-process "openssl" nil t nil "rand" (number-to-string (length buf)))
+    (crypto-rand--read-bytes buf (current-buffer))))
+
+(cl-defmethod crypto-rand-int (rand &optional (max integer))
+  (unless max (setq max most-positive-fixnum))
+  ;; bitsize is the amount of bits required to store an integer of size `max`.
+  (let* ((bitsize (ceiling (log max 2)))
+         ;; Bits to be read that do not make up a full uint64
+         (rest-bitsize (mod bitsize 64))
+         ;; Full uint64s to be read
+         (ints (/ (- bitsize rest-bitsize) 64))
+         ;; Bytes to be read to become part of a/multiple full uint64
+         (bytes)
+         ;; Bytes to be read that do not make up a full uint64
+         (rest-bytes)
+         ;; Bits to be read that do not make up a full byte
+         (rest-bits)
+         (buf))
+
+    ;; A uint64 is 8 bytes
+    (setq bytes (floor (* ints 8)))
+
+    ;; Add more bytes for any bits that do not require a full 64bit uint.
+    (when rest-bitsize
+      (setq rest-bits (mod rest-bitsize 8))
+      (setq rest-bytes (/ (- rest-bitsize rest-bits) 8))
+      (when (> rest-bits 0)
+        (setq rest-bytes (+ rest-bytes 1))))
+
+    (setq bytes (+ bytes rest-bytes))
+
+    (setq buf (crypto-rand-read rand (make-vector bytes nil)))
+
+    (let ((int 0)
+          (ints-read 0))
+      (while (> ints ints-read)
+        (let ((unpacked (bindat-unpack
+                         crypto-rand-uint64-bindat-spec buf (* ints-read 8))))
+          (setq int (+ int (bindat-get-field unpacked 'int)))
+          (setq ints-read (+ ints-read 1))))
+
+      ;; Read remaining bytes that don't make up a full uint64
+      (when (> rest-bytes 0)
+        (let* ((rest-buf (vconcat (make-vector (- 8 rest-bytes) 0)
+                                  (seq-subseq buf (* 8 ints-read))))
+               (unpacked (bindat-unpack crypto-rand-uint64-bindat-spec rest-buf)))
+          (setq int (+ int (bindat-get-field unpacked 'int)))))
+
+
+      ;; Use floor to explicitly make number an int.
+      (setq int (floor int))
+
+      ;; Drop all bits that exceed bitsize, to make sure that `max` is never
+      ;; violated.
+      (while (> int max)
+        (setq int (ash int (floor (- rest-bits 8)))))
+
+      ;; Return
+      int)))
+
+(cl-defmethod crypto-rand--read-bytes ((buf array) (buffer buffer))
+  (with-current-buffer buffer
+    (let ((len (length buf))
+          (pos 0))
+      (while (> len pos)
+        (aset buf pos (get-byte (+ 1 pos)))
+        (setq pos (+ 1 pos))))
+    buf))
+
+(cl-defmethod crypto-rand--read-bytes ((buf array) (file string))
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (call-process "head" nil t nil "-c" (number-to-string (length buf))
+                  file)
+    (crypto-rand--read-bytes buf (current-buffer))))
+
+(provide 'crypto-rand)