Skip to content

Latest commit

 

History

History
874 lines (763 loc) · 38.8 KB

reval.org

File metadata and controls

874 lines (763 loc) · 38.8 KB

Reval: Evaluate remote elisp code

Introduction

Remote eval. Ephemeral code reuse. Somewhere between load eval, and securl then load. More auditable and stable curl pipe bash.

There are some significant drawbacks, such as remote files not being able to resolve xrefs from remote files. It is also not clear whether to use reval and then save the buffer to disk and the load or whether it makes more sense to use reval to get securl and then use securl to get the sources. Unless securl is going to be used for something else it seems more practical to reval-into-reload, or even just reload to get the cache benefit in addition to being able to resolve xrefs.

At the moment the serialization of the whole file is used rather than one of the normalized prp variants. This might be added in the future, but the objective of reval is to be small enough that it will fit in the remaining space in the orgstrap elv it probably won’t happen.

See Library Headers for details related to reval-update.

reval-update functionality works by leveraging the builtin functionality of package-buffer-info. To create a file that can be updated automatically by reval, use the URL: header to point to a url that resolves to the Latest-Version of the while it would be nice to use a Latest-Version: header directly using URL: simplifies the implementation immensely. Note that pacakge-buffer-info only returns the first occurrence of URL: or Homepage: so the Latest-Version url must come first. Other urls can be listed later but will not be included in the parse.

Sadly this is not as simple as one might think. Listing the Latest-Version url is sufficient to detect that there has been a change, but then there is the multipath issue of how to obtain a static url to the exact (new) version of the resource. In addition to the Latest-Version url you need some url that either redirects to the static latest. For example the github latest releases url https://github.com/tgbugs/orgstrap/releases/latest has the desired redirection behavior. The equivalent for branch refs is https://api.github.com/repos/tgbugs/orgstrap/git/refs/heads/master. However you have to deal with the json response there which is the multipath issue discussed before.

Depending on how far things like git-share go, mirrors could be listed Mirror-List: or something? If we do that then Latest-Version can be used this is useful only after a user has been able to resolve a copy after which a local mirrors list could be created.

file-exists-pchecksum-matchmultisignalelisp?buffer
tttwarntevaled
nilttwarntkill
tniltwarntfailed
nilniltwarntkill
ttnilerrortevaled
niltnilerrortkill
tnilnilerrortfailed
nilnilnilerrortkill
tttwarnnilfailed
nilttwarnnilkill
tniltwarnnilfailed
nilniltwarnnilkill
ttnilerrornilfailed
niltnilerrornilkill
tnilnilerrornilfailed
nilnilnilerrornilkill

TODO need a way to ensure that reval maximal can run itself again on same inputs without having to invoke again, maybe a dynamic variable in minimal?

Notes

The general approach here is to provide a very lightweight way to get the functionality needed for an orgstrap block into that block in a way that allows for some level of code reuse. Thus reval should be doing as little work as possible to get to a point where a real package manager can take over (e.g. it is probably better to reval in a file that can install quelpa something like that for unpublished packages, on the other hand, the simplicity of a reval expression means that there are fewer things that can go wrong). The minimal reval implementation pretty much has to be included in the orgstrap block. This is unfortunate, but since I do have machinery in orgstrap to clone blocks, it seems reasonable to have a reval minimal block that can be used with orgstrap clone and that should be reasonably easy to keep up to date, though hopefully also the need to do that will be small since it should be fairly stable.

All of this to say that reval is intentionally minimal, and should be used compositionally in expressions like the following.

(unless (featurep 'file) (reval 'sha256 ? "https://example.org/file.el"))

Issues

Diff when updating

It is hard to audit a whole file every single time it is updated. When update is called and there is an existing immutable url or a cached version of the hash the new version should be diffed against the existing version and the changes should be displayed for easier review.

secure-hash-algorithms is only useful for emacs >= 26

reval.el

tangles

;;; reval.el --- Remote elisp eval. -*- lexical-binding: t -*-

;; Author: Tom Gillespie
;; Homepage: https://github.com/tgbugs/orgstrap
;; Version: 9999
;; Package-Requires: ((emacs "24.4"))
;; Is-Version-Of: https://raw.githubusercontent.com/tgbugs/orgstrap/master/reval.el
;; Reval-Get-Immutable: reval--reval-update

;;;; License and Commentary

;; License:
;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;; reval.el implements eval of remote elisp code. It implements
;; somewhat secure local evaluation of remote elisp by only running
;; `eval-buffer' when the checksum of the remote matches the checksum
;; embedded in the reval expression. If the checksum passes the remote
;; file is cached to avoid future calls to the network.
;;
;; To make it easier to maintain files using remote elisp code, reval
;; provides functionality to check for updates, and streamlines the
;; process for auditing new files and changes via `reval-sync'.

;;; Code:

<<reval-impl>>

(defun reval--reval-update ()
  "Get the immutable url for the current remote version of this file."
  (reval-get-imm-github "tgbugs" "orgstrap" "reval.el"))

(provide 'reval)

;;; reval.el ends here

code

minimal

This will be a common starter block for orgstrap.
(unless (featurep 'reval)
  (defvar reval-cache-directory (concat user-emacs-directory "reval/cache/"))
  <<reval-minimal>>
  (defalias 'reval #'reval-minimal)
  (reval ? ? "~/git/orgstrap/reval.el"))

A note on how reval-minimal is different from regular reval.

missing debug features and support for alternate sources the rationale is that 99% of the time this minimal reval is going to be used only once to open and eval a file that will also include the full version, if that first reval fails then something is wrong enough that users that don’t have the full version installed already are unlikely to be able to debug the issue on their own

BIG NOTE ON CACHING reval-minimal by itself leaks information when it is used. Therefore the FIRST AND LAST CALL to reval-minimal should be to retrieve and evaluate an elisp file that contains version of reval that caches retrieved files so that network traffic cannot be used to reveal when someone is running a file that uses reval.

As much as we want to keep this simple, reval-minimal must implement caching so that reval.el itself can be cached and make use of all the usual machinery for updates etc. Thus we trade off a bit of complexity in the implementation of reval-minimal for massively reduced complexity everywhere else.

(defun reval-minimal (cypher checksum path-or-url &rest alternates)
  "Simplified and compact implementation of reval."
  (let* (done (o url-handler-mode) (csn (symbol-name checksum))
         (cache-path (concat reval-cache-directory (substring csn 0 2) "/" csn
                             "-" (file-name-nondirectory path-or-url))))
    (url-handler-mode)
    (unwind-protect
        (cl-loop for path-or-url in (cons cache-path (cons path-or-url alternates))
                 do (when (file-exists-p path-or-url)
                      (let* ((buffer (find-file-noselect path-or-url))
                             (buffer-checksum (intern (secure-hash cypher buffer))))
                        (if (eq buffer-checksum checksum)
                            (progn
                              (unless (string= path-or-url cache-path)
                                (let ((parent-path (file-name-directory cache-path))
                                      make-backup-files)
                                  (unless (file-directory-p parent-path)
                                    (make-directory parent-path t))
                                  (with-current-buffer buffer
                                    (write-file cache-path))))
                              (eval-buffer buffer)
                              (setq done t))
                          (kill-buffer buffer) ; kill so cannot accidentally evaled
                          (error "reval: checksum mismatch! %s" path-or-url))))
                 until done)
      (unless o
        (url-handler-mode 0)))))

maximal

(require 'cl-lib)

(defgroup reval nil
  "Minimal remote evaluation of elisp code."
  :tag "reval"
  :group 'applications)

(defcustom reval-default-cypher 'sha256
  "Default cypher to use to fill in a hole in `reval'."
  :type 'symbol
  :options (if (fboundp #'secure-hash-algorithms) (secure-hash-algorithms) '(sha256))
  :group 'reval)

(defvar reval-cache-directory (concat user-emacs-directory "reval/cache/")
  "The directory where retrieved .el files are saved.")

(defvar reval-failed-buffer-list nil "List of failed reval buffers.") ; XXX FIXME this is dumb
;; use the buffer to track the state using `reval-fail' because then
;; the process composes with the other tools we have for interacting
;; with revaled files and caches etc.

(defvar reval-evaled-buffer-list nil "List of evaled reval buffers.")

(defvar-local reval--pending-updates nil
  "Internal variable use to coordinate updates for a single buffer.")

(defmacro with-url-handler-mode (&rest body)
  "Run BODY with `url-handler-mode' enabled."
  (declare (indent defun))
  `(let ((uhm url-handler-mode))
     (unwind-protect
         (progn
           (url-handler-mode)
           ,@body)
       (unless uhm
         (url-handler-mode 0)))))

(defun reval-id->buffer (path-or-url)
  "Given a PATH-OR-URL return a buffer of its contents."
  ;; We explicitly do not catch errors here since they need to
  ;; be caught by the human in the loop later.
  (with-url-handler-mode
    (find-file-noselect path-or-url)))

(defun reval-resum-review (cypher buffer &optional review)
  "Return checksum under CYPHER for BUFFER.
If REVIEW is non-nil then switch to BUFFER and prompt asking if audit
is ok before continuing."
  ;; we don't need to check or review alternates here because they
  ;; must all be identical
  (let (enable-local-eval)
    (save-excursion
      (save-window-excursion
        (with-current-buffer buffer
          (unless (file-exists-p (buffer-file-name))
            ;; NOTE url-handler-mode must be set in the calling context
            ;; this case should not happen, only extant files should make it here
            (error "reval-resum: file does not exist! %s" (buffer-file-name)))
          (when review
            (switch-to-buffer (current-buffer))
            ;; FIXME `yes-or-no-p' still blocks the command loop in >= 27 emacsclient
            (unless (yes-or-no-p "Audit of file ok? ") ; not using `y-or-n-p' since it is too easy
              (error "Audit failed.  Checksum will not be calculated for %s"
                     (buffer-file-name (current-buffer)))))

          ;; need to ensure that file is actually elisp
          ;; note that in some cases read can succeed
          ;; even when a file is not elisp e.g. an html
          ;; file can sometimes read without error but
          ;; will fail on eval

          ;; elisp check by major mode
          (unless (eq major-mode 'emacs-lisp-mode)
            (error "Not an Emacs Lisp file!"))

          ;; elisp check by read
          (condition-case nil
              (read (concat "(progn\n"
                            (buffer-substring-no-properties (point-min) (point-max))
                            "\n)"))
            (error (error "Not an Emacs Lisp file!")))

          ;; return the checksum
          (intern (secure-hash cypher (current-buffer))))))))

(defun reval-resum-minimal (cypher buffer)
  "Checksum of BUFFER under CYPHER." ; minimal for maximal porability
  ;; not used since the expression takes up less space
  (intern (secure-hash cypher buffer)))

(defalias 'reval-resum #'reval-resum-review)

(defvar reval--make-audit t "Dynamic variable to control audit during `reval--make'.")
;; the control of audit behavior is intentionally excluded from the
;; arguments of `reval--make' so that top level calls must audit
(defun reval--make (cypher path-or-url)
  "Make a `reval' expression from CYPHER and PATH-OR-URL.
This should not be used directly at the top level see docs for `reval'
for a better workflow."
  (unless reval--make-audit
    (warn "`reval--make' not auditing %S" path-or-url))
  (let ((checksum (reval-resum-review cypher (reval-id->buffer path-or-url) reval--make-audit)))
    `(reval ',cypher ',checksum ,path-or-url)))

(defun reval-audit (&optional universal-argument)
  "Audit the reval under the cursor." ; FIXME this needs a LOT of work
  (interactive)
  (cl-multiple-value-bind (cypher checksum path-or-url _alternates _b _e) ; FIXME probably loop here
      (reval--form-at-point)
    (let* ((buffer (with-url-handler-mode
                     (find-file-noselect path-or-url)))
           (buffer-checksum (reval-resum cypher buffer t)))
      (eq buffer-checksum checksum))))

(defun reval--add-buffer-to-list (buffer buffer-list-name)
  "Add BUFFER to list at BUFFER-LIST-NAME."
  (with-current-buffer buffer ; FIXME do this in both cases but change which list
    (push buffer (symbol-value buffer-list-name))
    ;; push first since it is better to have a dead buffer linger in a list
    ;; than it is to have an error happen during execution of `kill-buffer-hook'
    (let ((buffer-list-name buffer-list-name))
      (add-hook 'kill-buffer-hook
                (lambda ()
                  ;; read the manual for sets and lists to see why we have to
                  ;; setq here ... essentially if our element is found in the
                  ;; car of the list then the underlying list is not modified
                  ;; and the cdr of the list is returned, therefore if you have
                  ;; a list of all zeros and try to delete zero from it the list
                  ;; will remain unchanged unless you also setq the name to the
                  ;; (now) cdr value
                  (set buffer-list-name
                       (delete (current-buffer) (symbol-value buffer-list-name))))
                nil t))))

(defun reval-cache-path (checksum &optional basename)
  "Return the path to the local cache for a given CHECKSUM.
If BASENAME is provided a wildcard is not used.  This is mostly
to make the calls more human readable for debugging but also
makes it easier to catch cases where the wrong checksum was passed."
  (let* ((name (symbol-name checksum))
         (subdir (substring name 0 2))
         (cache-path (concat reval-cache-directory subdir "/" name "-" (or basename "*"))))
    (if basename
        cache-path
      (let ((expanded (file-expand-wildcards cache-path)))
        (if expanded
            ;; I guess a strict rename could hit a dupe but hitting a
            ;; hash collision here would be ... astronimical odds
            (car expanded)
          nil)))))

(defun reval--write-cache (buffer cache-path)
  "Write BUFFER to CACHE-PATH.  Create the parent if it doesn not exist."
  (let ((parent-path (file-name-directory cache-path))
        make-backup-files)
    (unless (file-directory-p parent-path)
      (make-directory parent-path t))
    (with-current-buffer buffer
      (write-file cache-path))))

(defun reval-find-cache (&optional universal-argument)
  "Jump to the cache for a given reval call.
At the moment UNIVERSAL-ARGUMENT is a placeholder."
  (interactive)
  (cl-multiple-value-bind (_cypher checksum path-or-url _alternates _b _e)
      (reval--form-at-point)
    (let ((cache-path (reval-cache-path checksum)))
      (if (file-exists-p cache-path)
          (let ((buffer (find-file-noselect cache-path)))
            (with-current-buffer buffer (emacs-lisp-mode))
            (pop-to-buffer-same-window buffer))
        (error "No cache for %s" path-or-url)))))

(defun reval-fail (&rest args)
  "Embed in buffer if audit fails on ARGS so that there is a record."
  (error "reval audit failed for: %S" args))

(defun reval (cypher checksum path-or-url &rest alternates)
  "Open PATH-OR-URL, match CHECKSUM under CYPHER, then eval.
If an error is encountered try ALTERNATES in order.

The simplest way to populate a `reval' expression starting from just
PATH-OR-URL is to write out expression with CYPHER and CHECKSUM as a
nonsense values.  For example (reval ? ? \"path/to/file.el\").  Then
run \\[reval-update-simple] (M-x `reval-update-simple') to populate
CYPHER and CHECKSUM."
  (reval--get-buffer cypher checksum path-or-url alternates #'eval-buffer))

(defun reval--get-buffer (cypher checksum path-or-url &optional alternates do-with-buffer)
  "generic implementation that gets a buffer and can run a function
DO-WITH-BUFFER in that buffer to enforce invariants, eval the buffer, etc.
Note that this function ALWAYS returns the buffer, so DO-WITH-BUFFER should only
be used to trigger a failure mode before the buffer is retruned, not used to get
a return value from the buffer."
  (let (found-buffer (cache-path (reval-cache-path checksum (file-name-nondirectory path-or-url))))
    (with-url-handler-mode
      (cl-loop for path-or-url in (cons cache-path (cons path-or-url alternates))
               do (if (file-exists-p path-or-url)
                      (let* ((buffer (reval-id->buffer path-or-url))
                             (_ (when (string= path-or-url cache-path)
                                  (with-current-buffer buffer (emacs-lisp-mode))))
                             ;; FIXME this is still not right ... can error due to not elisp
                             (buffer-checksum (reval-resum cypher buffer)))
                        (if (eq buffer-checksum checksum)
                            (let ((buffer
                                   (if (string= path-or-url cache-path)
                                       buffer
                                     ;; save to cache and switch buffer before eval for xrefs
                                     (reval--write-cache buffer cache-path)
                                     (find-file-noselect cache-path))))
                              (when do-with-buffer
                                (with-current-buffer buffer
                                  (funcall do-with-buffer)))
                              (setq found-buffer buffer))
                          (reval--add-buffer-to-list buffer 'reval-failed-buffer-list)
                          (funcall (if alternates #'warn #'error)
                                   ;; if alternates warn to prevent an early failure
                                   ;; from blocking later potential successes otherwise
                                   ;; signal an error
                                   "reval: checksum mismatch! %s" path-or-url)))
                    (warn "reval: file does not exist! %s" path-or-url))
               until found-buffer))
    (unless found-buffer
      (error "reval: all paths failed!"))
    found-buffer))

(defun reval-view-failed ()
  "View top of failed reval buffer stack and kill or keep."
  (interactive)
  (when reval-failed-buffer-list
    (save-window-excursion
      (with-current-buffer (car reval-failed-buffer-list)
        (switch-to-buffer (current-buffer))
        (when (y-or-n-p "Kill buffer? ")
          (kill-buffer))))))

;;; machinery to get the latest immutable url for a revaled file

(require 'lisp-mnt)

(defvar url-http-end-of-headers)
(defun reval-url->json (url)  ; see utils.el
  "Given a URL string return json as a hash table."
  (json-parse-string
   (with-current-buffer (url-retrieve-synchronously url)
     (buffer-substring url-http-end-of-headers (point-max)))))

(defun reval--get-new-immutable-url ()
  "Get the immutable url for the current buffer."
  (let ((get-imm-name (reval-header-get-immutable)))
    (if get-imm-name
        (let ((get-imm (intern get-imm-name)))
          (if (fboundp get-imm)
              (funcall get-imm)
            (warn "Function %s from Reval-Get-Immutable not found in %s" get-imm-name (buffer-file-name))
            nil))
      (warn "Reval-Get-Immutable: header not found in %s" (buffer-file-name))
      nil)))

(defun reval-get-imm-github (group repo path &optional branch)
  "Get the immutable url for PATH on BRANCH in a github remote for REPO at GROUP."
  (let* ((branch (or branch "master"))
         (branch-url
          (format "https://api.github.com/repos/%s/%s/git/refs/heads/%s"
                  group repo branch))
         (branch-sha (gethash "sha" (gethash "object" (reval-url->json branch-url))))
         (url
          (format "https://api.github.com/repos/%s/%s/commits?path=%s&page=1&per_page=1&sha=%s"
                  group repo path branch-sha))
         (result (reval-url->json url))
         (sha (gethash "sha" (elt (reval-url->json url) 0))))
    (format "https://raw.githubusercontent.com/%s/%s/%s/%s" group repo sha path)))

(defun reval-header-is-version-of (&optional file)
  "Return the Is-Version-Of: header for FILE or current buffer."
  ;; this was originally called Latest-Version but matching the
  ;; datacite relationships seems to make more sense here esp.
  ;; since this is literally the example from the documentation
  (lm-with-file file
    (lm-header "is-version-of")))

(defun reval-header-get-immutable (&optional file)
  "Return the Reval-Get-Immutable: header for FILE or current buffer.

The value of this header should name a function in the current
file that returns an immutable name that points to the current
remote version of the the current file.

The implementation of the function may assume that the reval
package is present on the system."
  ;; there will always have to be a function because even if the
  ;; remote does all the work for us we will still have to ask the
  ;; remote to actually do the dereference operation, since we can't
  ;; gurantee that all remotes even have endpoints that behave this
  ;; functionality we can't implement this once in reval, so each
  ;; file implements this pattern itself, or worst case, the
  ;; update function can be supplied at update time if there is a
  ;; useful remote file that doesn't know that it is being revaled
  (lm-with-file file
    (lm-header "reval-get-immutable")))

;;; internals for `reval-sync' workflow

(defun reval--audit-change (buffer-old url-new buffer-source cypher begin)
  "Audit the changes made in URL-NEW relative to BUFFER-OLD.
If the audit passes, a checksum is calculated under CYPHER for
the new buffer, and a new reval form is inserted into BUFFER-SOURCE
starting at position BEGIN which corresponds to the beginning of the
reval form that was the source for BUFFER-OLD."
  (let* ((buffer-new (with-url-handler-mode (find-file-noselect url-new)))
         (buffer-review (reval--diff buffer-old buffer-new)))
    ;; audit
    ;; TODO see if we need something more than this, for small diffs it seems
    ;; to work fairly well, it captures the core functionality needed, and
    ;; if users are curious about the changes, they can accept or reject,
    ;;; and then look up the changes in git without complicating this workflow
    (let*
        ((ok
          (save-excursion
            (save-window-excursion
              (with-current-buffer buffer-review
                (display-buffer buffer-review)
                ;; not using `y-or-n-p' since it is too easy
                (let ((yes (yes-or-no-p "Audit of changes ok? ")))
                  (unless yes
                    (warn "Audit failed.  Checksum will not be calculated for %s"
                          (buffer-file-name buffer-new)))
                  yes)))))
         (checksum-new (if (not ok) 'audit-failed (intern (secure-hash cypher buffer-new))))
         (to-insert
          (prin1-to-string
           `(,(if (not ok) 'reval-fail 'reval) ',cypher ',checksum-new ,url-new 'NEW))))
      (with-current-buffer buffer-source
        (save-excursion
          (goto-char begin)
          (insert to-insert "\n")))
      ok)))

(defun reval--diff (buffer-old buffer-new)
  "Construct a buffer that is the diff between BUFFER-OLD and BUFFER-NEW."
  ;;(ediff-buffers buffer-old buffer-new)
  ;; lol no-select noselect inconsistency
  (diff-no-select buffer-old buffer-new nil nil))

(defun reval--get-changed ()
  "Collect thunks to update the reval expressions in the current buffer that have new versions."
  (save-excursion
    (goto-char (point-min))
    (let (out (buffer-source (current-buffer)))
      (while (re-search-forward "(reval[[:space:]]" nil t)
        (cl-multiple-value-bind (cypher checksum path-or-url-raw alternates begin)
            (reval--form-at-point)
          (let* ((path-or-url
                  (or (and (stringp path-or-url-raw) path-or-url-raw) ; XXX why does stringp return t !??!?
                      ;; FIXME DANGERZONE !? (yes very)
                      (eval path-or-url-raw)))
                 (buffer
                  (reval--get-buffer
                   cypher checksum path-or-url alternates
                   #'reval--eval-buffer-when-not-fboundp))
                 (url-new (with-current-buffer buffer (reval--get-new-immutable-url))))
            (unless (string= url-new path-or-url)
              ;; FIXME TODO local urls should check for version control so that
              ;; checksums can be updated before pushing, but that is more involved
              (setq
               out
               (cons
                (list
                 (reval--make-diff-thunk buffer url-new buffer-source cypher begin)
                 alternates)
                out)))))
        (forward-sexp))
      out)))

(defun reval--eval-buffer-when-not-fboundp ()
  "Run inside `reval--get-buffer' to avoid revaling the buffer if
the imm url function if it is already fboundp"
  (let ((get-imm-name (reval-header-get-immutable)))
    (if get-imm-name
        (let ((get-imm (intern get-imm-name)))
          (unless (fboundp get-imm)
            (eval-buffer))))))

(defun reval--make-diff-thunk (buffer-old url-new buffer-source cypher begin)
  "Create the thunk that kicks off the update workflow."
  (lambda () (reval--audit-change buffer-old url-new buffer-source cypher begin)))

(defun reval--dquote-symbolp (thing)
  "Match pattern ''THING.
Useful when dealing with quoted symbols in the outpub or a `read'.
For example elt 2 of '(reval 'sha256 ? \"file.el\")."
  (and (consp thing)
       (eq (car thing) 'quote)
       (consp (cdr thing))
       (symbolp (cadr thing))))

(defun reval--form-at-point ()
  "Extract the components of the reval expression at the current point."
  (save-excursion
    (re-search-forward " ")
    (re-search-backward "(reval[[:space:]]")
    (let ((begin (point)))
      (forward-sexp)
      (let ((raw (read (buffer-substring-no-properties begin (point))))
            (end (point)))
        ;;(message "aaaaa: %S %S %S" raw (symbolp (elt raw 1)) (type-of (elt raw 1)))
        (let ((cypher (let ((cy (elt raw 1)))
                        ;; '(sigh 'sigh) XXX the usual eval dangerzone >_<
                        (if (reval--dquote-symbolp cy) (eval cy) reval-default-cypher)))
              (checksum (let ((cs (elt raw 2)))
                          (if (reval--dquote-symbolp cs) (eval cs) nil)))
              (path-or-url (elt raw 3))
              (alternates (cddddr raw)))
          (cl-values cypher checksum path-or-url alternates begin end))))))

(defun reval-check-for-updates (&optional universal-argument) ; TODO reval-sync ?
  "Check current buffer revals for updates.
UNIVERSAL-ARGUMENT is a placeholder."
  (interactive)
  ;; search and collect all calls to reval in the current buffer? all org files? ???
  ;; open the current reval in a buffer
  ;; get the package info if avaiable
  ;; warn about all revals that cannot be updated due to missing metadata?
  (let* ((pending-updates (reval--get-changed))
         (count (length pending-updates))
         (updates? (if (> count 1) "updates" "update")))
    (setq-local reval--pending-updates pending-updates)
    ;; TODO display a message about pending updates or a buffer
    ;; with the pending updates? probably easier to do the latter
    ;; and have approve/deny buttons or something
    (if (> count 0)
        (message "%s %s found for %s run `reval-do-updates' to audit changes."
                 count updates? (buffer-file-name))
      (message "No reval updates found for %s" (buffer-file-name)))))

(defun reval-do-updates (&optional universal-argument)
  "Audit and insert pending updates.
UNIVERSAL-ARGUMENT is a placeholder."
  ;; XXX `reval-update' isn't here because it would be for a single
  ;; form, but our workflow doesn't do that right now
  (interactive)
  (while reval--pending-updates
    (let* ((update (pop reval--pending-updates))
           (do-update (car update))
           (success (funcall do-update))))))

(defun reval-form-checksum-at-point (&optional universal-argument)
  "Get the checksum in the reval form at point.  UNIVERSAL-ARGUMENT is a placeholder."
  (interactive)
  (cl-multiple-value-bind (_cypher checksum _path-or-url _alternates _b _e)
      (reval--form-at-point)
    checksum))

;; user facing functionality

(defun reval-update-simple (&optional universal-argument)
  "Update the checksum for the reval sexp under the cursor or up the page.
Useful when developing against a local path or a mutable remote id.
If UNIVERSAL-ARGUMENT is non-nil then `reval-audit' is skipped, please use
this functionality responsibly."
  (interactive "P")
  (with-url-handler-mode
    (let ((reval--make-audit (not universal-argument))
          (sigh (point)))
      (cl-multiple-value-bind (cypher checksum path-or-url alternates begin end)
          (reval--form-at-point)
        (unless (memq cypher (secure-hash-algorithms))
          (error "%S is not a known member of `secure-hash-algorithms'" cypher))
        (let ((new (reval--make cypher path-or-url))
              (print-quoted t)
              print-length
              print-level)
          (delete-region begin end)
          (insert (prin1-to-string
                   (if alternates ; don't cons the old checksum, repeated invocations grow
                       (append new (cons ''OLD> alternates))
                     new))))
        (goto-char sigh)))))

(defun reval-sync (&optional universal-argument)
  "Check for, audit, and insert updates for the current buffer.
UNIVERSAL-ARGUMENT is a placeholder."
  (interactive)
  (reval-check-for-updates)
  (when reval--pending-updates
    (reval-do-updates)))

See https://emacs.stackexchange.com/a/7577 for why we have to manually save the position and save-excursion does nothing in this case.

FIXME huge problem with older versions of reval being pulled in by ow.el there really isn’t a way to fix that other than to decouple completely or to wrap the whole reval block in a conditional? actually that probably makes more sense …

FIXME TODO reuse the approach that we took with the orgstrap local variables for making it a bit more manageable to find and update any reval minimal blocks that are created. Since it is a key entry point and it is fairly large having an automated way to update to the latest version would be useful. Maybe via reval-insert-minimal and reval-update-minimal or similar. Be sure to match whatever naming conventions we used in orgstrap.

TODO M-: (insert (package-name–reval-update)) or rather, the reval-confirm workflow which is

  1. digest a local file or the master url etc.
  2. use reval-header-is-version-of package-name–reval-update to get the immutable url in the buffer for that file
  3. insert the immutable url and check that they match

A little trick in M-: (insert (prin1-to-string (read (buffer-string)))).

The more complex version of this is reload which includes a cache where files are stored locally, and the ability to set a preferred local path from whence a particular hash can be sourced. Given that reval is intended to be as bare bones as possible so that it can fit in the remaining elv space, I’m not including the reload functionality in the main block right now.

(defcustom reval-alternates-alist nil
  "An alist of ((CHECKSUM location ...) ...)")

(defcustom reval-cache-path nil
  "Override the reval default cache path.")

(defun reval-local-alternate (cypher checksum)
  ""
  ;; check explicit alternates
  ;; check cache
  ;; check default directory
  )

reval testing

basics

;; `eval-print-last-sexp'

;; bad since html not elisp
(reval--make 'sha256 "https://github.com/tgbugs/orgstrap/blob/417b87304da27397d3ce1b79039119a9337be305/packages.el")

;; bad 404 file exists but cannot be read ... 404 error or something like that should just fail ?
(reval--make 'sha256 "https://github.com/tgbugs/orgstrap/blob/does-no-exist/packages-does-not-exist.el")

(reval--make 'sha256 "https://raw.githubusercontent.com/tgbugs/orgstrap/does-no-exist/packages-does-not-exist.el")

;; connection error
(reval--make 'sha256 "https://127.0.0.2/connection-error")

(reval--make 'sha256 "https://0.0.0.0/connection-error")

;;(setq debug-on-message "File exists, but cannot be read")
;;(setq debug-on-message nil)

;; ok
(reval--make 'sha256 "https://raw.githubusercontent.com/tgbugs/orgstrap/417b87304da27397d3ce1b79039119a9337be305/packages.el")

;; checksum match
(reval 'sha256 'aada229afa36ac1f3e9f26e1ec7c0c09214d75563adb62aa0fac2f1ae58496fe "https://raw.githubusercontent.com/tgbugs/orgstrap/417b87304da27397d3ce1b79039119a9337be305/packages.el")

;; checksum mismatch
(reval 'sha256 'bada229afa36ac1f3e9f26e1ec7c0c09214d75563adb62aa0fac2f1ae58496fe "https://raw.githubusercontent.com/tgbugs/orgstrap/417b87304da27397d3ce1b79039119a9337be305/packages.el")

;; checksum missing file then match
(reval 'sha256 'aada229afa36ac1f3e9f26e1ec7c0c09214d75563adb62aa0fac2f1ae58496fe
 "packages.el"
 "https://raw.githubusercontent.com/tgbugs/orgstrap/417b87304da27397d3ce1b79039119a9337be305/packages.el")

;; missing file then missing url
(reval 'sha256 'aada229afa36ac1f3e9f26e1ec7c0c09214d75563adb62aa0fac2f1ae58496fe
 "packages.el"
 "https://raw.githubusercontent.com/tgbugs/orgstrap/417b87304da27397d3ce1b79039119a9337be305/packages.el-oops")

;; test whether Emacs can find xrefs in reval buffers

;; local files are of course ok
(reval--make 'sha256 "orgstrap.el")

(reval 'sha256 'cbb890d65aa85180f26cb334ac3ca26880005584a1b7f3910f147762eef0196d "orgstrap.el")

;; the default behavior for emacs does not work
(reval--make 'sha256 "https://raw.githubusercontent.com/tgbugs/orgstrap/38a8c1688f81a54e39f93bf84b7d4907cf03442c/orgstrap.el")

(reval 'sha256 'f25c7aa8c0e40afab8884a67f09e5a6629682bb6e6592c48025b87a7a05c4d98 "https://raw.githubusercontent.com/tgbugs/orgstrap/38a8c1688f81a54e39f93bf84b7d4907cf03442c/orgstrap.el")

Understanding delete

(defvar asdf '(a a))
(member (car asdf) asdf)
(delete (car asdf) asdf)
asdf
(delete 'a asdf)
(delq 'a asdf)
(setq asdf '(a a))
(setq asdf '(b a b a))

reval-failed-buffer-list
(switch-to-buffer (car reval-failed-buffer-list))
(pop reval-failed-buffer-list)

Thinking about whether there are reasonable ways we could enable more automated updates. It seems that without a redirect to current head url that provides known and specified behavior from the server side, we are stuck implementing all the usual insanity for each vcs, remote service, etc. I guess a Reval-Update: header could implement the processes needed to obtain the latest immutable url might work. Of course one could always use the prop line local variables for something like this rather than trying to stuff even more nonsense into the package metadata. setq-local only works if the file is loaded in a buffer though right … ?

;; Is-Version-Of: https://raw.githubusercontent.com/tgbugs/orgstrap/master/ow-min.el
;; Dereference: https://api.github.com/repos/tgbugs/orgstrap/git/refs/heads/master#/object/sha -> master
;; Reval-Get-Immutable: ow--reval-update
;; Reval-Update-Url-Func: ow-reval-update-get-immutable-url

(setq-local reval-update-get-immutable-url-function-name #'ow--update-url)

(defun ow--reval-update ()
  "Get the immutable url for the current remote version of this file."
  (reval-get-imm-github "tgbugs" "orgstrap" "ow.el"))

(defun ow--update-url-old ()
  (let ((branch "master")
        (glvt "https://raw.githubusercontent.com/tgbugs/orgstrap/%s/ow-min.el")
        (drvt "https://api.github.com/repos/tgbugs/orgstrap/git/refs/heads/%s"))
    (format glvt (gethash "sha" (gethash "object" (url->json (format drvt branch)))))))

update

Run reval-update-simple on each of these.

(reval ? ? "orgstrap.el")
(reval reval-default-cypher ? "orgstrap.el")
(reval 'sha512 ? "orgstrap.el")
(reval ? ? "orgstrap-lol-not-here.el") ; should fail