;; 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)