A Vtron

Posted 2018-03-17
Files: v.lisp, v.lisp.sig

Introduction.

What you see here is a functioning implementation of V, a version control system and a potent weapon against wreckers everywhere. Commentary throughout is designed so that the reader can fully understand every piece of the V implementation while building and testing it on their own.

This implementation is not without major flaws: pathnames are a pain (a consequence of the lisp-unix interface), key pieces (diff/patch/crypro) are delegated to external utilities, the use of CLOS is heavy-handed, and reliance on gpg makes the program slow and insecure. When it makes sense, I hope to clean up these problems (for instance, when I can wield a proper rsatron).

What is V?

V is a cryptographically backed version control system. Coders modify a codebase and run a diff utility (currently a modified GNU diff) to capture their changes. The coders then sign their (v)patch (the output of the diff utility) with their identity to endorse the changes. Other coders can download the patch and the signature. The signature and identity is used to verify trust in the patch, and a patch utility is used to apply the trusted patch. When multiple patches exist, they need to be applied in a certain order to resolve dependencies, so the patches must be topologically sorted to find that order.

V is the sum of the above: a single machine with buttons and levers for all the above actions.

Before we begin

This implementation is written in Common Lisp, and developed in SBCL version 1.4.4. It is designed to be used from within the Lisp repl, and tries to be minimal while providing the key functions of a vtron. The only dependency beyond SBCL is CL-PPCRE, used to parse vpatches. To load CL-PPCRE and set defaults, begin your file with the following:

(ql:quickload :cl-ppcre)
(defparameter *default-vpatch-dir* "./patches/")
(defparameter *default-wot-dir* "./wot/")
(defparameter *default-keyring-path* "./wot.gpg")
(defparameter *default-seal-dir* "./seals/")
(defparameter *default-output-dir* "./output/")
(defparameter *gpg-location* "/usr/bin/gpg")
(defparameter *patch-location* "/usr/bin/patch")

Please note that, if you change these defaults or provide your own arguments, then all paths must be absolute or prefixed with ./, and all directories must end in a forward slash. (For more info on why, see here.)

Lastly, this domain provides a Common Lisp Hyper Spec. If you don't have a local copy, then use to understand the code here, and beyond.

The anatomy of a vpatch

Here's a real vpatch, used to build the bitcoin client:

diff -uNr a/bitcoin/src/bitcoinrpc.cpp b/bitcoin/src/bitcoinrpc.cpp
--- a/bitcoin/src/bitcoinrpc.cpp bc6c82ab1a129e9e74a6bf785df99ac939fef94d72afbee153913fd53cab5d05120047275342cb4d52a98a951184eed47cccd9710e3655c261b68d2f257614a3
+++ b/bitcoin/src/bitcoinrpc.cpp cfc24bce544ba71ed8e7e876a1074dc89da184c6aa7f0fc2ad8d0c213516b2b9539497d3176dd0a17ccb427d687ce8d3cc4d3b9969802c9da5f05a0617a2a30b
@@ -1758,8 +1758,8 @@
         result.push_back(Pair("version", pblock->nVersion));
         result.push_back(Pair("previousblockhash", pblock->hashPrevBlock.GetHex()));
         result.push_back(Pair("transactions", transactions));
-        result.push_back(Pair("coinbasevalue", (int64_t)pblock->vtx[0].vout[0].nValue));
-        result.push_back(Pair("time", (int64_t)pblock->nTime));
+        result.push_back(Pair("coinbasevalue", (boost::int64_t)pblock->vtx[0].vout[0].nValue));
+        result.push_back(Pair("time", (boost::int64_t)pblock->nTime));

         union {
             int32_t nBits;
diff -uNr a/bitcoin/src/util.h b/bitcoin/src/util.h
--- a/bitcoin/src/util.h 1e2275fea3780708aed4d4c7de351b23a9379354df29dda39b8bf2ccc72df95713514b2b7837dc2230d42cf8234744e804bfd608fb4442ff62871257f8d80c12
+++ b/bitcoin/src/util.h e5e5da8c45c0fab1aca83eadb8e98560dc14f65060803b5efd7ea83418be6412ee6a4f59f15fa939e1d639ef2638c9c5d18b5448c246d943827a41e01997ef7b
@@ -7,7 +7,7 @@
 
 #include "uint256.h"
 
-
+#include <stdint.h>
 #include <sys/types.h>
 #include <sys/time.h>
 #include <sys/resource.h>

We can see two pieces: the first a diff of bitcoinrpc.cpp, and the second a diff of util.h. The lines beginning with --- and +++ give hashes of the files, computed before and after application of the patch. In my terminology, I call each such piece (a patch for a single file) a subpatch. The first task in building our vtron will be creating an abstract representation of the vpatch in our program. Let's get to it.

Abstract data

The guts of the program digests four classes of objects. The first is class is the subpatch. Because we will be relying on an external utility to apply each patch, we only load the name of the file and the before/after hashes:

(defclass subpatch ()
  ((path :initarg :path :reader path)
   (pre-hash :initarg :pre-hash :reader pre-hash)
   (post-hash :initarg :post-hash :reader post-hash))
  (:documentation "A subpatch is a patch for a single file."))

Next up is the vpatch class, consisting of subpatches, a name, and a path to the file:

(defclass vpatch ()
  ((name :initarg :name :reader name)
   (subpatches :initarg :subpatches :reader subpatches)
   (path :initarg :path :reader path))
  (:documentation "A representation of a vpatch."))

The second pair of classes concern topological sorting. The topological sort (toposort) acts on a directed graph, consisting of vertices and directed edges:

(defclass directed-edge ()
  ((head :initarg :head :reader head)
   (tail :initarg :tail :reader tail))
  (:documentation "A directed edge of a directed graph."))

(defclass directed-graph ()
  ((vertices :initarg :vertices :reader vertices)
   (edges :initarg :edges :reader edges))
  (:documentation "A directed graph, consisting of vertices and directed edges."))

The rest of the code consists of methods eating the above classes, and regular ol' functions to glue things together. We can get the generics out of the way now: but don't worry about this stuff (it's a Common Lisp idiom):

(defgeneric trustedp (vpatch &key keyring-path seal-dir))
(defgeneric patch (vpatch &key output-dir))
(defgeneric alignedp (obj1 obj2))
(defgeneric alignment (obj1 obj2))
(defgeneric adjacentp (obj1 obj2))
(defgeneric parentp (vp1 vp2))
(defgeneric toposort (obj))

Loading vpatches

To load a vpatch, we must extract out the path to the vpatch and the subpatches; so we begin with the subpatches. The following function scans through a vpatch file, accumulating info for each subpatch. (Note: this is the only place where we use the cl-ppcre library.)

(defun extract-hashes (vpatch-filepath)
  "Given a path to a vpatch, return a list of lists containing hash information
   for files in the vpatch. Each sub-list is of the form
   ([path] [pre-application hash] [post-application hash]) where the
   hashes are strings. Per the standard, nonexistance is denoted as \"false\". "
  (labels ((extract-vtree-info (vpatch)
             (let ((vtree-info-list nil))
               (with-open-file (s vpatch)
                 (do ((L (read-line s) (read-line s nil)))
                     ((eql L nil))
                   (if (cl-ppcre:scan "^diff" L)
                       (setq vtree-info-list
                             (cons (list (read-line s)
                                         (read-line s))
                                   vtree-info-list)))))
               vtree-info-list))
           (process-vtree-info (vtree-info-list)
             (mapcar #'(lambda (vtree-info)
                         (labels ((split-on-spaces (x)
                                    (cl-ppcre:split "\\s+" x)))
                           (let ((pre (split-on-spaces (first vtree-info)))
                                 (post (split-on-spaces (second vtree-info))))
                             (list (second pre)
                                   (car (last pre))
                                   (car (last post))))))
                     vtree-info-list)))
    (process-vtree-info (extract-vtree-info vpatch-filepath))))

Using the extracted info, we can make a list of subpatch objects:

(defun make-vpatch (filepath)
  "Given a filepath, returns a vpatch object capturing
   subpatches of the vpatch."
  (make-instance 'vpatch
                 :path filepath
                 :subpatches (mapcar #'(lambda (x)
                                         (make-instance 'subpatch
                                                        :path (first x)
                                                        :pre-hash (second x)
                                                        :post-hash (third x)))
                                     (extract-hashes filepath))))

A final function loads and returns all vpatches in a given directory:

(defun load-vpatches (path)
  "Given a path to a directory, returns a list containing the
   application of make-vpatch to every .vpatch file in the directory."
  (mapcar #'make-vpatch
          (directory (concatenate 'string path "/*.vpatch"))))

Validation of vpatches using gpg

Due to gpg keyring idiocy, this step is far less transparent than is acceptable. Integration with a proper rsatron will happen at a later date. Until then, the code below is workable.

Two error conditions are defined, catching simple operator error. The first is raised when trying to create a keyring where one already exists:

(define-condition wot-file-exists (error)
  ((text :initarg :text :reader text))
  (:documentation "Raised if a wot file (keyring) alreads exists."))

The second is raised when the wot directory does not exist:

(define-condition wot-dir-dne (error)
  ((text :initarg :text :reader text))
  (:documentation "Raised if a wot dir does not exist."))

Next up is the method for generating the keyring file:

(defun wot (&key
              (wot-dir *default-wot-dir*)
              (keyring-path *default-keyring-path*))
  "Generates a gpg keyring at keyring-path, loading
   in all .asc keys in wot-dir. Raises wot-file-exists error
   if a gpg keyring exists at keyring-path, and raises wot-dir-dne
   if wot-dir does not exist. Return is undefined."
  (if (not (probe-file wot-dir)) (error 'wot-dir-dne))
  (if (probe-file keyring-path) (error 'wot-file-exists))
  (mapcar #'(lambda (w)
              (format t "Adding key: ~a~%" (file-namestring w))
              (run-program *gpg-location* (list "--no-default-keyring"
                                                "--keyring"
                                                keyring-path
                                                "--import"
                                                (namestring w))))
          (directory (concatenate 'string wot-dir "*.asc")))
  (let ((s (make-string-output-stream)))
      (run-program *gpg-location* (list "--no-default-keyring"
                                        "--keyring"
                                        keyring-path
                                        "--list-keys")
                   :output s)
      (format t (get-output-stream-string s))))

The code begins by checking for the above error conditions. Then it adds every *.asc file in wot-dir to the newly generated keyring with the following call:

gpg --no-default-keyring --keyring keyring-path --import pubkey-path

The code finishes with a call to gpg to list all keys in the keyring at keyring-path, so the user can see the resultant wot.

Having gathered the vpatches and public keys, we also need to gather the digital signatures (seals) of the vpatches. The function is trivial:

(defun get-seals (&key (seal-dir *default-seal-dir*))
  "Returns a list of strings containing absolute paths for every .sig
   file in seal-dir."
  (mapcar #'namestring
          (directory (concatenate 'string
                                  seal-dir
                                  "*.sig"))))

Now we are in position to validate each vpatch against known seals and public keys:

(defmethod trustedp ((vp vpatch) &key
                      (keyring-path *default-keyring-path*)
                      (seal-dir *default-seal-dir*))
  "Takes in a vpatch, and returns t if signature in seal-dir
  is a valid signature of some member of the keyring at keyring-path.
  Otherwise returns nil."
  (format t "Checking ~a..." (file-namestring (path vp)))
  (let ((trusted (some #'(lambda (s)
                           (eq 0
                               (process-exit-code
                                (run-program *gpg-location*
                                             (list "--no-default-keyring"
                                                   "--keyring"
                                                   keyring-path
                                                   "--verify"
                                                   s
                                                   (namestring (path vp)))))))
                       (get-seals :seal-dir seal-dir))))
    (format t "~a~%" (if trusted " trusted" " NOT TRUSTED!"))
    trusted))

The trustedp method (called after creating the web of trust using (wot)) takes in a vpatch, and indicates if some seal of the vpatch comes from a trusted identity.

Applying a vpatch

To apply a vpatch a.vpatch with output to output-dir, we make an external call to the patch utility:

patch --dir output-dir -F 0 -E -p1 -i ./patches/a.vpatch

In Common Lisp and using our vpatch class, the code is:

(defun apply-patch (vpatch &key (output-dir *default-output-dir*))
  (format t "Applying ~a..." (file-namestring (path vpatch)))
  (if (eq 0
          (process-exit-code (run-program *patch-location*
                                          (list "--dir" output-dir
                                                "-F" "0" "-E" "-p1" "-i"
                                                (namestring (path vpatch))))))
      (progn (format t " success~%") t)
      (progn (format t " FAILED!~%") nil)))

The code calls the patch utility and checks its exit code. If the code is 0, it prints the success to the standard output. Otherwise, it prints the failure.

Generating the dependency graph.

Given a collection of vpatches, we need to create the dependency graph to ensure that the patches are applied a valid order. I consider this the trickest part of the whole process, for how do we determine if one vpatch derives from another, given only the patch itself? There is a planned resolution to the problem, but for this implementation I developed my own solution.

To begin, a few definitions: Two subpatches are aligned if their relative paths match:

(defmethod alignedp ((sp1 subpatch) (sp2 subpatch))
  (equal (path sp1) (path sp2)))

With two vpatches $v_1$ and $v_2$, we can collect all pairs $(s_1, s_2)$ with $s_i$ a subpatch of $v_i$. This collection forms the alignment of $v_1$ and $v_2$:

(defmethod alignment ((vp1 vpatch) (vp2 vpatch))
  (loop for sp1 in (subpatches vp1)
	 append (loop for sp2 in (subpatches vp2)
			   if (alignedp sp1 sp2)
			   collect (list sp1 sp2))))

That two subpatches are aligned doesn't tell us anything about the order to apply them. So we define subpatch $s_1$ to be a parent to subpatch $s_2$ if the post-hash of $s_1$ is equal to the pre-hash of $s_2$:

(defmethod parentp ((vp1 vpatch) (vp2 vpatch))
  (let ((alignment (alignment vp1 vp2)))
    (labels ((parentp-apply (x) (apply #'parentp x)))
      (and (every #'parentp-apply alignment)
           (some #'parentp-apply alignment)))))

Now the dicey part: how do we extend the parent relation to vpatches? Since the child vpatch can create and delete files, we can't rely on a bijective relation between sets of subpatches. So we might think it enough that every child subpatch be either created from nothing, or have a parent subpatch in the parent vpatch. But this doesn't account for vpatches with multiple parents. Hence the notion of alignment: we track the lineages of each subpatch, and only compare the alignment of vpatches when considering the parent relationship. When every aligned pair of subpatchs is in the parent-child relationship, we have a match. But a final catch: if the alignment is empty, then trivially, every pair of aligned subpatches is in the parent-child relationship, whereas it's nonsense to consider the containing vpatches as parent-child. So we require that some pair of subpatches be in alignment and parent-child. The result:

(defmethod parentp ((vp1 vpatch) (vp2 vpatch))
  (let ((alignment (alignment vp1 vp2)))
    (labels ((parentp-apply (x) (apply #'parentp x)))
      (and (every #'parentp-apply alignment)
           (some #'parentp-apply alignment)))))

Generating the dependency graph is simple: loop through pairs, searching for parent-child pairs:

(defun generate-depgraph (vpatch-list)
  "Generate a directed graph from the input list of vpatches.
   Returns a list whose first member is the input list of vpatches,
   and second member is a list of all directed edges (vp1 vp2)
   where vp1 is a parent of vp2."
  (make-instance 'directed-graph
                 :vertices vpatch-list
                 :edges (loop for vp1 in vpatch-list
                           append (loop for vp2 in vpatch-list
                                     if (parentp vp1 vp2)
                                     collect (make-instance 'directed-edge
                                                            :head vp1
                                                            :tail vp2)))))

Topologically sorting a directed graph

Having generated a directed graph, we need to extract a sensible sequence for applying the contained vpatches. The method used is extremely simple, taken from Knuth's The Art of Computer Programming. In this case, it's easiest to present the pieces first, and bake them together last.

First ingredient is an error condition for when we can't sort the graph:

(define-condition cyclic (error)
  ((text :initarg :text :reader text))
  (:documentation "Thrown when a cycle is encountered."))

Second is a method to take a unary proposition and a list, and separate the members of the list by the truth value of its members:

(defun partition (proposition list)
  "Given a unary proposition (true/false on one argument),
  returns two values: those for which the proposition is true,
  and those for which the proposition is false, in that order."
  (let ((successes '())
        (failures '()))
    (mapcar #'(lambda (x) (if (funcall proposition x)
                              (push x successes)
                              (push x failures)))
            list)
    (values successes failures)))

Third is a way to distinguish roots, being vertices with no parents:

(defun rootp (vertex edges)
  "Returns t if vertex is not the tail of any edge, nil otherwise."
  (notany #'(lambda (e) (eq (tail e) vertex))
          edges))

Fourth is a function to remove all edges whose heads are certain vertices:

(defun decapitate (vertices edges)
       "Removes all edges with head in vertices"
       (remove-if #'(lambda (edge) (member (head edge) vertices))
                  edges))

Now we bake everything together. Starting with the directed graph, remove all roots, and place them in arbitrary order at the beginning sequence. Then remove the new roots, and place them after the previous roots. Repeat until the graph is empty. Caveat: if, at some point, the graph is nonempty but has no roots, then we are stuck (the graph is cyclic), so we signal the error condition. Make sure you understand how every ingredient fits into the implementation:

(defmethod toposort ((dg directed-graph))
  "Topologically sorts a directed graph using the standard method from Knuth.
   Throws an error if a cycle is encountered."
  (labels ((flatten-rec (vertices edges)
             (if (null vertices)
                 '()
                 (multiple-value-bind (roots others)
                     (partition #'(lambda (v) (rootp v edges))
                                vertices)
                   (if (null roots)
                       (error 'cyclic)
                       (append roots
                               (flatten-rec others (decapitate roots
                                                               edges))))))))
    (flatten-rec (vertices dg) (edges dg))))

With the toposort operational, we are ready to define the main operations.

Main operations

Alright, enough chit-chat. Let's see this thing work.

(flow) will topologically sort all the vpatches in a directory (ignoring seals!!!) and print the sorted list:

(defun flow (&key (vpatch-dir *default-vpatch-dir*))
  (let* ((counter 0)
         (sorted (toposort
                  (generate-depgraph
                   (load-vpatches vpatch-dir))))
         (format-string (concatenate 'string
                                     "~"
                                     (write-to-string
                                      (ceiling (log (length sorted) 10)))
                                     ",' d ~a~%")))
    (mapcar #'(lambda (vp)
                (format t format-string
                        (incf counter)
                        (file-namestring (namestring (path vp)))))
            sorted)))

The return value is undefined. Example:

CL-USER> (flow)
 1 genesis.vpatch
 2 bitcoin-asciilifeform.1.vpatch
 3 rm_rf_upnp.vpatch
 4 bitcoin-asciilifeform.2-https_snipsnip.vpatch
 5 bitcoin-asciilifeform.3-turdmeister-alert-snip.vpatch
 6 bitcoin-v0_5_3_1-static_makefile_v002.8.vpatch
 7 bitcoin-asciilifeform.4-goodbye-win32.vpatch
 8 asciilifeform_orphanage_thermonuke.vpatch
 9 asciilifeform-kills-integer-retardation.vpatch
10 asciilifeform_dnsseed_snipsnip.vpatch
11 asciilifeform_tx-orphanage_amputation.vpatch
12 bitcoin-v0_5_3-db_config.6.vpatch
13 bitcoin-v0_5_3_1-rev_bump.7.vpatch
14 asciilifeform_zap_hardcoded_seeds.vpatch
15 asciilifeform_maxint_locks_corrected.vpatch
16 asciilifeform_and_now_we_have_block_dumper_corrected.vpatch
17 asciilifeform_zap_showmyip_crud.vpatch
18 mod6_fix_dumpblock_params.vpatch
19 asciilifeform_dns_thermonyukyoolar_kleansing.vpatch
20 asciilifeform_ver_now_5_4_and_irc_is_gone_and_now_must_give_ip.vpatch
21 asciilifeform_and_now_we_have_eatblock.vpatch
22 asciilifeform_lets_lose_testnet.vpatch
23 asciilifeform_add_verifyall_option.vpatch
24 programmable-versionstring.vpatch
25 mod6_der_high_low_s.vpatch
26 malleus_mikehearnificarum.vpatch
27 makefiles.vpatch
(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
 NIL NIL NIL NIL NIL NIL NIL NIL)

(roots) will list out all roots of the depgraph:

(defun roots (&key (vpatch-dir *default-vpatch-dir*))
  (mapcar
   #'(lambda (vp) (format t "~a~%" (file-namestring (path vp))))
   (let ((vpatch-list (load-vpatches vpatch-dir)))
     (remove-if-not #'(lambda (vp) (rootp vp
                                          (edges
                                           (generate-depgraph vpatch-list))))
                    vpatch-list))))

Example:

CL-USER> (roots)
genesis.vpatch
(NIL)

(leaves) will list out the leaves:

(defun leaves (&key (vpatch-dir *default-vpatch-dir*))
  (let* ((vpatch-list (load-vpatches vpatch-dir))
         (edges (edges (generate-depgraph vpatch-list))))
    (labels ((leafp (vertex) (notany #'(lambda (e) (eq (head e) vertex))
                                     edges)))
      (mapcar
       #'(lambda (vp) (format t "~a~%" (file-namestring (path vp))))
       (remove-if-not #'leafp vpatch-list)))))

Example:

CL-USER> (leaves)
makefiles.vpatch
(NIL)

To get a list of antecedents or descendants for a single vpatch, we combine the similarties in a helper function first:

(defun ancestors (vpatch-basename vpatch-dir ancestor-function)
  (let* ((dg (generate-depgraph
              (load-vpatches vpatch-dir)))
         (vp1 (car (remove-if-not
                    #'(lambda (v) (eql (path v)
                                       (probe-file
                                        (concatenate 'string
                                                     vpatch-dir
                                                     vpatch-basename))))
                    (vertices dg)))))
    (labels ((direct-ancestor (vp1 vp2)
               (some (funcall ancestor-function vp1 vp2)
                     (edges dg)))
             (ancestors-rec (vp1)
               (let ((current-ancestors
                      (remove-if-not
                       #'(lambda (vp2) (direct-ancestor vp2 vp1))
                       (vertices dg))))
                 (if (null current-ancestors)
                     '()
                     (append current-ancestors
                             (apply #'append
                                    (mapcar #'ancestors-rec
                                            current-ancestors)))))))
      (mapcar #'(lambda (x) (format t "~a~%" (file-namestring (path x))))
              (remove-duplicates (ancestors-rec vp1))))))

(defun antecedents (vpatch-basename &key (vpatch-dir *default-vpatch-dir*))
  (ancestors vpatch-basename
             vpatch-dir
             #'(lambda (vp1 vp2)
                 #'(lambda (e) (and (eql (head e) vp1)
                                    (eql (tail e) vp2))))))

(defun descendants (vpatch-basename &key (vpatch-dir *default-vpatch-dir*))
  (ancestors vpatch-basename
             vpatch-dir
             #'(lambda (vp1 vp2)
                 #'(lambda (e) (and (eql (tail e) vp1)
                                    (eql (head e) vp2))))))

Examples:

CL-USER> (antecedents "asciilifeform_add_verifyall_option.vpatch")
asciilifeform_lets_lose_testnet.vpatch
asciilifeform_and_now_we_have_eatblock.vpatch
asciilifeform_tx-orphanage_amputation.vpatch
asciilifeform_ver_now_5_4_and_irc_is_gone_and_now_must_give_ip.vpatch
mod6_fix_dumpblock_params.vpatch
asciilifeform_dns_thermonyukyoolar_kleansing.vpatch
bitcoin-v0_5_3_1-rev_bump.7.vpatch
bitcoin-v0_5_3_1-static_makefile_v002.8.vpatch
asciilifeform_zap_showmyip_crud.vpatch
asciilifeform_zap_hardcoded_seeds.vpatch
asciilifeform_dnsseed_snipsnip.vpatch
asciilifeform_and_now_we_have_block_dumper_corrected.vpatch
asciilifeform-kills-integer-retardation.vpatch
asciilifeform_orphanage_thermonuke.vpatch
bitcoin-asciilifeform.4-goodbye-win32.vpatch
bitcoin-asciilifeform.2-https_snipsnip.vpatch
bitcoin-asciilifeform.3-turdmeister-alert-snip.vpatch
rm_rf_upnp.vpatch
bitcoin-asciilifeform.1.vpatch
genesis.vpatch
(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
 NIL)
CL-USER> (descendants "asciilifeform_add_verifyall_option.vpatch")
programmable-versionstring.vpatch
malleus_mikehearnificarum.vpatch
mod6_der_high_low_s.vpatch
makefiles.vpatch
(NIL NIL NIL NIL)

And finally, (press) will ensure that the output directory exists, and then load all vpatches, remove untrusted vpatches, generate a dependency graph, toposort, and apply the sorted vpatches. Returns t if every patch is successful (exit code 0), and nil otherwise:

(defun press (&key
                (vpatch-dir *default-vpatch-dir*)
                (output-dir *default-output-dir*))
  (ensure-directories-exist (make-pathname :directory `(:relative ,output-dir)))
  (every #'identity
         (mapcar #'patch
                 (toposort
                  (generate-depgraph
                   (remove-if-not #'trustedp (load-vpatches vpatch-dir)))))))

Example

CL-USER> (press)
Checking asciilifeform-kills-integer-retardation.vpatch... trusted
Checking asciilifeform_add_verifyall_option.vpatch... trusted
Checking asciilifeform_and_now_we_have_block_dumper_corrected.vpatch... trusted
Checking asciilifeform_and_now_we_have_eatblock.vpatch... trusted
Checking asciilifeform_dns_thermonyukyoolar_kleansing.vpatch... trusted
Checking asciilifeform_dnsseed_snipsnip.vpatch... trusted
Checking asciilifeform_lets_lose_testnet.vpatch... trusted
Checking asciilifeform_maxint_locks_corrected.vpatch... trusted
Checking asciilifeform_orphanage_thermonuke.vpatch... trusted
Checking asciilifeform_tx-orphanage_amputation.vpatch... trusted
Checking asciilifeform_ver_now_5_4_and_irc_is_gone_and_now_must_give_ip.vpatch... trusted
Checking asciilifeform_zap_hardcoded_seeds.vpatch... trusted
Checking asciilifeform_zap_showmyip_crud.vpatch... trusted
Checking bitcoin-asciilifeform.1.vpatch... trusted
Checking bitcoin-asciilifeform.2-https_snipsnip.vpatch... trusted
Checking bitcoin-asciilifeform.3-turdmeister-alert-snip.vpatch... trusted
Checking bitcoin-asciilifeform.4-goodbye-win32.vpatch... trusted
Checking bitcoin-v0_5_3-db_config.6.vpatch... trusted
Checking bitcoin-v0_5_3_1-rev_bump.7.vpatch... trusted
Checking bitcoin-v0_5_3_1-static_makefile_v002.8.vpatch... trusted
Checking genesis.vpatch... trusted
Checking makefiles.vpatch... trusted
Checking malleus_mikehearnificarum.vpatch... trusted
Checking mod6_der_high_low_s.vpatch... trusted
Checking mod6_fix_dumpblock_params.vpatch... trusted
Checking programmable-versionstring.vpatch... trusted
Checking rm_rf_upnp.vpatch... trusted
Applying genesis.vpatch... success
Applying bitcoin-asciilifeform.1.vpatch... success
Applying rm_rf_upnp.vpatch... success
Applying bitcoin-asciilifeform.2-https_snipsnip.vpatch... success
Applying bitcoin-asciilifeform.3-turdmeister-alert-snip.vpatch... success
Applying bitcoin-v0_5_3_1-static_makefile_v002.8.vpatch... success
Applying bitcoin-asciilifeform.4-goodbye-win32.vpatch... success
Applying asciilifeform_orphanage_thermonuke.vpatch... success
Applying asciilifeform-kills-integer-retardation.vpatch... success
Applying asciilifeform_dnsseed_snipsnip.vpatch... success
Applying asciilifeform_tx-orphanage_amputation.vpatch... success
Applying bitcoin-v0_5_3-db_config.6.vpatch... success
Applying bitcoin-v0_5_3_1-rev_bump.7.vpatch... success
Applying asciilifeform_zap_hardcoded_seeds.vpatch... success
Applying asciilifeform_maxint_locks_corrected.vpatch... success
Applying asciilifeform_and_now_we_have_block_dumper_corrected.vpatch... success
Applying asciilifeform_zap_showmyip_crud.vpatch... success
Applying mod6_fix_dumpblock_params.vpatch... success
Applying asciilifeform_dns_thermonyukyoolar_kleansing.vpatch... success
Applying asciilifeform_ver_now_5_4_and_irc_is_gone_and_now_must_give_ip.vpatch... success
Applying asciilifeform_and_now_we_have_eatblock.vpatch... success
Applying asciilifeform_lets_lose_testnet.vpatch... success
Applying asciilifeform_add_verifyall_option.vpatch... success
Applying programmable-versionstring.vpatch... success
Applying mod6_der_high_low_s.vpatch... success
Applying malleus_mikehearnificarum.vpatch... success
Applying makefiles.vpatch... success
T

Making a vpatch

After all that, you're probably wondering: how do I make one of these vpatches? For now (and until I can endorse a proper hashing algorithm), that's out of the scope of this program. Instead, you can save the following snippet into a shell script, and pass it your before and after codebases:

diff -uNr \$1 \$2 | awk 'm = /^(---|\+\+\+)/{s="sha512sum \"" \$2 "\" 2>/dev/null  " | \
getline x; if (s) { split(x, a, " "); o = a[1]; } else {o = "false";} \
print \$1 " " \$2 " " o} !m { print \$0 }'

That's all for now.

3 Responses to “A Vtron”

  1. [...] esthlos Creativity is a response to being "sufficiently annoyed" - Erik Naggum « A Vtron [...]
  2. [...] current intention of the Republic is for my vtron to become the standard for the time being. This post is intended to keep track of the proposed [...]
  3. [...] If you're new here and don't know what V is, I suggest you glance at the canonical introduction by Benjamin Vulpes, and possibly glance my (now outdated by this post) older, flawed vtron. [...]

Leave a Reply (USE HTML! Space not preserved!)