Archive for the ‘Uncategorized’ Category

esthlos-v: Release with Working Keccak

Sunday, October 14th, 2018

Patches and Seals

In press order:

What is It?

This is a release of esthlos-v supporting pressing and checking Keccak vpatches. Currently a diff is not provided, but is next on the list.

What's in Those Patches?

esthlos-v_genesis.vpatch

This patch simply lays out the directory structure of esthlos-v. The structure is like so:

- patches
- seals
- wot
- src
-- diff
-- gpg
-- keccak
-- patch
-- toposort

The design attempts to be modular. In particular, keccak can be built and run as a standalone executable.

esthlos-v_keccak.vpatch

This patch introduces Keccak, as explained here

esthlos-v_gpg.vpatch

This patch defines an interface to GPG, used for verifying seals. The knobs:

(defparameter *gpg-location* "/usr/bin/gpg")
(defparameter *rm-location* "/bin/rm")
(defparameter *tmp-location* "/tmp")

and the primary function, which checks a list of patches against all matching seals in a directory:

(defun check-trust (pathname-list seal-dir wot-dir)
  (let ((wot (create-wot wot-dir
                         (make-temp-dir (namestring
                                         (make-pathname
                                          :directory `(:relative ,*tmp-location*)
                                          :name "gpgXXXXXX"))))))
    (dolist (p pathname-list)
      (let ((seals (find-seals-for-vpatch p seal-dir)))
        (if (null seals)
            (error 'no-seal :text (pathname p))
            (dolist (v (find-seals-for-vpatch p seal-dir))
              (check-trust-on-wot p v wot)))))))

For clarity, the naming convention used to match patches is

<patch-name>.vpatch.<key-name>.sig

Eventually, I imagine this component being replaced by some TMSR RSA.

esthlos-v_patch.vpatch

This brings a dead-simple interface to GNU Patch, with knobs

(defparameter *patch-location* "/usr/bin/patch")

and procedure

(defun patch (patch output-dir)
  (ensure-directories-exist output-dir)
  (if (not (probe-file output-dir))
      (error 'output-dir-dne)
      (if (eq 0
              (run-subprocess *patch-location*
                              (list "--dir" (namestring output-dir)
                                    "-F" "0" "-E" "-p1" "-i"
                                    (namestring (probe-file patch)))))
          nil
          (error 'patch-failure :text (namestring patch)))))

esthlos-v_toposort.vpatch

This patch defines a general-purpose topological sort, acting on classes

(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."))

and defined as follows:

(defmethod toposort ((dg directed-graph))
  (labels ((separate-roots (vertices edges)
             (partition #'(lambda (v) (rootp v edges))
                        vertices))
           (decapitate (vertices edges)
             "Removes all edges with head in vertices"
             (remove-if #'(lambda (edge) (member (head edge) vertices))
                        edges))
           (flatten-iter (remaining-vertices remaining-edges sorted-vertices)
             (if (null remaining-vertices)
                 sorted-vertices
                 (multiple-value-bind (roots non-roots)
                     (separate-roots remaining-vertices remaining-edges)
                   (if (null roots)
                       'cyclic
                       (flatten-iter non-roots
                                     (decapitate roots remaining-edges)
                                     (append sorted-vertices roots)))))))
    (flatten-iter (vertices dg) (edges dg) '())))

esthlos-v_defsystem.vpatch

This patch defines glues the pieces of the vtron together by introducting a ASDF defsystem form into the vtron. As a side effect, the round constants in the Keccak implementation had to be changed from a defconstant to a defparameter (otherwise the build refused to move forward, go figure). The system is defined like so:

(defsystem v
  :components ((:file "package")
               (:file "v"
                      :depends-on ("package"
                                   gpg
                                   keccak
                                   patch
                                   toposort))
               (:module gpg
                        :serial t
                        :components ((:file "package")
                                     (:file "knobs")
                                     (:file "cl-gpg")))
               (:module keccak
                        :serial t
                        :components ((:file "src/package")
                                     (:file "src/knobs")
                                     (:file "src/bits")
                                     (:file "src/cl-keccak")))
               (:module patch
                        :serial t
                        :components ((:file "package")
                                     (:file "knobs")
                                     (:file "patch")))
               (:module toposort
                        :serial t
                        :components ((:file "package")
                                     (:file "toposort")))))

esthlos-v_gpg-fix.vpatch

This patch fixes the behaivor of the GPG interface; prior to this patch, the GPG interface would not throw an error if there existed no seals corresponding to a patch. After this patch, the GPG interface fails with a no-seal condition.

esthlos-v_main.vpatch

Finally, this patch implements the core vtronic behaivor. Building on my previous vtron, we now have hash checking using Keccak:

(defun check-hashes (vpatch output-dir)
  (labels ((subpatch-path-to-actual (subpatch)
             (merge-pathnames (subseq (path subpatch)
                                      (1+ (position #\/ (path subpatch))))
                              (make-pathname
                               :directory `(:relative ,output-dir))))
           (compare-hashes (subpatch hash-accessor)
             (if (string= (funcall hash-accessor subpatch)
                          "false")
                 (not (probe-file (subpatch-path-to-actual subpatch)))
                 (string= (funcall hash-accessor subpatch)
                          (string-downcase
                           (cl-keccak::keccak-hash-file
                            (subpatch-path-to-actual subpatch)
                            cl-keccak::+bitrate+
                            cl-keccak::+output-bits+))))))
    (dolist (sp (subpatches vpatch))
      (format t "    Checking hash on ~A~%"
              (namestring (subpatch-path-to-actual sp)))
      (if (not (compare-hashes sp #'post-hash))
          (error 'hash-failure :text (namestring (subpatch-path-to-actual sp)))))))

Additionally, I rewrote the macros used to define the main operations. They now look like so:

(defun flow (&optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-verifying-patches
    (cl-toposort:toposort
     (generate-depgraph
      vpatch-list)))))

(defun roots (&optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-verifying-patches
    (cl-toposort:toposort
     (generate-depgraph
      (remove-if-not #'(lambda (vp)
                         (cl-toposort::rootp vp
                                             (cl-toposort::edges
                                              (generate-depgraph vpatch-list))))
                     vpatch-list))))))

(defun leaves (&optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-verifying-patches
    (cl-toposort:toposort
     (generate-depgraph
      (remove-if-not #'(lambda (vp)
                         (cl-toposort::leafp vp
                                             (cl-toposort::edges
                                              (generate-depgraph vpatch-list))))
                     vpatch-list))))))

(defun antecedents (vpatch &optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-looking-up-vpatch-if-needed
    (after-verifying-patches
     (cl-toposort:toposort
      (generate-depgraph
       (ancestors vpatch vpatch-list #'childp)))))))

(defun descendants (vpatch &optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-looking-up-vpatch-if-needed
    (after-verifying-patches
     (cl-toposort:toposort
      (generate-depgraph
       (ancestors vpatch vpatch-list #'parentp)))))))

(defun press-path (vpatch &optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-looking-up-vpatch-if-needed
    (append (antecedents vpatch vpatch-list)
            (list vpatch)))))

(defun press (vpatch output-dir &optional vpatch-list)
  (after-finding-vpatches-if-needed
   (after-looking-up-vpatch-if-needed
    (notany #'(lambda (vp)
                (format t "Pressing ~A~%" (name vp))
                (cl-patch:patch (path vp)
                                (make-pathname
                                 :directory `(:relative
                                              ,output-dir)))
                (format t "  Checking hashes in ~A~%" (name vp))
                (check-hashes vp output-dir))
            (cl-toposort:toposort
             (generate-depgraph
              (press-path vpatch vpatch-list)))))))

As before, there are two ways to call these operations. The first is using a string s, which will find the first patch in the patches directory whose patch name has s as a substring. (The order appears to be that of a simple ls, but does not seem to be standardized, unfortunately).

Known Issues:

  • The old interpret-and-verify macro was not removed from v.lisp.

esthlos-v Part 2: cl-keccak

Saturday, September 15th, 2018

Get the latest vpatch here:

This post introduces Keccak into the refactored esthlos-v. The inner workings of Keccak have already been well explained, including operations at the bit-level, so I'm not going to beat a dead horse. Instead, let's hit the broad strokes of how the thing works, pointing out quirks of implementation.

Oh, and please do point out all the inefficiencies and such that you see. I'm aware of a few optimizations which are begging to be made, but I'm sure there are more in plain right.

First things first. The available knobs:

;; the number of bits in a byte, arch-specific
(defconstant +bits-in-byte+ 8)

;; the keccak L parameter, takes a value in {1,2,3,4,5,6}
(defconstant +keccak_L+ 6)

;; the number of bits absorbed into the sponge on each pass
(defconstant +bitrate+ 1344)

;; the desired number of output bits
(defconstant +output-bits+ 512)

My guess is that you probably shouldn't touch +bits-in-byte+. The Keccak-specific guts of the program theoretically will work on alien, non-octet-based arch, but the I/O will break. Everything else should be self-explanatory: keep +keccak_L+ a valid value, ensure that the +bitrate+ is less than the Keccak width, and keep +output-bits+ divisible by 16 (for the hex output).

Now for the internals. Upon being called, the first action is to look up the input file and create a corresponding bit vector. Immediately we have a challenge of interpretation: The file stored on disk is byte-addressed, so there's no meaning to "the first bit of the the byte". All we can ask for is a the first byte of the file, and we must make a decision of how to store that byte as a vector of bits to carry out the Keccak operations. According to the team Keccak website, the convention is to represent each byte as little-endian vector of eight bits, left-concatenating the vectors as we read off the bytes of the file. You might expect such crucial information, which very much does impact the results of the hash, to be standardized by the standard. Well, I guess you might expect a lot of things. But I'm using little-endian representation, and below you can see how:

(defun integer-to-bit-vector (n)
  (labels ((bit-array-iter (n array)
             (if (zerop n)
                 array
                 (multiple-value-bind (q r)
                     (floor n 2)
                   (bit-array-iter q
                                   (append array (list r)))))))
    (bit-pad-right (bit-array-iter n '()) 8)))

The eight-bit-long vectors are concatenated together in a simple and (hopefully) efficient loop:

(defun bit-vector-concatenate-uniform-vector (bit-vector-vector member-size)
  (let ((rtn (make-sequence 'simple-bit-vector
                            (* member-size (length bit-vector-vector)))))
    (dotimes (i (length bit-vector-vector))
      (replace rtn
               (aref bit-vector-vector i)
               :start1 (* i member-size)
               :end1 (* (1+ i) member-size)))
    rtn))

And the input to the concatenation procedure derives from a higher procedure, taking in a path to the file in question:

(defun file-to-bit-vector (filepath)
  (with-open-file (f filepath :direction :input :element-type 'bit)
    (bit-vector-concatenate-uniform-vector
     (map 'vector
          #'integer-to-bit-vector
          (let ((s (make-sequence 'list (file-length f))))
            (read-sequence s f)
            s))
     +bits-in-byte+)))

I'm acutely aware that my Common Lisp skills are mediocre, and my optimization abilities are worse, so please leave feedback if I'm missing obvious improvements.1

After constructing a bit vector to represent the file, we go through the usual Keccak mumbo jumbo as explained elsewhere. At the highest level, this part of the program looks like so:

(defun keccak-sponge (input-bit-vector bitrate output-bits)
  (keccak-squeeze (keccak-absorb input-bit-vector
                                 bitrate)
                  bitrate
                  output-bits))

In the end, it's that simple; absorb and squeeze. Make sure to set the bitrate to be less than the width, where the width can be calculated as

(* 5 5 (expt 2 +keccak_L+))

Now for output. All we do is take the bit vector returned by the sponge, and convert it to big-endian hexadecimal:

(defun keccak-hash-file (filepath bitrate output-bits)
  (bit-vector-to-hex (keccak-sponge (file-to-bit-vector filepath)
                                    bitrate
                                    output-bits)))

The conversion takes place one octet at a time, and padding the hexadecimal so there are two digits without exception. These two-digit hexadecimal numerals are then left-concatenated, creating the usual sloppy big-endian mess2:

(defun bit-vector-to-hex (bv)
  (apply #'concatenate
         'string
         (mapcar (lambda (n)
                   (let ((s (write-to-string n :base 16)))
                     (if (= (length s) 2)
                         s
                         (concatenate 'string "0" s))))
                 (mapcar #'bit-vector-to-integer
                         (bit-chunk bv 8)))))

Then the concatenated hexadecimal is downcased, output, and we're finished!

(defun main ()
  (let ((args #+sbcl (cdr sb-ext:*posix-argv*)
              #+ccl (cdr ccl:*command-line-argument-list*)))
    (princ (string-downcase (keccak-hash-file (first args)
                                              +bitrate+
                                              +output-bits+)))))

So how do we know it works? Well, check the tests directory and read the README:

To run the tests:
1. Run make
2. Run the resulting executable

Apologies to the neets and jwzs out there, for making you do something. These tests are the same as those used by Diana, including both tests of the permutations and tests of the sponge. Pipe the output of the executable to a file, or watch it lazily scroll by. If you don't see any "fail", you're good to go.

So we know how it works, but how well? Here are some benchmarks:

| size (KiB) | time (seconds) | rate (KiB/s) |
|------------+----------------+--------------|
|          1 |          0.051 |         19.6 |
|         10 |          0.255 |         39.2 |
|        100 |          2.351 |         42.5 |
|       1000 |          23.52 |         42.5 |
|      10000 |          246.4 |        40.58 |

The trend between input size and resulting time of computation appears linear across the orders of magnitude. Though based on a rate of 40 KiB/s, large files will take some time to hash.

Anyway, that's all for now. More on esthlos-v to follow.

  1. Additionally, I am aware that the current approach requires the entire file be loaded into memory at once, whereas the mathematics behind Keccak do not require having the entire file available. However, the Keccak specification itself does require the entire file be in memory to carry out the procedure as specified; a detail which, I'd hazard a guess, most implementations fail to conform to. []
  2. Isn't computing elegant? []

esthlos-v redux

Monday, August 27th, 2018

This week, having coerced my Keccak implementation1 to agree with Diana's, I set to the task of integrating Keccak into esthlos-v. In that process, I saw that the original project structure of esthlos-v doesn't clearly convey the logically separable components of a vtron and how they fit together. Hence I'm regrinding esthlos-v into a structure which

  • makes clear what pieces of technology (ideas!) go into a vtron, and
  • enables the user to modify or swap out each dependency as desired, so that, as long as the external interface is adhered to, the vtron as a whole continues to operate correctly.

The new esthlos-v is split splits out five dependencies:

  • a Keccak implementation,
  • a toposort implementation,
  • an interface to GPG,
  • a differ (Hunt-McIlroy), and
  • a patcher.

As a result, we have the following directory structure:

esthlos-v
  patches
  seals
  src
    diff
    gpg
    keccak
    patch
    toposort
    v.lisp
  wot

The interfaces to each dependency are fairly obvious2:

keccak: The interface is the procedure

(compute-hash in out)

which reads byte-by-byte from the input stream in and writes the resulting hash, in hexadecimal, to the output stream out. If the calculation and write finish, returns nil, and otherwise returns data indicating error.

toposort: The interface is the procedure

(toposort edges)

where edges is an association list with members of the form (head . tail). The procedure returns a list consisting of the sorted members of the pairs of the association list if the graph determined by the association list is sortable, and returns the symbol cyclic otherwise.

GPG: The interface is the procedure

(check-trust vpatch_file_list seal_dir wot_dir)

takes in a list vpatch_file_list of path designators, and the directories seal_dir and wot_dir. The procedure returns nil if and only if:

  • Each file in wot_dir is a valid public key in GPG format;
  • Each member of vpatch_file_list is a path designator of an existing file;
  • For each member of vpatch_file_list, there is least one corresponding seal seal in seal_dir which passes gpg --verify seal vpatch_file;
  • For each member vpatch_file of vpatch_file_list, every corresponding seal seal in seal_dir passes gpg --verify seal vpatch_file.

If the above conditions are not met, the procedure returns data indicating error.

diff: The interface is the procedure

(diff a b out)

where a and b are pathname designators (possibly pointing to directories), and out is an output stream. The procedure calculates the diff of a to b, and writes this information to out. If the calculation and write complete, the procedure returns nil, and otherwise returns data indicating error.

patch: The interface is the procedure

(patch in d)

where in is an input stream and d is a pathname designator. The procedure reads the entire contents of in, interpreting the contents as a patch, and attempts to apply the patch to the file(s) located at d. If the interpretation and patch succeed, returns nil, and otherwise returns data indicating error.

And that's it for the interfaces. To create the skeleton directory structure, use the genesis vpatch and seal below:

  1. post to follow []
  2. the return data on error is not as straightforward, and I am not specifying it prematurely. []

Log Reading, Week 4

Tuesday, July 31st, 2018

This week sees 10 new log entries. Again not the expected 14. Hence I'm changing my base organizational approach and will be prioritizing the log reading above Keccak and other projects, to move towards the desired number.

Additionally, I plan to cease these semi-weekly progress reports, and simply read through the logs. (Simply, I'm not seeing much value besides informing me in what I already know: that I have a prioritization and effort-management problem). I'll also add some mechanism to the log summaries page to report statistics on entries created in the last week.

If you object to my approach, please voice your concerns below.

cl-keccak, Week 3

Monday, July 30th, 2018

With three weeks spent on the cl-keccak project, the thing is nearing completion. Currently there exists a (hopefully) working sponge, taking in an arbitrarily long vector of bits, and returning an equally arbitrarily long vector of bits. And after fixing two bugs in last week's post, my state transitions match those of s.mg keccak.

However, cl-keccak does not seem to agree with s.mg keccak on return hashes. For instance, if we place1

Long live the Republic!

in a file, ascii encoded, cl-keccak reports the hash as

18B75F434B28705333D18C57627085596EBF2AF68F52D3CF5796C01EAA682D4D5F259D2F89F9AEE082BC577B4DBEB8882D5F125DCE5FC977F701817487F06078

where the raw binary data (reported by xxd -b) is

00000000: 01001100 01101111 01101110 01100111 00100000 01101100  Long l
00000006: 01101001 01110110 01100101 00100000 01110100 01101000  ive th
0000000c: 01100101 00100000 01110010 01100101 01110000 01110101  e repu
00000012: 01100010 01101100 01101001 01100011 00100001 00001010  blic!.

Whereas s.mg keccak (taken from vtools) reports

dc3c4ed4bcbdc55d0917cbea51272f30b0d0dfa5d029100871e383be39568cec30afd298878a7d7f51ce5bad6bc01d651adf1ac5355652cf623d55b9d7da97dc

for the same file. So, I'm going to put the current state of my work below, and attempt to hash out the details this week in the logs.

As for parameters, cl-keccak uses

  • 6 for the Keccak L parameter
  • 1600 for the width
  • 1344 for the bitrate
  • 512 for the output bits

The primary function, keccak-sponge, takes a bit-vector as input and returns a bit-vector as output. At this level, there are no endianness issues whatsoever.

When interfacing with the disk, cl-keccak uses read-byte, which on my machine reads bits in 8 at a time, returning an integer as an (unsigned-byte 8). cl-keccak then converts this integer into a bit-vector which is 8 bits long, creating a little-endian representation of the integer. Ideally, I would like be able to read from the disk a single bit at the time, but as far as I am aware, this is not possible (and not meaningful on a byte-addressed architecture). Hence cl-keccak relies on the system to consistently interpret stored bytes as the same integer on differing hardware architectures.

Finally for this week, here is the current state of the program2:

package.lisp:

(defpackage "CL-KECCAK"
  (:use "COMMON-LISP" "CL-USER")
  (:export keccak-sponge))

bits.lisp:

(in-package "CL-KECCAK")

(defun bit-chunk (bit-vector chunk-size)
  (assert (= 0 (mod (length bit-vector) chunk-size)))
  (let ((chunks '()))
    (dotimes (c (/ (length bit-vector) chunk-size))
      (setq chunks (append chunks (list (subseq bit-vector
                                                (* c chunk-size)
                                                (* (1+ c) chunk-size))))))
    chunks))

(defun bit-pad-right (bv n)
  (do ((x (coerce bv 'list) (append x '(0))))
      ((>= (length x) n)
       (coerce x 'simple-bit-vector))))

(defun bit-pad-right-and-chunk (bit-vector chunk-size)
  (bit-chunk (bit-pad-right bit-vector
                            (* chunk-size (ceiling (length bit-vector)
                                                   chunk-size)))
             chunk-size))

(defun concatenate-bit-vectors (bit-vector-list)
  (reduce #'(lambda (a b) (concatenate 'simple-bit-vector a b))
          bit-vector-list))

(defun bit-vector-to-integer (bv)
  (reduce #'(lambda (a b) (+ a (* 2 b)))
          bv
          :from-end t))

(defun integer-to-bit-vector (n)
  (labels ((bit-array-iter (n array)
             (if (zerop n)
                 array
                 (multiple-value-bind (q r)
                     (floor n 2)
                   (bit-array-iter q
                                   (append array (list r)))))))
    (bit-pad-right (bit-array-iter n '()) 8)))

(defun file-to-bit-vector (filepath)
  (with-open-file (f filepath :direction :input :element-type 'bit)
    (concatenate-bit-vectors
     (mapcar #'integer-to-bit-vector
             (let ((s (make-sequence 'list (file-length f))))
               (read-sequence s f)
               s)))))

cl-keccak.lisp:

(in-package "CL-KECCAK")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; configure the keccak_L parameter here

(defconstant +keccak_L+ 6)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; magic numbers

(defconstant +row-size+ 5)
(defconstant +column-size+ 5)
(defconstant +lane-size+ (expt 2 +keccak_L+))
(defconstant +keccak-width+ (* +row-size+ +column-size+ +lane-size+))
(defconstant +round-quantity+ (+ 12 (* 2 +keccak_L+)))

(defparameter *default-bitrate* 1344)
(defparameter *default-output-bits* 512)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lanes

;; definition of a lane
(deftype lane () `(simple-bit-vector ,+lane-size+))

;; instantiation lanes
(defun make-lane ()
  (make-sequence 'lane +lane-size+ :initial-element 0))

(defun copy-lane (lane)
  (make-array `(,+lane-size+) :element-type 'bit
              :initial-contents lane))

;; basic operations on lanes
(defun lane-and (a b)
  (declare (type lane a b))
  (bit-and a b))

(defun lane-xor (a b)
  (declare (type lane a b))
  (bit-xor a b))

(defun lane-not (a)
  (declare (type lane a))
  (bit-not a))

(defun lane-rot (a n)
  (let* ((rtn (make-lane)))
    (dotimes (z +lane-size+)
      (setf (aref rtn (mod (+ z n) +lane-size+))
            (aref a z)))
    rtn))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; magic lanes

(defconstant +round-constants+
  (let ((magic
         '(#*1000000000000000000000000000000000000000000000000000000000000000
           #*0100000100000001000000000000000000000000000000000000000000000000
           #*0101000100000001000000000000000000000000000000000000000000000001
           #*0000000000000001000000000000000100000000000000000000000000000001
           #*1101000100000001000000000000000000000000000000000000000000000000
           #*1000000000000000000000000000000100000000000000000000000000000000
           #*1000000100000001000000000000000100000000000000000000000000000001
           #*1001000000000001000000000000000000000000000000000000000000000001
           #*0101000100000000000000000000000000000000000000000000000000000000
           #*0001000100000000000000000000000000000000000000000000000000000000
           #*1001000000000001000000000000000100000000000000000000000000000000
           #*0101000000000000000000000000000100000000000000000000000000000000
           #*1101000100000001000000000000000100000000000000000000000000000000
           #*1101000100000000000000000000000000000000000000000000000000000001
           #*1001000100000001000000000000000000000000000000000000000000000001
           #*1100000000000001000000000000000000000000000000000000000000000001
           #*0100000000000001000000000000000000000000000000000000000000000001
           #*0000000100000000000000000000000000000000000000000000000000000001
           #*0101000000000001000000000000000000000000000000000000000000000000
           #*0101000000000000000000000000000100000000000000000000000000000001
           #*1000000100000001000000000000000100000000000000000000000000000001
           #*0000000100000001000000000000000000000000000000000000000000000001
           #*1000000000000000000000000000000100000000000000000000000000000000
           #*0001000000000001000000000000000100000000000000000000000000000001)))
    (make-array '(24)
                :element-type 'lane
                :initial-contents
                (mapcar #'(lambda (x) (subseq x 0 +lane-size+))
                        magic))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; states

(deftype state () `(array lane (,+row-size+ ,+column-size+)))

(defun make-state ()
  (make-array `(,+row-size+ ,+column-size+)
              :element-type 'lane
              :initial-element (make-lane)))

(defun lane (a x y)
  (declare (type state a)
           (type fixnum x y))
  (aref a (mod x +row-size+) (mod y +column-size+)))

(defmethod set-lane (a x y L)
  (setf (aref a (mod x +row-size+) (mod y +column-size+))
        L))

(defsetf lane set-lane)

(defun copy-state (state)
  (let ((s (make-array `(,+row-size+ ,+column-size+)
                       :initial-element (make-lane)
                       :element-type 'lane)))
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane s x y)
              (copy-lane (lane state x y)))))
    s))

(defun state-linearize (state &optional
                                (start 0)
                                (end +keccak-width+))
  (let ((r '()))
    (dotimes (y +column-size+)
      (dotimes (x +row-size+)
        (setq r (append r (list (lane state x y))))))
    (subseq (concatenate-bit-vectors r)
            start
            end)))

(defun state-xor (state bit-vector)
  (assert (<= (length bit-vector) +keccak-width+))
  (let ((s (copy-state state))
        (x 0)
        (y 0)
        (chunks (bit-pad-right-and-chunk bit-vector +lane-size+)))
    (dolist (c chunks)
      (setf (lane s x y)
            (lane-xor (lane state x y)
                      c))
      (setf x (mod (1+ x) +row-size+))
      (if (= 0 (mod x +row-size+))
          (setf y (mod (1+ x) +column-size+))))
    s))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; keccak round operations

(defmacro with-return-state (s &rest body)
  `(let ((,(first s) (if (= ,(length s) 2)
                         (copy-state ,(second s))
                         (make-state))))
     (progn ,@body)
     ,(first s)))

(defun theta (a)
  (with-return-state (b)
    (let* ((c (make-sequence '(vector lane) +row-size+
                             :initial-element (make-lane)))
           (d (make-sequence '(vector lane) +row-size+
                             :initial-element (make-lane))))
      (dotimes (x +row-size+)
        (setf (aref c x)
              (lane a x 0))
        (loop for y from 1 below +column-size+
           do (setf (aref c x)
                    (lane-xor (aref c x)
                              (lane a x y)))))
      (dotimes (x +row-size+)
        (setf (aref d x)
              (lane-xor (aref c (mod (- x 1) +row-size+))
                        (lane-rot (aref c (mod (+ x 1) +row-size+))
                                  1)))
        (dotimes (y +column-size+)
          (setf (lane b x y)
                (lane-xor (lane a x y)
                          (aref d x))))))))

(defun rho (a)
  (with-return-state (b)
    (setf (lane b 0 0) (lane a 0 0))
    (let ((x 1) (y 0))
      (dotimes (q 24)
        (setf (lane b x y)
              (lane-rot (lane a x y)
                        (/ (* (+ q 1)
                              (+ q 2))
                           2)))
        (psetq x y
               y (+ (* 2 x)
                    (* 3 y)))))))

(defun k-pi (a)
  (with-return-state (b)
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane b y (+ (* 2 x)
                           (* 3 y)))
              (lane a x y))))))

(defun chi (a)
  (with-return-state (b)
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane b x y)
              (lane-xor (lane a x y)
                        (lane-and (lane-not (lane a (+ x 1) y))
                                  (lane a (+ x 2) y))))))))

(defun iota (r a)
  (with-return-state (b a)
    (setf (lane b 0 0)
          (lane-xor (lane b 0 0)
                    (aref +round-constants+ r)))))

(defun keccak-permute (a)
  (with-return-state (b a)
    (dotimes (r +round-quantity+)
      (setq b (iota r (chi (k-pi (rho (theta b)))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sponge

(defun keccak-pad (bit-vector bitrate)
  (let ((bv-tmp (concatenate 'simple-bit-vector bit-vector #*1)))
    (concatenate 'simple-bit-vector
                 (bit-pad-right bv-tmp (1- (* bitrate
                                              (1+ (floor (length bv-tmp)
                                                         bitrate)))))
                 #*1)))

(defun keccak-absorb (bit-vector bitrate)
  (assert (<= bitrate +keccak-width+))
  (with-return-state (s)
    (dolist (c (bit-chunk (keccak-pad bit-vector bitrate) bitrate))
      (setq s (keccak-permute (state-xor s c))))))

(defun keccak-squeeze (state bitrate output-bit-quantity)
  (assert (<= bitrate +keccak-width+))
  (multiple-value-bind (full-blocks remaining-bits)
      (floor output-bit-quantity bitrate)
    (concatenate-bit-vectors
     (mapcar (lambda (x)
               (setq state (keccak-permute state))
               (state-linearize state 0 x))
             (append (make-sequence 'list full-blocks
                                    :initial-element bitrate)
                     (if (zerop remaining-bits)
                         '()
                         (list remaining-bits)))))))

(defun keccak-sponge (input-bit-vector &optional
                                         (bitrate *default-bitrate*)
                                         (output-bits *default-output-bits*))
  (keccak-squeeze (keccak-absorb input-bit-vector bitrate)
                  bitrate
                  output-bits))

(defun keccak-hash-file (filepath)
  (write-to-string (bit-vector-to-integer (keccak-sponge (file-to-bit-vector filepath)
                                                         *default-bitrate*
                                                         *default-output-bits*))
                   :base 16))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; for use as an executable

(defun main ()
  (let ((args #+sbcl (cdr sb-ext:*posix-argv*)
              #+ccl (cdr ccl:*command-line-argument-list*)))
    (princ (keccak-hash-file (first args)))))

cl-keccak-tests.lisp:

(in-package "CL-KECCAK")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utility functions for moving between integers and lanes
;; these are not used in cl-keccak proper. rather, they are
;; for testing and generating the round constants


(defun bit-truncate-right (bv n)
  (subseq bv 0 n))

(defun integer-to-lane (n)
  (labels ((bit-array-iter (n array)
             (if (zerop n)
                 array
                 (multiple-value-bind (q r)
                     (floor n 2)
                   (bit-array-iter q
                                   (append array (list r)))))))
    (bit-truncate-right (bit-pad-right (bit-array-iter n '())
                                       +lane-size+)
                        +lane-size+)))

(defun lane-to-integer (bv)
  (reduce #'(lambda (a b) (+ a (* 2 b)))
          bv
          :from-end t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; code used to generate the magic lanes.
;; this code is retained for user verification.
;; numbers used to generate the lanes can be found here:
;; https://keccak.team/keccak_specs_summary.html#roundConstants

;; (defparameter *magic-constants*
;;   (make-array '(24)
;;               :element-type 'lane
;;               :initial-contents
;;               (mapcar #'integer-to-lane
;;                       '(#x0000000000000001
;;                         #x0000000000008082
;;                         #x800000000000808a
;;                         #x8000000080008000
;;                         #x000000000000808b
;;                         #x0000000080000001
;;                         #x8000000080008081
;;                         #x8000000000008009
;;                         #x000000000000008a
;;                         #x0000000000000088
;;                         #x0000000080008009
;;                         #x000000008000000a
;;                         #x000000008000808b
;;                         #x800000000000008b
;;                         #x8000000000008089
;;                         #x8000000000008003
;;                         #x8000000000008002
;;                         #x8000000000000080
;;                         #x000000000000800a
;;                         #x800000008000000a
;;                         #x8000000080008081
;;                         #x8000000000008080
;;                         #x0000000080000001
;;                         #x8000000080008008))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedures for making states

(defun make-state-using-lane-generator (nullary-lane-generator)
  (with-return-state (a)
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane a x y) (funcall nullary-lane-generator))))))

(defun make-ascending-state ()
  (make-state-using-lane-generator
   (let ((b -1))
     (lambda ()
       (integer-to-lane (incf b))))))

(defun make-randomized-state ()
  (make-state-using-lane-generator
   (lambda () (integer-to-lane (random (expt 2 +lane-size+))))))

(defun make-bit-ascending-state ()
  (make-state-using-lane-generator
   (let ((b 0))
     (lambda () (integer-to-lane (if (= b 0) (incf b) (setq b (expt 2 b))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedures for testing states

(defun diff-states (state1 state2)
  (let ((diff '()))
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (if (not (equal (lane state1 x y)
                        (lane state2 x y)))
            (setq diff (append diff (list (cons x y)))))))
    diff))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; printing the state

(defun print-state (a &optional (stream t))
  (let ((fmt-str (format nil "~~{~~~d,'0X~~^ ~~}"
                         (max 0 (/ +lane-size+ 4)))))
    (dotimes (y +column-size+)
      (format stream fmt-str (mapcar #'(lambda (x) (lane-to-integer (lane a x y)))
                                     '(0 1 2 3 4)))
      (format stream "~%"))))

(defun print-readable-state (a &optional (stream t))
  (let ((fmt-str (format nil "(~~{#x~~~d,'0X~~^ ~~})"
                         (max 0 (/ +lane-size+ 4)))))
    (format stream "#2A(")
    (dotimes (x +row-size+)
      (format stream fmt-str (mapcar #'(lambda (y) (lane-to-integer (lane a x y)))
                                     '(0 1 2 3 4)))
      (format stream
              (if (= x (1- +row-size+)) ")" "~%    ")))))

(defun read-printed-state (stream)
  (with-return-state (b)
    (let ((a (read stream)))
      (dotimes (x +row-size+)
        (dotimes (y +column-size+)
          (setf (lane b x y)
                (integer-to-lane (aref a x y))))))))

(defun print-keccak-permute (state stream)
  (format stream ";; Initial state:~%")
  (print-state state stream)
  (let ((maps `(("theta" . ,#'theta)
                ("rho" . ,#'rho)
                ("pi" . ,#'k-pi)
                ("chi" . ,#'chi))))
    (dotimes (r +round-quantity+)
      (let ((maps (append maps `(("iota" . ,#'(lambda (a) (iota r a)))))))
        (format stream "~%~%~%;; Round ~d~%~%" r)
        (dolist (m maps)
          (format stream "~%;; After ~a:~%" (car m))
          (print-state (setq state
                             (funcall (cdr m) state))
                       stream)))))
  (format stream "~%~%~%;; Final state:~%")
  (print-state state stream))

(defun test-permute-and-write (state output-file)
  (with-open-file (s output-file :direction :output :if-exists :supersede)
    (print-keccak-permute state s)))

Makefile:

LISP=sbcl

all: ${LISP}

sbcl:
    sbcl --no-sysinit --no-userinit --disable-debugger \
        --load package.lisp \
        --load bits.lisp \
        --load cl-keccak.lisp \
        --eval "(sb-ext:save-lisp-and-die #p\"cl-keccak\" :toplevel #'cl-keccak::main :executable t)"

ccl:
    ccl --no-init \
        --load package.lisp \
        --load bits.lisp \
        --load cl-keccak.lisp
        --eval "(ccl:save-application #P\"cl-keccak\" :toplevel-function #'cl-keccak::main :prepend-kernel t)"
  1. no trailing newline []
  2. I am not placing these as files or signing them on purpose. This weeks release is very likely broken []

Log Reading, Week 3

Wednesday, July 25th, 2018

So this week's post is late. But that lateness, coupled with my continuing inability to keep up with the log reading pace, has started to get some nice lessons through my thick skull!1

This week we are up to 75 entries, 11 more than the last. While I honestly believe the past two weeks were far more busy for fiat esthlos than usual, I'm still planning for the worst. So the new plan is two per day, which should be far more sustainable. And anyways, the plan for my reading to speed up simply didn't happen. As Mircea intuits, the logs are information dense2 , and the brain can only process at such and such a rate. My attempts to read faster simply resulted in confusion.

Next week I'll try giving some highlights in the log reading update. Until then!

  1. Here are a few. (1). It's not enough to vaguely plan things out and hope I get done what needs to be done. I need to lay out everything that needs to be accomplished well before the deadline. (2) Things need to be prioritized. Just because one Emacs keybinding is broken doesn't mean that I need to deal with it now. (3) There must be time allocated to the unanticipated and fuckups in general. (4) Plans and scheduling follow through to the end. If I just plan to finish my weekly log reading on Sunday, then guess what: there won't be time for a post! Truly, it's remarkable that I managed to get this far in life while not understanding these kind of things! []
  2. Though I have read enough at this point to have an opinion on this density, and I think an unfortunate that much of it results from people not considering the minds of others and making unnecessary assumptions on all kinds of things. []

cl-keccak 2 Week Progress Report

Tuesday, July 24th, 2018

Two weeks ago, I determined that the writing of a Republican1 Common Lisp Keccak is the best path forward for esthlos-v. So what has the past two weeks bought us?

Well, it has bought two files. The first contains procedures to define a Keccak state and permute it in the ordained methods:

(defpackage "CL-KECCAK"
  (:use "COMMON-LISP" "CL-USER"))

(in-package "CL-KECCAK")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; configure the keccak_L parameter here

(defconstant +keccak_L+ 6)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; magic numbers

(defconstant +row-size+ 5)
(defconstant +column-size+ 5)
(defconstant +lane-size+ (expt 2 +keccak_L+))
(defconstant +round-quantity+ (+ 12 (* 2 +keccak_L+)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lanes

(deftype lane () `(simple-bit-vector ,+lane-size+))

(defun make-lane ()
  (make-sequence 'lane +lane-size+ :initial-element 0))

(defun lane-and (a b)
  (declare (type lane a b))
  (bit-and a b))

(defun lane-xor (a b)
  (declare (type lane a b))
  (bit-xor a b))

(defun lane-not (a)
  (declare (type lane a))
  (bit-not a))

(defun lane-rot (a n)
  (let* ((rtn (make-lane)))
    (dotimes (z +lane-size+)
      (setf (aref rtn (mod (+ z n) +lane-size+))
            (aref a z)))
    rtn))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; magic lanes

(defconstant +round-constants+
  (let ((magic
         '(#*1000000000000000000000000000000000000000000000000000000000000000
           #*0100000100000001000000000000000000000000000000000000000000000000
           #*0101000100000001000000000000000000000000000000000000000000000001
           #*0000000000000001000000000000000100000000000000000000000000000001
           #*1101000100000001000000000000000000000000000000000000000000000000
           #*1000000000000000000000000000000100000000000000000000000000000000
           #*1000000100000001000000000000000100000000000000000000000000000001
           #*1001000000000001000000000000000000000000000000000000000000000001
           #*0101000100000000000000000000000000000000000000000000000000000000
           #*0001000100000000000000000000000000000000000000000000000000000000
           #*1001000000000001000000000000000100000000000000000000000000000000
           #*0101000000000000000000000000000100000000000000000000000000000000
           #*1101000100000001000000000000000100000000000000000000000000000000
           #*1101000100000000000000000000000000000000000000000000000000000001
           #*1001000100000001000000000000000000000000000000000000000000000001
           #*1100000000000001000000000000000000000000000000000000000000000001
           #*0100000000000001000000000000000000000000000000000000000000000001
           #*0000000100000000000000000000000000000000000000000000000000000001
           #*0101000000000001000000000000000000000000000000000000000000000000
           #*0101000000000000000000000000000100000000000000000000000000000001
           #*1000000100000001000000000000000100000000000000000000000000000001
           #*0000000100000001000000000000000000000000000000000000000000000001
           #*1000000000000000000000000000000100000000000000000000000000000000
           #*0001000000000001000000000000000100000000000000000000000000000001)))
    (make-array '(24)
                :element-type 'lane
                :initial-contents
                (mapcar #'(lambda (x) (subseq x 0 +lane-size+))
                        magic))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; states

(deftype state () `(array lane (,+row-size+ ,+column-size+)))

(defun make-state ()
  (make-array `(,+row-size+ ,+column-size+)
              :element-type 'lane
              :initial-element (make-lane)))

(defun lane (a x y)
  (declare (type state a)
           (type fixnum x y))
  (aref a (mod x +row-size+) (mod y +column-size+)))

(defmethod set-lane (a x y L)
  (setf (aref a (mod x +row-size+) (mod y +column-size+))
        L))

(defsetf lane set-lane)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; keccak round operations

(defmacro with-return-state (s &rest body)
  `(let ((,(first s) ,(if (= (length s) 2)
                          (second s)
                          (make-state))))
     (progn ,@body)
     ,(first s)))

(defun theta (a)
  (with-return-state (b)
    (let* ((c (make-sequence '(vector lane) +row-size+
                             :initial-element (make-lane)))
           (d (make-sequence '(vector lane) +row-size+
                             :initial-element (make-lane))))
      (dotimes (x +row-size+)
        (setf (aref c x)
              (lane a x 0))
        ;;(format t "~a~%" (aref c x))
        (loop for y from 1 below +column-size+
           do (setf (aref c x)
                    (lane-xor (aref c x)
                              (lane a x y)))))
      ;;(format t "~{~a~%~^~}~%" (coerce (copy-seq c) 'list))
      (dotimes (x +row-size+)
        (setf (aref d x)
              (lane-xor (aref c (mod (- x 1) +row-size+))
                        (lane-rot (aref c (mod (+ x 1) +row-size+))
                                  1)))
        (dotimes (y +column-size+)
          (setf (lane b x y)
                (lane-xor (lane a x y)
                          (aref d x))))))))


(defun rho (a)
  (with-return-state (b)
    (let ((x 1) (y 0))
      (dotimes (q 24)
        (setf (lane b x y)
              (lane-rot (lane a x y)
                        (/ (* (+ q 1)
                              (+ q 2))
                           2)))
        (psetq x y
               y (+ (* 2 x)
                    (* 3 y)))))))

(defun consts ()
  (let ((a (make-array '(5 5)))
        (b (make-array '(5 5))))
    (let ((x 1) (y 0))
      (dotimes (q 24)
        (setf (aref a (mod x 5) (mod y 5))
              (/ (* (+ q 1)
                    (+ q 2))
                 2))
        (psetq x y
               y (+ (* 2 x)
                    (* 3 y)))))
    (dotimes (x 5)
      (dotimes (y 5)
        (setf (aref b x y)
              (aref a (mod (+ x 3) 5) (mod (+ y 3) 5)))))
    b))

(defun pi (a)
  (with-return-state (b)
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane b x y)
              (lane a y (+ (* 2 x)
                           (* 3 y))))))))

(defun chi (a)
  (with-return-state (b)
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane b x y)
              (lane-xor (lane a x y)
                        (lane-and (lane-not (lane a (+ x 1) y))
                                  (lane a (+ x 2) y))))))))

(defun iota (r a)
  (with-return-state (b a)
    (setf (lane b 0 0)
          (lane-xor (lane b 0 0)
                    (aref +round-constants+ r)))))

(defun keccak-permute (a)
  (with-return-state (b a)
    (dotimes (r +round-quantity+)
      (setq b (iota r (chi (pi (rho (theta b)))))))))

You will notice that the code defines lanes as simple-bit-vectors, and there is no interpretation of these lanes as numbers in any sense. Hence endianness troubles are eliminated, at the cost of a linear-time vector rotation2 .

A second file contains a few goodies, including methods for converting integers to lanes (little-endian) and back again, and methods for visualizing the Keccak state:

(in-package "CL-KECCAK")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utility functions for moving between integers and lanes
;; these are not used in cl-keccak proper. rather, they are
;; for testing and generating the round constants

(defun bit-pad-right (bv n)
  (do ((x (coerce bv 'list) (append x '(0))))
      ((>= (length x) n)
       (coerce x 'simple-bit-vector))))

(defun bit-truncate-right (bv n)
  (subseq bv 0 n))

(defun integer-to-lane (n)
  (labels ((bit-array-iter (n array)
             (if (zerop n)
                 array
                 (multiple-value-bind (q r)
                     (floor n 2)
                   (bit-array-iter q
                                   (append array (list r)))))))
    (bit-truncate-right (bit-pad-right (bit-array-iter n '())
                                       +lane-size+)
                        +lane-size+)))

(defun lane-to-integer (bv)
  (reduce #'(lambda (a b) (+ a (* 2 b)))
          bv
          :from-end t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; code used to generate the magic lanes.
;; this code is retained for user verification.
;; numbers used to generate the lanes can be found here:
;; https://keccak.team/keccak_specs_summary.html#roundConstants

;; (defparameter *magic-constants*
;;   (make-array '(24)
;;               :element-type 'lane
;;               :initial-contents
;;               (mapcar #'integer-to-lane
;;                       '(#x0000000000000001
;;                         #x0000000000008082
;;                         #x800000000000808a
;;                         #x8000000080008000
;;                         #x000000000000808b
;;                         #x0000000080000001
;;                         #x8000000080008081
;;                         #x8000000000008009
;;                         #x000000000000008a
;;                         #x0000000000000088
;;                         #x0000000080008009
;;                         #x000000008000000a
;;                         #x000000008000808b
;;                         #x800000000000008b
;;                         #x8000000000008089
;;                         #x8000000000008003
;;                         #x8000000000008002
;;                         #x8000000000000080
;;                         #x000000000000800a
;;                         #x800000008000000a
;;                         #x8000000080008081
;;                         #x8000000000008080
;;                         #x0000000080000001
;;                         #x8000000080008008))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedures for making states

(defun make-state-using-lane-generator (nullary-lane-generator)
  (with-return-state (a)
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (setf (lane a x y) (funcall nullary-lane-generator))))))

(defun make-ascending-state ()
  (make-state-using-lane-generator
   (let ((b -1))
     (lambda ()
       (integer-to-lane (incf b))))))

(defun make-randomized-state ()
  (make-state-using-lane-generator
   (lambda () (integer-to-lane (random (expt 2 +lane-size+))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedures for testing states

(defun diff-states (state1 state2)
  (let ((diff '()))
    (dotimes (x +row-size+)
      (dotimes (y +column-size+)
        (if (not (equal (lane state1 x y)
                        (lane state2 x y)))
            (setq diff (append diff (list (cons x y)))))))
    diff))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; printing the state

(defun print-state (a &optional (stream t))
  (let ((fmt-str (format nil "~~{~~~d,'0X~~^ ~~}"
                         (max 0 (/ +lane-size+ 4)))))
    (dotimes (x +row-size+)
      (format stream fmt-str (mapcar #'(lambda (y) (lane-to-integer (lane a x y)))
                                     '(0 1 2 3 4)))
      (format stream "~%"))))

(defun print-readable-state (a &optional (stream t))
  (let ((fmt-str (format nil "(~~{#x~~~d,'0X~~^ ~~})"
                         (max 0 (/ +lane-size+ 4)))))
    (format stream "#2A(")
    (dotimes (x +row-size+)
      (format stream fmt-str (mapcar #'(lambda (y) (lane-to-integer (lane a x y)))
                                     '(0 1 2 3 4)))
      (format stream
              (if (= x (1- +row-size+)) ")" "~%    ")))))

(defun read-printed-state (stream)
  (with-return-state (b)
    (let ((a (read stream)))
      (dotimes (x +row-size+)
        (dotimes (y +column-size+)
          (setf (lane b x y)
                (integer-to-lane (aref a x y))))))))

(defun print-keccak-permute (state stream)
  (format stream ";; Initial state:~%")
  (print-readable-state state stream)
  (let ((maps `(("theta" . ,#'theta)
                ("rho" . ,#'rho)
                ("pi" . ,#'pi)
                ("chi" . ,#'chi))))
    (dotimes (r +round-quantity+)
      (let ((maps (append maps `(("iota" . ,#'(lambda (a) (iota r a)))))))
        (format stream "~%~%~%;; Round ~d~%~%" r)
        (dolist (m maps)
          (format stream "~%;; After ~a:~%" (car m))
          (print-readable-state (setq state
                                      (funcall (cdr m) state))
                                stream)))))
  (format stream "~%~%~%;; Final state:~%")
  (print-readable-state state stream))

(with-open-file (s "tests.txt" :direction :output :if-exists :supersede)
  (print-keccak-permute (make-state) s))

Let's have some fun with tests. Here are the first three rounds of operating on the null state:

;; Initial state:
#2A((#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000))


;; Round 0


;; After theta:
#2A((#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000))
;; After rho:
#2A((#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000))
;; After pi:
#2A((#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000))
;; After chi:
#2A((#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000))
;; After iota:
#2A((#x0000000000000001 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000))


;; Round 1


;; After theta:
#2A((#x0000000000000001 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000001 #x0000000000000001 #x0000000000000001 #x0000000000000001 #x0000000000000001)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000002 #x0000000000000002 #x0000000000000002 #x0000000000000002 #x0000000000000002))
;; After rho:
#2A((#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000002 #x0000000000000000 #x0000000000000400 #x0000200000000000 #x0000000000000004)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000)
    (#x0000000010000000 #x0000000000200000 #x0000010000000000 #x0000000000000200 #x0000000000008000))
;; After pi:
#2A((#x0000000000000000 #x0000200000000000 #x0000000000000000 #x0000000000000000 #x0000010000000000)
    (#x0000000000000000 #x0000000000000002 #x0000000000000000 #x0000000000000000 #x0000000000008000)
    (#x0000000000000000 #x0000000000000400 #x0000000000000000 #x0000000000000000 #x0000000000200000)
    (#x0000000000000000 #x0000000000000004 #x0000000000000000 #x0000000000000000 #x0000000000000200)
    (#x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000000000000 #x0000000010000000))
;; After chi:
#2A((#x0000000000000000 #x0000200000000400 #x0000000000000000 #x0000000000000000 #x0000010000200000)
    (#x0000000000000000 #x0000000000000006 #x0000000000000000 #x0000000000000000 #x0000000000008200)
    (#x0000000000000000 #x0000000000000400 #x0000000000000000 #x0000000000000000 #x0000000010200000)
    (#x0000000000000000 #x0000200000000004 #x0000000000000000 #x0000000000000000 #x0000010000000200)
    (#x0000000000000000 #x0000000000000002 #x0000000000000000 #x0000000000000000 #x0000000010008000))
;; After iota:
#2A((#x0000000000008082 #x0000200000000400 #x0000000000000000 #x0000000000000000 #x0000010000200000)
    (#x0000000000000000 #x0000000000000006 #x0000000000000000 #x0000000000000000 #x0000000000008200)
    (#x0000000000000000 #x0000000000000400 #x0000000000000000 #x0000000000000000 #x0000000010200000)
    (#x0000000000000000 #x0000200000000004 #x0000000000000000 #x0000000000000000 #x0000010000000200)
    (#x0000000000000000 #x0000000000000002 #x0000000000000000 #x0000000000000000 #x0000000010008000))


;; Round 2


;; After theta:
#2A((#x000000001001048C #x000020001001800E #x000000001001840E #x000000001001840E #x000001001021840E)
    (#x0000210020608C82 #x0000210020608C84 #x0000210020608C82 #x0000210020608C82 #x0000210020600E82)
    (#x000042000000860E #x000042000000820E #x000042000000860E #x000042000000860E #x000042001020860E)
    (#x0000000030210404 #x0000200030210400 #x0000000030210404 #x0000000030210404 #x0000010030210604)
    (#x0000630000410B00 #x0000630000410B02 #x0000630000410B00 #x0000630000410B00 #x0000630010418B00))
;; After rho:
#2A((#x0000000000000000 #x001800E000020001 #x00000000800C2070 #x03081C0000000020 #x0400408610380000)
    (#x0000420040C11904 #x0000000000000000 #x0084008182320800 #x119040000420040C #x0000840081803A08)
    (#x8000108000002183 #x0010800000208380 #x0430700002100000 #x2100000043070000 #xC0000840020410C1)
    (#x0302104040000000 #x0000001000181082 #x0060420808000000 #x0006042080800000 #x0400000100302106)
    (#x0002085800000318 #x30000410B0200006 #x2085800000318000 #x00630000410B0000 #x18C0041062C00000))
;; After pi:
#2A((#x0000000000000000 #x119040000420040C #x0010800000208380 #x0400000100302106 #x2085800000318000)
    (#x00000000800C2070 #x0000420040C11904 #x2100000043070000 #x0000001000181082 #x18C0041062C00000)
    (#x0400408610380000 #x0084008182320800 #x8000108000002183 #x0006042080800000 #x30000410B0200006)
    (#x001800E000020001 #x0000840081803A08 #x0430700002100000 #x0302104040000000 #x00630000410B0000)
    (#x03081C0000000020 #x0000000000000000 #xC0000840020410C1 #x0060420808000000 #x0002085800000318))
;; After chi:
#2A((#x0400408610300000 #x111440818612040C #x801090800020A203 #x0406042180B02106 #x0085800090118006)
    (#x00180060800E2071 #x0000C60041412B0C #x2530600041170000 #x0300105040181082 #x18A3041023CB0000)
    (#x07005C8610380020 #x0084008182320800 #x400018C000043142 #x0066462888800000 #x30000C48B020031E)
    (#x001800E000020001 #x1190C40085A03E04 #x0420F00002308300 #x0702104140302106 #x20E68000413A8000)
    (#x03081C00800C2050 #x0000020040C11900 #xE1000840410310C1 #x0060421808081080 #x18420C4862C00318))
;; After iota:
#2A((#x840040861030808A #x111440818612040C #x801090800020A203 #x0406042180B02106 #x0085800090118006)
    (#x00180060800E2071 #x0000C60041412B0C #x2530600041170000 #x0300105040181082 #x18A3041023CB0000)
    (#x07005C8610380020 #x0084008182320800 #x400018C000043142 #x0066462888800000 #x30000C48B020031E)
    (#x001800E000020001 #x1190C40085A03E04 #x0420F00002308300 #x0702104140302106 #x20E68000413A8000)
    (#x03081C00800C2050 #x0000020040C11900 #xE1000840410310C1 #x0060421808081080 #x18420C4862C00318))

For comparison, here are the first three rounds of the empty state package with Diana Coman's Keccak:

Same, with lanes as 64-bit words:
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000

 -- Round 0 --

After theta:
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
After rho:
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
After pi:
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
After chi:
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
After iota:
0000000000000001 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000

 -- Round 1 --

After theta:
0000000000000001 0000000000000001 0000000000000000 0000000000000000 0000000000000002
0000000000000000 0000000000000001 0000000000000000 0000000000000000 0000000000000002
0000000000000000 0000000000000001 0000000000000000 0000000000000000 0000000000000002
0000000000000000 0000000000000001 0000000000000000 0000000000000000 0000000000000002
0000000000000000 0000000000000001 0000000000000000 0000000000000000 0000000000000002
After rho:
0000000000000001 0000000000000002 0000000000000000 0000000000000000 0000000010000000
0000000000000000 0000100000000000 0000000000000000 0000000000000000 0000000000200000
0000000000000000 0000000000000400 0000000000000000 0000000000000000 0000010000000000
0000000000000000 0000200000000000 0000000000000000 0000000000000000 0000000000000200
0000000000000000 0000000000000004 0000000000000000 0000000000000000 0000000000008000
After pi:
0000000000000001 0000100000000000 0000000000000000 0000000000000000 0000000000008000
0000000000000000 0000000000200000 0000000000000000 0000200000000000 0000000000000000
0000000000000002 0000000000000000 0000000000000000 0000000000000200 0000000000000000
0000000010000000 0000000000000000 0000000000000400 0000000000000000 0000000000000000
0000000000000000 0000000000000000 0000010000000000 0000000000000000 0000000000000004
After chi:
0000000000000001 0000100000000000 0000000000008000 0000000000000001 0000100000008000
0000000000000000 0000200000200000 0000000000000000 0000200000000000 0000000000200000
0000000000000002 0000000000000200 0000000000000000 0000000000000202 0000000000000000
0000000010000400 0000000000000000 0000000000000400 0000000010000000 0000000000000000
0000010000000000 0000000000000000 0000010000000004 0000000000000000 0000000000000004
After iota:
0000000000008083 0000100000000000 0000000000008000 0000000000000001 0000100000008000
0000000000000000 0000200000200000 0000000000000000 0000200000000000 0000000000200000
0000000000000002 0000000000000200 0000000000000000 0000000000000202 0000000000000000
0000000010000400 0000000000000000 0000000000000400 0000000010000000 0000000000000000
0000010000000000 0000000000000000 0000010000000004 0000000000000000 0000000000000004

 -- Round 2 --

After theta:
0000700000600487 0000130010018C89 0000700020208606 000021000041840D 0000320030018B01
0000700000608404 0000230010218C89 0000700020200606 000001000041840C 0000220030210B01
0000700000608406 0000030010018E89 0000700020200606 000021000041860E 0000220030010B01
0000700010608004 0000030010018C89 0000700020200206 000021001041840C 0000220030010B01
0000710000608404 0000030010018C89 0000710020200602 000021000041840C 0000220030010B05
After rho:
0000700000600487 0000260020031912 80001C0008082181 00041840D0000210 01800C5808000190
0608404000070000 18C8900002300102 001C000808018180 06000000800020C2 20030210B0100002
0003800003042030 000C0040063A2400 0030300003800101 0000830C1C000042 0085808000110018
C100080000E00020 3191200000600200 3800101001030000 2002083081800004 00220030010B0100
C400018210100001 00000C0040063224 40000E20040400C0 0C00002100004184 08800C0042C14000
After pi:
0000700000600487 18C8900002300102 0030300003800101 2002083081800004 08800C0042C14000
00041840D0000210 20030210B0100002 0003800003042030 3191200000600200 40000E20040400C0
0000260020031912 001C000808018180 0000830C1C000042 00220030010B0100 C400018210100001
01800C5808000190 0608404000070000 000C0040063A2400 3800101001030000 0C00002100004184
80001C0008082181 06000000800020C2 0085808000110018 C100080000E00020 00000C0040063224
After chi:
0030500001E00486 38CA983082300106 08B0340041C14101 2002783081A00483 10488C0040D14100
00049840D3042220 11932210B0700202 40038E20070020F0 31953040D0600010 60030C30241400C2
0000A50434031950 003E0038090A8080 C400828E0C100043 0022263021081812 C41C018A18108081
01840C580E382590 3E08505001060000 040C0061063A6584 39801C4809030010 0A08402100074184
80859C8008192199 C700080080E020E2 008584804017321C 4100180008E801A1 06000C00C0063266
After iota:
8030500001E0840C 38CA983082300106 08B0340041C14101 2002783081A00483 10488C0040D14100
00049840D3042220 11932210B0700202 40038E20070020F0 31953040D0600010 60030C30241400C2
0000A50434031950 003E0038090A8080 C400828E0C100043 0022263021081812 C41C018A18108081
01840C580E382590 3E08505001060000 040C0061063A6584 39801C4809030010 0A08402100074184
80859C8008192199 C700080080E020E2 008584804017321C 4100180008E801A1 06000C00C0063266

(Note that Diana's states are transposes of mine, as she chose to use the y coordinate as the row index when printing). The careful reader will notice that my implementation is failing on rho of row 1; for instance, the (0,0) coordinate is set from 1 to 0, which is in clear violation of the reference. Well, I haven't figured out where my rho is going wrong. Perhaps you, reader, would lend a hand?

Edit: After discovering the problem in rho (no initial assignment of A[0][0] = a[0][0]) and also discovering a problem with pi (mixing up the X and Y with x and y), cl-keccak now exactly aligns with the Eucrypt test vectors! On to the sponge construction!

  1. meaning that transparency, correctness, and clarity of purpose are held above all else. []
  2. If I'm missing a constant-time vector shift operation, please let me know []

Log Reading, Week 2

Monday, July 16th, 2018

64 entries! The summaries project is 20 entries short for this week! What in the world happened?

Well, I could blame things on by fiat job, but we know where that leads. No: I knew these things were coming up; I knew that I would have to prioritize ruthlessly to make the summary target1 this week; and yet, I didn't.

So this week becomes another instance where I set a difficult yet surmountable bar, didn't bother to organize myself to meet that bar, and fell far short. As to the why, there are all kinds of answers, being the usual crowd of laziness, stupidity, or lack of will, but what does one do about these? I only hope that the more fearful part of the brain gets the message that my reputation is on the line, a lesson ill-learned in the land of socialist safety nets and participation awards2.

  1. all the while, chugging along at a Common Lisp Keccak. Which yes, has made good progress. Be on the lookout for a release within the next two weeks. []
  2. also known as diplomas []

Log Reading, Week 1

Sunday, July 8th, 2018

Last Sunday brought the public launch of the Trilema log summary project. The goal is to read 4 logs per day, to which I've had to add the practical cap of 2 hours per day1. I also have concern that much needed projects will eat into the log reading time. Certainly, all of this is a continuing lesson in priorities and pacing over time.

Currently the summaries exist for 54 dates. The target for this week will be 28 entries, 21 of them of older logs, bringing the project somewhere mid-April 2016, and the total to 82. I'm anticipating the reality of ending up off-target, and reassessing how many logs I can commit to per week over the next month or so.

There's also the matter of an esthlos-bot for reading out entries. The call could be something like

!e 2018 7 6 2

to print out the second entry of the 2018-07-06 log summary (that is, July 6th, 2018). It would be nice to also print a link to the log item in question, which could also facilitate tracking long-term conversations in the logs, with the cost of many additional cross-reference links.

In addition to the bot, a search feature will be needed as the summaries grow. I would expect the search to work through the bot as well as on the page, spitting out a text-paste with results.

The bot and search will have to wait, though, while I explicitly prioritize getting esthlos-v working properly.

esthlos-bot, esthlos-v...I need some better names!

  1. Generally I don't expect the 2 hour cap to be reached, and I also anticipate some speedup in reading as the project progresses. March 2016 has so far been a month of megalogs, coinciding with the the shifts occurring in the Republic at the time. []

Routes to Keccak in esthlos-v

Sunday, July 8th, 2018

For reasons amply put in the logs, esthlos-v needs a hashing mechanism, and the standard is Keccak. How can Keccak be attached to the Common Lisp esthlos-v? Really, it comes down to:

  1. Call out to a pre-existing Keccak implementation; or
  2. Write a Keccak implementation for Common Lisp.

Let's consider the options.

Option 1: Call out to a pre-existing Keccak implementation

The only Republican-signed Keccak implementation is smg-keccak, a piece of the EuCrypt library by Diana Coman. How could the smg-keccak be incorporated into esthlos-v? Well, again, there are two options:

  1. Make a new patch with esthlos-v_genesis and some node of the EuCrypt tree as parents.
  2. Build EuCrypt, rip out the non-Keccak code, and patch this code on to esthlos-v.

To 1: Some trouble with the smg-keccak patching prevents simply selecting a subset of the EuCrypt patchset to build only smg-keccak. Either the majority of EuCrypt must be pulled in, or a new patch must be created off of the smg-keccak branch to correct the trouble. I want esthlos-v to be as small1 and simple2 as possible, so pulling in all of EuCrypt is off the table. Creating a trivial new patch, though, is feasible; let's keep this in the back of our minds for now.

To 2: The trouble with this method is how it drops the history built into the EuCrypt smg-keccak patchset, introducing a heap of problems. For instance, dropping the history renders the best resource for understanding the code, Diana's excellent posts, a pain to match to the code. Basically, this approach smells rotten, and will not be pursued.

Details of smg-keccak incorporation aside, what would follow from said incorporation? smg-keccak is written in Ada, so the user of esthlos-v would need a working Ada build environment. If understanding of the code is desired, a working understanding of Ada would be needed as well. Besides, calling out to a common library is a flavor of dynamic soup, to be avoided when possible.

Outside of Ada, a quick search revealed an already existing Keccak for Common Lisp, written by some dweeb.3. Of course, to be signed, it must be deloused and understood, so while it can serve as a useful reference, it can be used as only that: a reference towards a new implementation.4

Option 2: Write a Keccak implementation for Common Lisp

The pluses of having a Common Lisp Keccak are mostly obvious. The use of a single language simplifies things, cutting down on both the requirements needed to get the thing running5 , and the knowledge needed to see how the thing works.

What about the downsides? Well, really the significant downside is the time and effort required to understand the operation of Keccak and implement it. But if smg-keccak was to be pulled into esthlos-v, then that would required a patch, which would need to be signed,6 and so the effort of understanding is unavoidable.7

So in the large, while the incorporation of smg-keccak into the esthlos-v might be the faster and less wasteful option, neither route to the incorporation outweighs the costs. Destroying the vtree structure creates the the "wtf is this, how does it work, and how did it come to be" problem, and branching off the EuCrypt tree still pulls in Ada as a dependency. The most natural cut, then, appears to be a Common Lisp Keccak.

Comments from the Lordship appreciated.

  1. "The practice is pervaded by the reassuring illusion that programs are just devices like any others, the only difference admitted being that their manufacture might require a new type of craftsmen, viz. programmers. From there it is only a small step to measuring "programmer productivity" in terms of "number of lines of code produced per month". This is a very costly measuring unit because it encourages the writing of insipid code, but today I am less interested in how foolish a unit it is from even a pure business point of view. My point today is that, if we wish to count lines of code, we should not regard them as "lines produced" but as "lines spent": the current conventional wisdom is so foolish as to book that count on the wrong side of the ledger." -Dijkstra []
  2. fits-in-head is a hard requirement []
  3. Warning: the choice of font may melt eyeballs []
  4. And there are those of us stuck in USGland, where the licensing of the thing is an issue. []
  5. aka the number of things which can break []
  6. An outstanding question of mine is whether signing a vpatch is a statement about the transformation of code outlined in the patch, or the state of the codebase once the patch is applied. []
  7. As usual. []

Trilema Log Reading

Sunday, July 1st, 2018

Reading through the logs of The Most Serene Republic, though rewarding and enjoyable, is not for the faint of heart. I'm often left wondering how anyone can make sense of the conversation, but certainly there are glimmers of real experts under the surface of madness.

Anyway, I've read enough to know that I want to keep reading---not only forwards, but backwards. So I built myself a little infrastructure, to develop the bigger view of what's going on:

TMSR Log Summaries

Not sure if it'll be of use to anyone but myself, but if I get a few "that wasn't about X, it was about Y!" spankings out of it, I'll consider it worthwhile.

My attempted pace will be to read 4 days of logs every day (3 older logs, and the present log). The average log takes me about 30 minutes to read (including following links), and there's a bit over 900 logs to catch up on, so I'll be caught up in 300 days, working 2 hours a day. Starting late is a bitch, ya know.

Perls Before Swine

Thursday, June 21st, 2018

The genius programmers Alphabet corp have censored what is possibly greatest lecture series on programming in existence. Act now and get a copy for yourself, before it's too late. The below snippet should be all you need.

import subprocess
import os

base_url = 'http://archive.org/download/MIT_Structure_of_Computer_Programs_1986/'

lectures1 = [base_url + 'lec' + str(number) + letter + '.mp4'
             for number in [1,2,3,4,5,7,8,9]
             for letter in ['a', 'b']]

lectures2 = [base_url + item + '.mp4'
             for item in ['lec6a', 'Lec6b', 'Lec10a', 'lec10b']]

for lecture in lectures1 + lectures2:
        if not os.path.exists(lecture[-9:]):
                subprocess.check_call(['wget', lecture])

FUCKGOATS: Some Thoughts and Minimal Tests

Monday, June 18th, 2018

The FUCKGOATS is an auditable True Random Number Generator produced by the infamous NSA. What does this mean?

Auditable

By not inspecting the tools on which your life and reputation rely, you are, without question, placing your trust in the manufacturers of those tools. Such trust is unavoidable, as survival is a joint effort, and is even desirable, the alternative being a lonely and painful solipsism. But not all forms of trust are equal; there is trust given consciously and willingly, and that given otherwise.

This distinction, of implicit and explicit trust, is a prime determinant in the status of master or slave, or along similar lines, of personhood and nonpersonhood. For we may take a reasonable measure of personhood, being true individuation of will, to be the degree to which implicit trust is avoided, and deliberate trust is achieved. Or on the flip side, the degree to which one is enslaved by a power may be measured by the level of implicit trust one is forced to place in that power, usually by threat of violence.

The implications quickly follow. For instance, we see that existence in the web of trust is a mandatory component of personhood, as without it you are operating with implicit trust, not trust by choice. That is to say, without the web of trust, the very possibility of true choice simply disappears.

And for another implication, you may see the existence of technologies which you must use but cannot trust (and no, it being "open source" is besides the point: do you trust someone who has understood the code?), as clear evidence of your slavery. It's that simple.

So as to the point of auditability, we understand that, any tool in which we do not place our conscious, informed trust (by trust in ourselves or through a trusted other), is a tool which amplifies our slavery. For those who aspire to personhood, the ability to audit a tool is an atomic and effective means to personal development.

And to those who say, "But esthlos, certainly it's not possible to place conscious trust in everything; I don't place trust in the asteroid belt that it will not hurl a meteor in my path tomorrow," note that you are correct, though missing the point: the degree to which your trust is explicit delimits the power of your will. Human will is somewhat limited, at present. (" Work is of two kinds: first, altering the position of matter at or near the earth's surface relatively to other such matter; second, telling other people to do so.")

True Random Number Generator

Vaguely, a computer might be said to have a true random number generator if the output of that generator cannot be predicted given its previous outputs and the entire state of the computer. This is directly opposed to psuedorandom number generators, whose output can be predicted (usually exactly) on the basis of its history and the computer state (that is, the generation is algorithmic). To be clear, when we say "predicted", we don't mean exactly, but with probability better than chance.

As is excellently explained, the existence of a source of cryptographic entropy is vital to individuation and personhood, along similar lines the auditability above.

Show Me The Facts

Though an iron-level audit of the FUCKGOATS is beyond my current ability, auditing the output is easy. In fact, the entire use of the thing is a pleasure: just plug it in, and read bits from it:

dd iflag=fullblock if=/dev/ttyUSB0 bs=1K count=102400 of=fg.bin

No firmware, drivers, or other nonsense: what a relief!

The ent utility tests for what might be most accurately called the information density of its input. Here's what it thinks of fg.bin:

Entropy = 7.999998 bits per byte.

Optimum compression would reduce the size
of this 104857600 byte file by 0 percent.

Chi square distribution for 104857600 samples is 269.30, and randomly
would exceed this value 25.75 percent of the times.

Arithmetic mean value of data bytes is 127.5095 (127.5 = random).
Monte Carlo value for Pi is 3.141683698 (error 0.00 percent).
Serial correlation coefficient is -0.000048 (totally uncorrelated = 0.0).

As for dieharder:

#=============================================================================#
#            dieharder version 3.31.1 Copyright 2003 Robert G. Brown          #
#=============================================================================#
   rng_name    |           filename             |rands/second|
 file_input_raw|                          fg.bin|  6.11e+07  |
#=============================================================================#
        test_name   |ntup| tsamples |psamples|  p-value |Assessment
#=============================================================================#
   diehard_birthdays|   0|       100|     100|0.54358111|  PASSED  
      diehard_operm5|   0|   1000000|     100|0.07037446|  PASSED  
  diehard_rank_32x32|   0|     40000|     100|0.26716133|  PASSED  
    diehard_rank_6x8|   0|    100000|     100|0.25098818|  PASSED  
   diehard_bitstream|   0|   2097152|     100|0.03656758|  PASSED  
        diehard_opso|   0|   2097152|     100|0.00239162|   WEAK   
        diehard_oqso|   0|   2097152|     100|0.20246720|  PASSED  
         diehard_dna|   0|   2097152|     100|0.01032017|  PASSED  
diehard_count_1s_str|   0|    256000|     100|0.14504447|  PASSED  
diehard_count_1s_byt|   0|    256000|     100|0.04346282|  PASSED  
 diehard_parking_lot|   0|     12000|     100|0.19200425|  PASSED  
    diehard_2dsphere|   2|      8000|     100|0.39891032|  PASSED  
    diehard_3dsphere|   3|      4000|     100|0.48542674|  PASSED  
     diehard_squeeze|   0|    100000|     100|0.33472292|  PASSED  
        diehard_sums|   0|       100|     100|0.30085025|  PASSED  
        diehard_runs|   0|    100000|     100|0.99751791|   WEAK   
        diehard_runs|   0|    100000|     100|0.57012941|  PASSED  
       diehard_craps|   0|    200000|     100|0.68010118|  PASSED  
       diehard_craps|   0|    200000|     100|0.17918854|  PASSED  
 marsaglia_tsang_gcd|   0|  10000000|     100|0.00000000|  FAILED  
 marsaglia_tsang_gcd|   0|  10000000|     100|0.00000000|  FAILED  
         sts_monobit|   1|    100000|     100|0.79478018|  PASSED  
            sts_runs|   2|    100000|     100|0.97291823|  PASSED  
          sts_serial|   1|    100000|     100|0.38448403|  PASSED  
          sts_serial|   2|    100000|     100|0.99929253|   WEAK   
          sts_serial|   3|    100000|     100|0.39921137|  PASSED  
          sts_serial|   3|    100000|     100|0.10097663|  PASSED  
          sts_serial|   4|    100000|     100|0.45707791|  PASSED  
          sts_serial|   4|    100000|     100|0.82096272|  PASSED  
          sts_serial|   5|    100000|     100|0.44969349|  PASSED  
          sts_serial|   5|    100000|     100|0.60287297|  PASSED  
          sts_serial|   6|    100000|     100|0.52825100|  PASSED  
          sts_serial|   6|    100000|     100|0.92793644|  PASSED  
          sts_serial|   7|    100000|     100|0.95060736|  PASSED  
          sts_serial|   7|    100000|     100|0.52448800|  PASSED  
          sts_serial|   8|    100000|     100|0.76509476|  PASSED  
          sts_serial|   8|    100000|     100|0.82820895|  PASSED  
          sts_serial|   9|    100000|     100|0.07769700|  PASSED  
          sts_serial|   9|    100000|     100|0.88497857|  PASSED  
          sts_serial|  10|    100000|     100|0.57704537|  PASSED  
          sts_serial|  10|    100000|     100|0.62145501|  PASSED  
          sts_serial|  11|    100000|     100|0.09353924|  PASSED  
          sts_serial|  11|    100000|     100|0.07304953|  PASSED  
          sts_serial|  12|    100000|     100|0.42271948|  PASSED  
          sts_serial|  12|    100000|     100|0.74765858|  PASSED  
          sts_serial|  13|    100000|     100|0.62853625|  PASSED  
          sts_serial|  13|    100000|     100|0.85367143|  PASSED  
          sts_serial|  14|    100000|     100|0.18879689|  PASSED  
          sts_serial|  14|    100000|     100|0.97272781|  PASSED  
          sts_serial|  15|    100000|     100|0.98723682|  PASSED  
          sts_serial|  15|    100000|     100|0.08419882|  PASSED  
          sts_serial|  16|    100000|     100|0.76081543|  PASSED  
          sts_serial|  16|    100000|     100|0.75893685|  PASSED  
         rgb_bitdist|   1|    100000|     100|0.17135399|  PASSED  
         rgb_bitdist|   2|    100000|     100|0.28925726|  PASSED  
         rgb_bitdist|   3|    100000|     100|0.95616928|  PASSED  
         rgb_bitdist|   4|    100000|     100|0.32585309|  PASSED  
         rgb_bitdist|   5|    100000|     100|0.72943312|  PASSED  
         rgb_bitdist|   6|    100000|     100|0.21215751|  PASSED  
         rgb_bitdist|   7|    100000|     100|0.14075440|  PASSED  
         rgb_bitdist|   8|    100000|     100|0.28562129|  PASSED  
         rgb_bitdist|   9|    100000|     100|0.17273637|  PASSED  
         rgb_bitdist|  10|    100000|     100|0.63410649|  PASSED  
         rgb_bitdist|  11|    100000|     100|0.99758648|   WEAK   
         rgb_bitdist|  12|    100000|     100|0.33444739|  PASSED  
rgb_minimum_distance|   2|     10000|    1000|0.45413674|  PASSED  
rgb_minimum_distance|   3|     10000|    1000|0.64403835|  PASSED  
rgb_minimum_distance|   4|     10000|    1000|0.72951905|  PASSED  
rgb_minimum_distance|   5|     10000|    1000|0.64637899|  PASSED  
    rgb_permutations|   2|    100000|     100|0.48035733|  PASSED  
    rgb_permutations|   3|    100000|     100|0.80765266|  PASSED  
    rgb_permutations|   4|    100000|     100|0.99200983|  PASSED  
    rgb_permutations|   5|    100000|     100|0.91284388|  PASSED  
      rgb_lagged_sum|   0|   1000000|     100|0.87959282|  PASSED  
      rgb_lagged_sum|   1|   1000000|     100|0.01018062|  PASSED  
      rgb_lagged_sum|   2|   1000000|     100|0.87569262|  PASSED  
      rgb_lagged_sum|   3|   1000000|     100|0.01294655|  PASSED  
      rgb_lagged_sum|   4|   1000000|     100|0.00003086|   WEAK   
      rgb_lagged_sum|   5|   1000000|     100|0.00009491|   WEAK   
      rgb_lagged_sum|   6|   1000000|     100|0.72738399|  PASSED  
      rgb_lagged_sum|   7|   1000000|     100|0.00000000|  FAILED  
      rgb_lagged_sum|   8|   1000000|     100|0.41770033|  PASSED  
      rgb_lagged_sum|   9|   1000000|     100|0.00000078|  FAILED  
      rgb_lagged_sum|  10|   1000000|     100|0.90321003|  PASSED  
      rgb_lagged_sum|  11|   1000000|     100|0.00007829|   WEAK   
      rgb_lagged_sum|  12|   1000000|     100|0.88981556|  PASSED  
      rgb_lagged_sum|  13|   1000000|     100|0.00000088|  FAILED  
      rgb_lagged_sum|  14|   1000000|     100|0.00000042|  FAILED  
      rgb_lagged_sum|  15|   1000000|     100|0.00000000|  FAILED  
      rgb_lagged_sum|  16|   1000000|     100|0.40896145|  PASSED  
      rgb_lagged_sum|  17|   1000000|     100|0.01254384|  PASSED  
      rgb_lagged_sum|  18|   1000000|     100|0.36024537|  PASSED  
      rgb_lagged_sum|  19|   1000000|     100|0.00000001|  FAILED  
      rgb_lagged_sum|  20|   1000000|     100|0.39678503|  PASSED  
      rgb_lagged_sum|  21|   1000000|     100|0.00064669|   WEAK   
      rgb_lagged_sum|  22|   1000000|     100|0.87902281|  PASSED  
      rgb_lagged_sum|  23|   1000000|     100|0.00004497|   WEAK   
      rgb_lagged_sum|  24|   1000000|     100|0.00000000|  FAILED  
      rgb_lagged_sum|  25|   1000000|     100|0.00005972|   WEAK   
      rgb_lagged_sum|  26|   1000000|     100|0.20365054|  PASSED  
      rgb_lagged_sum|  27|   1000000|     100|0.00122854|   WEAK   
      rgb_lagged_sum|  28|   1000000|     100|0.76503450|  PASSED  
      rgb_lagged_sum|  29|   1000000|     100|0.00000000|  FAILED  
      rgb_lagged_sum|  30|   1000000|     100|0.30703574|  PASSED  
      rgb_lagged_sum|  31|   1000000|     100|0.00000000|  FAILED  
      rgb_lagged_sum|  32|   1000000|     100|0.69183974|  PASSED  
     rgb_kstest_test|   0|     10000|    1000|0.92884220|  PASSED  
     dab_bytedistrib|   0|  51200000|       1|0.00000000|  FAILED  
             dab_dct| 256|     50000|       1|0.23779837|  PASSED  
Preparing to run test 207.  ntuple = 0
        dab_filltree|  32|  15000000|       1|0.23801359|  PASSED  
        dab_filltree|  32|  15000000|       1|0.67308112|  PASSED  
Preparing to run test 208.  ntuple = 0
       dab_filltree2|   0|   5000000|       1|0.01247750|  PASSED  
       dab_filltree2|   1|   5000000|       1|0.25390150|  PASSED  
Preparing to run test 209.  ntuple = 0
        dab_monobit2|  12|  65000000|       1|1.00000000|  FAILED

So you can see, the thing works damn well!

Eventually, I hope to conduct a circuit-level audit. Until then, I have some reading to do.

Towards a Computer Science Education

Sunday, June 10th, 2018

As you may be aware, the current state of education in computer science is abysmal, to the point where "top researchers" in the field produce work that is worthless, designed for architectures inferior to what came before, written in programming languages) which are conceptually braindead, and all while operating at the beck and call of corporate lobbyists and traitorous three letter agencies. Educators teach to the lowest common denominator, while allowing the eternally shortsighted market and its pointless fashions to decide what deserves a place in the curriculum. Buyer beware.

My education is as a theoretical mathematician, a relatively mature field with a clear path through the cornerstones. Of course, most institutions manage to screw this up anyway, and most graduates can't explain the purpose of the derivative (to linearize), the integral (to globalize), or the group (the structure on the self-transformations of an object which defines that object in a model). So, fraudulent behavior of the CS academics aside, it's no shocker that the nubile field of computer science teaches its students diddly squat about computing or its history. (Every mathematician knows Gauss, Euler, and Riemann. Students: do you know John McCarthy, Guy Steele, and Gerald Sussman?)

So, let's say you're in the same position I find myself in, having no formal education in computer science, and little chance of finding a decent school, but with enough experience in a real discipline to posses a decent bullshit detector. What to do?

Well, the best I've managed is to gather a collection of books which seem promising, and to slowly work through them on my own. I'll be picking up the pace on them, and posting reviews on completion.

Meanwhile, if you think this list sucks, then speak up!

  • Generalist Works
    • Knuth - The Art of Computer Programming
  • Theory of Computation
    • Moore and Mertens - The Nature of Computation
  • Algorithms
    • Cormen, Leiserson, Rivest, and Stein - Introduction to Algorithms
  • Hardware Considerations
    • Horowitz and Hill - The Art of Electronics
    • Hennessy and Patterson - Computer Architecture: A Quantitative Approach
    • Kogge - The Architecture of Symbolic Computers
    • Silc, Robic, and Ungerer - Processor Architecture: From Dataflow to Superscalar and Beyond
  • Symbolic Computation
    • Stark - LISP, Lore, and Logic
    • Sussman and Steele - The Lambda Papers
    • John Alan - Anatomy of Lisp
    • Sussman and Abelson - Structure and Interpretation of Computer Programs
    • Graham - On Lisp
    • Hoyte - Let over Lambda: 50 Years of Lisp
    • Queinnec - Lisp in Small Pieces
  • Programming and Programming Languages
    • Steele - Common LISP: The Language (2nd edition)
    • Various - Ada 95 (reference manual and rational)
    • Keene - Object-Oriented Programming in Common Lisp
    • Various - Object-Oriented Programming: The CLOS Perspective
    • Kiczales, Rivieres, and Bobrow - The Art of the Metaobject Protocol
  • Programming Techniques
    • Norvig - Artificial Intelligence Programming: Case Studies in Common Lisp
    • Okasaki - Purely Functional Data Structures
  • Cryptography
    • Schneier - Applied Cryptography

esthlos-V Genesis, Or: Who Presses the Pressor?

Wednesday, May 30th, 2018
Edit on 2018-06-07: Modified the below vpatch to include a manifest, per the spec.

Introduction

This item fulfills the request for a new V implementation.

Files:

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.

Credit is due to

  • trinque for overall guidance,
  • phf for providing a mkdtemp interface for ccl,
  • asciilifeform for providing the original V,
  • Diana Coman for helping me get my shit together,

and others for general advice on vtronics and other matters.

Setup and Use

Per-System Configuration

As a user, you must take care to correctly set the global tuning parameters for your system. I've tried to set sensible defaults, but if something doesn't work, you should make sure that these parameters are set correctly. Here are the defaults:

(defparameter *default-vpatch-dir* "./patches/")
(defparameter *default-wot-dir* "./wot/")
(defparameter *default-seal-dir* "./seals/")
(defparameter *default-keyring-dir-location* "./")
(defparameter *default-keyring-dir-template* "gpgXXXXXX")
(defparameter *gpg-location* "/usr/bin/gpg")
(defparameter *patch-location* "/usr/bin/patch")
(defparameter *rm-location* "/bin/rm")

Explanations:

  • default-vpatch-dir is the directory where vpatches are looked for;
  • default-wot-dir is the directory where public keys are looked for;
  • default-seal-dir is the directory where seals are looked for;
  • default-keyring-dir-location is the location where gpg temporary keyring directory generation is attempted;
  • default-keyring-dir-template is the template used to name the temporary keyring directory. It must end with "XXXXXX" (six capital X's);
  • gpg-location is the location of your gpg executable;
  • patch-location is the location of your patch executable; and
  • rm-location is the location of your rm executable.

Note well: strings pointing to directories should end in a forward slash to ensure correct interpretation.

Setup Guide

Setting the thing up is simple:

  1. (n00b step): Ensure the following:
    1. You're on a decent Linux distribution (e.g. Gentoo).
    2. You have gpg 1.4.X installed. (2.x is banned.)
  2. Ensure at least one of the following is installed:
    1. sbcl (tested on version 1.4.4 x86_64).
    2. ccl (tested on version 1.11.5 x86_64).
  3. Press the thing with your current vtron.
  4. Move the files to a convenient location.
  5. Create (and possibly populate) the wot, seals, and vpatch directories.
  6. If you want to run interactively:
    1. In the directory with the files, run sbcl or ccl.
    2. In the REPL, run (load "v.lisp").
    3. Either:
      1. run (in-package "V"); or
      2. preface the main vtron commands with v:, and the internal vtron commands with v::. E.g., (v:flow) or (v::load-vpatches)
  7. If you want run as a portable executable:
    1. Either:
      1. run make sbcl to build with sbcl; or
      2. run make ccl to build with ccl.
    2. Invoke ./v to see your options

Testing

Of course, the user of this program is expected to read and understood before use, but you might want to test it, too. I've designed the program so that each piece can be tested independently. Here's something to get you started.

Open up your preferred (any color you like, as long it's sbcl or ccl) REPL, and load in the vtron with (load "v.lisp"). We're going to test the topological sorting capability by creating all directed 6-graphs, and trying to press each one. Exactly one of the graphs has a cycle, and should throw an error.

To make things easier, we will first redefine the vpatch class so that subpatches (patches for individual files) can be added post-instantiation:

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

Next, we define a command to spit out three distinct vpatches, and another generally useful routine for establishing the parenthood relation between vpatches:

(defun new-vertex-set ()
  (list (make-instance 'vpatch :name "a")
        (make-instance 'vpatch :name "b")
        (make-instance 'vpatch :name "c")))

(defun set-parent (vpatch-list child parent)
  (let ((filename (symbol-name (gensym)))
        (pre-hash (symbol-name (gensym)))
        (post-hash (symbol-name (gensym)))
        (parent (find-if #'(lambda (vp) (string= parent (name vp)))
                         vpatch-list))
        (child (find-if #'(lambda (vp) (string= child (name vp)))
                        vpatch-list)))
    (cl:setf (subpatches parent)
             (append (subpatches parent)
                     (list (make-instance 'subpatch
                                          :path filename
                                          :pre-hash "false"
                                          :post-hash pre-hash))))
    (cl:setf (subpatches child)
             (append (subpatches child)
                     (list (make-instance 'subpatch
                                          :path filename
                                          :pre-hash pre-hash
                                          :post-hash post-hash))))))

Now the following procedure should, upon evaluation, simply print "Cycle caught correctly.":

(defun make-and-test-3-graphs ()
  (let ((g1) (g2) (g3) (g4) (g5) (g6))
    ;; {}
    (setq g1 (new-vertex-set))

    ;; {(b,a)}
    (setq g2 (new-vertex-set))
    (set-parent g2 "b" "a")

    ;; {(b,a), (c,a)}
    (setq g3 (new-vertex-set))
    (set-parent g3 "b" "a")
    (set-parent g3 "c" "a")

    ;; {(b,a), (a,c)}
    (setq g4 (new-vertex-set))
    (set-parent g4 "b" "a")
    (set-parent g4 "a" "c")

    ;; {(b,a), (c,a), (c,b)}
    (setq g5 (new-vertex-set))
    (set-parent g5 "b" "a")
    (set-parent g5 "c" "a")
    (set-parent g5 "c" "b")

    ;; {(b,a), (a,c), (c,b)}
    (setq g6 (new-vertex-set))
    (set-parent g6 "b" "a")
    (set-parent g6 "a" "c")
    (set-parent g6 "c" "b")

    ;; this should execute without a problem
    (mapcar #'(lambda (vpatch-list)
                (toposort (generate-depgraph vpatch-list)))
            (list g1 g2 g3 g4 g5))

    ;; the error should be caught here
    (handler-case
        (toposort (generate-depgraph g6))
      (cyclic () (format t "Cycle caught correctly.")))))

I encourage you to further play with the thing, especially if you believe it's broken in some way.

Concluding Remarks

I'm sure something is broken, so please: read and test!

Regardless, I hope it serves you well.

esthlos-v Prerelease

Thursday, May 17th, 2018

Having made the required changes, this iteration of V is near finished. The program has no problem pressing:

Additional tests have been conducted to ensure that appropriate error conditions are raised when a press should fail.

As far as I'm aware, the only thing left to add is makefile support for Closure Common Lisp, which trinque has agreed to supply.

Get the source, the signature, and the optional makefile. Tests and comments are appreciated.

esthlos-v Version 2

Wednesday, May 9th, 2018

The 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 changes to my item, my progress on those changes, and pertinent discussion of the matter.

The latest source will be maintained here,the latest signature here, and the makefile for a executable build here.

ChangeReferencesImplemented On
return vpatch objects12018-05-06
remove dependency on cl-ppcre1 22017-05-13
select run-program by cl implementation1 22018-05-11
take a head to press, not entire patch directory12018-05-06
use a tempdir for gpg keyring (stateless)12018-05-13
complain loudly (eggog) and clearly on bad sig1 2018-05-13
fail on bad public key2018-05-13
error on bad public key2018-05-13
deal with console args12018-05-14
build script to produce binary12018-05-14
remove form feeds1 2 3 2018-05-09
remove tabs12018-05-09

A Brief Overview of Eucrypt's MPI Library

Sunday, April 29th, 2018

Introduction

The Eucrypt MPI library, painfully removed from GnuPG 1.4.10, remains a mess in the traditional manner of C programs. This post is not, by any means, an exhaustive walk through the code. Rather, this post tries to convey the essence of the library, so that the curious reader can rummage through the code with a moderate sense of direction. Code excerpts are given to show what procedures depend on what, not necessarily to explain how it works.

Topics which this guide does not cover, include:

  • Secure memory: secmem.c
  • Error handling: error.c
  • Debugging (set by defining M_DEBUG)
  • Logging: logger.c
  • Compile-time configuration: config.h
  • Architecture-specific autoconfiguration: (,code "types.h")
  • Bytewise access/repalcement for MPIs: mpi-scan.c
  • I/O (which is insanely overcomplicated: see the iobuf_struct struct): iobuf.c, iobuf.h, ttyio.h, mpicoder.c
  • Macros for compiler inlining of operations: mpi-inline.h
Admittedly, this is the bulk of the library. But here the focus is on the arithmetic operations, and what is needed to carry those out.

Structure of an MPI

An MPI is defined as typedef struct gcry_mpi *MPI, where

struct gcry_mpi {
	int alloced;    /* array size (# of allocated limbs) */
	int nlimbs;     /* number of valid limbs */
	unsigned int nbits; /* the real number of valid bits (info only) */
	int sign;		/* indicates a negative number */
	unsigned flags; /* bit 0: array must be allocated in secure memory space */
			/* bit 1: not used */
			/* bit 2: the limb is a pointer to some xmalloced data */
	mpi_limb_t *d;  /* array with the limbs */
};
mpi-internal.h

To sumarize, an MPI is an array of limbs, where a limb is some kind of builtin number type:

#if BYTES_PER_MPI_LIMB == SIZEOF_UNSIGNED_INT
  typedef unsigned int mpi_limb_t;
  typedef   signed int mpi_limb_signed_t;
#elif BYTES_PER_MPI_LIMB == SIZEOF_UNSIGNED_LONG
  typedef unsigned long int mpi_limb_t;
  typedef   signed long int mpi_limb_signed_t;
#elif BYTES_PER_MPI_LIMB == SIZEOF_UNSIGNED_LONG_LONG
  typedef unsigned long long int mpi_limb_t;
  typedef   signed long long int mpi_limb_signed_t;
#elif BYTES_PER_MPI_LIMB == SIZEOF_UNSIGNED_SHORT
  typedef unsigned short int mpi_limb_t;
  typedef   signed short int mpi_limb_signed_t;
#else
#error BYTES_PER_MPI_LIMB does not match any C type
#endif
#define BITS_PER_MPI_LIMB    (8*BYTES_PER_MPI_LIMB)
mpi-internal.h

The user can set (before compillation) the underlying type of a limb by modifying mpi-asm-defs.h:

/* This file defines some basic constants for the MPI machinery.  We
 * need to define the types on a per-CPU basis, so it is done with
 * this file here.  */
#define BYTES_PER_MPI_LIMB  (SIZEOF_UNSIGNED_LONG)
mpi-asm-defs.h

A revealing example is the procedure for copying limbs of an MPI, which simply reassignes the limb pointers in the target MPI to the limb pointers in the source MPI:

/* Copy N limbs from S to D.  */
#define MPN_COPY( d, s, n) 
	do {				
	mpi_size_t _i;			
	for( _i = 0; _i < (n); _i++ )	
		(d)[_i] = (s)[_i];		
	} while(0)

Memory Management of MPIs

From the GPG FAQ (yes, I am intentionally preserving their encoding):

GnuPG tries to lock memory so that no other process can see it and so that the memory will not be written to swap. If for some reason it’s not able to do this (for instance, certain platforms don’t support this kind of memory locking), GnuPG will warn you that it’s using insecure memory.

Since this kind of security is flawed, I am skipping its implementation. So this article will not cover these items:

 *  a) functions to provide memory from a secure memory.
 *  b) by looking at the requested allocation size we
 *     can reuse memory very quickly (e.g. MPI storage)
 *     (really needed?)
 *  c) memory usage reporting if compiled with M_DEBUG
 *  d) memory checking if compiled with M_GUARD
memory.c

On to the code. The primary procedure for memory allocation is below:

void *
FNAMEXM(alloc)( size_t n FNAMEPRT )
{
	char *p;

#ifdef M_GUARD
	if(!n)
	  out_of_core(n,0); /* should never happen */
	if( !(p = malloc( n + EXTRA_ALIGN+5 )) )
	out_of_core(n,0);
	store_len(p,n,0);
	used_memory += n;
	p[4+EXTRA_ALIGN+n] = MAGIC_END_BYTE;
	return p+EXTRA_ALIGN+4;
#else
	/* mallocing zero bytes is undefined by ISO-C, so we better make
	   sure that it won't happen */
	if (!n)
	  n = 1;
	if( !(p = malloc( n )) )
	out_of_core(n,0);
	return p;
#endif
}
memory.c

(Note how the name of the procedure is determined by the macro FNAMEXM, which prefixes the procedure name with m_debug when M_DEBUG is defined. Also, if M_GUARD is defined, then the procedure takes a const char*. In our case, we ignore these options.) The procedure checks if the allocation succeeded, calling out_of_core if the allocation fails:

static void
out_of_core(size_t n, int secure)
{
	log_error ("out of %s memory while allocating %u bytesn",
			   secure? "secure":"" ,(unsigned)n );
	if (secure) {
		/*secmem_dump_stats ();*/
		log_info ("(this may be caused by too many secret keys used "
				  "simultaneously or due to excessive large key sizes)n");
	}
#if defined(M_GUARD) && defined(__riscos__)
	abort();
#endif
	exit (2);
}
memory.c

There is also a trymalloc procedure, which doesn't terminate the process on failure:

void *
FNAMEX(trymalloc)(size_t n FNAMEPRT)
{
#ifdef M_GUARD
	char *p;

	if (!n)
	  n = 1;
	p = malloc (n + EXTRA_ALIGN+5);
	if (!p)
	  return NULL;
	store_len(p,n,0);
	used_memory += n;
	p[4+EXTRA_ALIGN+n] = MAGIC_END_BYTE;
	return p+EXTRA_ALIGN+4;
#else
	/* Mallocing zero bytes is undefined by ISO-C, so we better make
	   sure that it won't happen.  */
	return malloc (n? n: 1);
#endif
}

As I'm sure the reader can guess, there is a procedure to re-allocate memory:

void *
FNAMEX(realloc)( void *a, size_t n FNAMEPRT )
{
	void *b;

#ifdef M_GUARD
	if( a ) {
#error "--enable-m-guard does not currently work"
		unsigned char *p = a;
		size_t len = m_size(a);

		if( len >= n ) /* we don't shrink for now */
			return a;
		if( p[-1] == MAGIC_SEC_BYTE )
			b = FNAME(alloc_secure_clear)(n FNAMEARG);
		else
			b = FNAME(alloc_clear)(n FNAMEARG);
		FNAME(check)(NULL FNAMEARG);
		memcpy(b, a, len );
		FNAME(free)(p FNAMEARG);
	}
	else
		b = FNAME(alloc)(n FNAMEARG);
#else
	if( m_is_secure(a) ) {
	if( !(b = secmexrealloc( a, n )) )
		out_of_core(n,1);
	}
	else {
	if( !(b = realloc( a, n )) )
		out_of_core(n,0);
	}
#endif

	return b;
}
memory.c

And there is a procedure to free allocated memory:

void
FNAMEX(free)( void *a FNAMEPRT )
{
	byte *p = a;

	if( !p )
	return;
#ifdef M_DEBUG
	free_entry(p-EXTRA_ALIGN-4, info);
#elif defined M_GUARD
	m_check(p);
	if( m_is_secure(a) )
	secmem_free(p-EXTRA_ALIGN-4);
	else {
	used_memory -= m_size(a);
	free(p-EXTRA_ALIGN-4);
	}
#else
	if( m_is_secure(a) )
	secmem_free(p);
	else
	free(p);
#endif
}
memory.c

The above procedures are for arbitrary memory management. Specific procedures exist for the memory management of MPIs. To allocate an MPI of nlimbs many limbs, use the following procedure:

MPI
#ifdef M_DEBUG
mpi_debug_alloc( unsigned nlimbs, const char *info )
#else
mpi_alloc( unsigned nlimbs )
#endif
{
    MPI a;

    if( DBG_MEMORY )
	log_debug("mpi_alloc(%u)n", nlimbs*BITS_PER_MPI_LIMB );
#ifdef M_DEBUG
    a = m_debug_alloc( sizeof *a, info );
    a->d = nlimbs? mpi_debug_alloc_limb_space( nlimbs, 0, info ) : NULL;
#else
    a = xmalloc( sizeof *a );
    a->d = nlimbs? mpi_alloc_limb_space( nlimbs, 0 ) : NULL;
#endif
    a->alloced = nlimbs;
    a->nlimbs = 0;
    a->sign = 0;
    a->flags = 0;
    a->nbits = 0;
    return a;
}
mpiutil.c

Another procedure takes in an MPI, and spits out an alloced copy of the input:

MPI
#ifdef M_DEBUG
mpi_debug_copy( MPI a, const char *info )
#else
mpi_copy( MPI a )
#endif
{
    int i;
    MPI b;

    if( a && (a->flags & 4) ) {
	void *p = m_is_secure(a->d)? xmalloc_secure( a->nbits )
				   : xmalloc( a->nbits );
	memcpy( p, a->d, a->nbits );
	b = mpi_set_opaque( NULL, p, a->nbits );
    }
    else if( a ) {
#ifdef M_DEBUG
	b = mpi_is_secure(a)? mpi_debug_alloc_secure( a->nlimbs, info )
			    : mpi_debug_alloc( a->nlimbs, info );
#else
	b = mpi_is_secure(a)? mpi_alloc_secure( a->nlimbs )
			    : mpi_alloc( a->nlimbs );
#endif
	b->nlimbs = a->nlimbs;
	b->sign = a->sign;
	b->flags  = a->flags;
	b->nbits = a->nbits;
	for(i=0; i < b->nlimbs; i++ )
	    b->d[i] = a->d[i];
    }
    else
	b = NULL;
    return b;
}
mpiutil.c

Yet another procedure resizes an MPI (but only to increase the size):

void
#ifdef M_DEBUG
mpi_debug_resize( MPI a, unsigned nlimbs, const char *info )
#else
mpi_resize( MPI a, unsigned nlimbs )
#endif
{
    if( nlimbs <= a->alloced )
	return; /* no need to do it */
    /* Note: a->secure is not used - instead the realloc functions
     * take care of it. Maybe we should drop a->secure completely
     * and rely on a mpi_is_secure function, which would be
     * a wrapper around m_is_secure
     */
#ifdef M_DEBUG
    if( a->d )
	a->d = m_debug_realloc(a->d, nlimbs * sizeof(mpi_limb_t), info );
    else
	a->d = m_debug_alloc_clear( nlimbs * sizeof(mpi_limb_t), info );
#else
    if( a->d )
	a->d = xrealloc(a->d, nlimbs * sizeof(mpi_limb_t) );
    else
	a->d = xmalloc_clear( nlimbs * sizeof(mpi_limb_t) );
#endif
    a->alloced = nlimbs;
}
mputil.c

Arithmetic Operations on MPIs

The MPI library supports the following arithmetic operations:

  • Addition and subtraction: mpi-add.c
  • Multiplication: mpi-mul.c
  • Division: mpi-div.c
  • Modular exponentiation: mpi-pow.c
  • GCD: mpi-gcd.c
  • Products of modular exponentiation: mpi-mpow.c
  • Ordering: mpi-cmp.c
  • Bitshifting of MPIs: mpi-bit.c
  • Multiplicative inverse in finite field: mpi-inv.c
A few specially optimized versions of the above exist, e.g. for multiplication by a power of 2.

Let's look carefully at addition. (By the end, you should appreciate just how disasterous the addition facility is). To begin, we need to know how to add arrays of limbs:

mpi_limb_t
mpihelp_add_n( mpi_ptr_t res_ptr, mpi_ptr_t s1_ptr,
	       mpi_ptr_t s2_ptr, mpi_size_t size)
{
    mpi_limb_t x, y, cy;
    mpi_size_t j;

    /* The loop counter and index J goes from -SIZE to -1.  This way
       the loop becomes faster.  */
    j = -size;

    /* Offset the base pointers to compensate for the negative indices. */
    s1_ptr -= j;
    s2_ptr -= j;
    res_ptr -= j;

    cy = 0;
    do {
	y = s2_ptr[j];
	x = s1_ptr[j];
	y += cy;		  /* add previous carry to one addend */
	cy = y < cy;		  /* get out carry from that addition */
	y += x; 		  /* add other addend */
	cy += y < x;		  /* get out carry from that add, combine */
	res_ptr[j] = y;
    } while( ++j );

    return cy;
}
mpih-add1.c

You may or may not notice that this is confusing as hell. Negative index values besides, the magic of < returning 1 is used to calculate the carry. And how can y be less than cy when we just added cy to y? Well, we're really checking if y wrapped around, duh! (Remember, y is unsigned.)

We also need a procedure to subtract an array of limbs, for the case where we add MPIs of differing signs:

mpi_limb_t
mpihelp_sub_n( mpi_ptr_t res_ptr, mpi_ptr_t s1_ptr,
				  mpi_ptr_t s2_ptr, mpi_size_t size)
{
    mpi_limb_t x, y, cy;
    mpi_size_t j;

    /* The loop counter and index J goes from -SIZE to -1.  This way
       the loop becomes faster.  */
    j = -size;

    /* Offset the base pointers to compensate for the negative indices.  */
    s1_ptr -= j;
    s2_ptr -= j;
    res_ptr -= j;

    cy = 0;
    do {
	y = s2_ptr[j];
	x = s1_ptr[j];
	y += cy;		  /* add previous carry to subtrahend */
	cy = y < cy;		  /* get out carry from that addition */
	y = x - y;		  /* main subtract */
	cy += y > x;		  /* get out carry from the subtract, combine */
	res_ptr[j] = y;
    } while( ++j );

    return cy;
}
mpih-sub1.c

Now we are adequately prepared to investigate addition:

void
mpi_add(MPI w, MPI u, MPI v)
{
    mpi_ptr_t wp, up, vp;
    mpi_size_t usize, vsize, wsize;
    int usign, vsign, wsign;

    if( u->nlimbs < v->nlimbs ) { /* Swap U and V. */
	usize = v->nlimbs;
	usign = v->sign;
	vsize = u->nlimbs;
	vsign = u->sign;
	wsize = usize + 1;
	RESIZE_IF_NEEDED(w, wsize);
	/* These must be after realloc (u or v may be the same as w).  */
	up    = v->d;
	vp    = u->d;
    }
    else {
	usize = u->nlimbs;
	usign = u->sign;
	vsize = v->nlimbs;
	vsign = v->sign;
	wsize = usize + 1;
	RESIZE_IF_NEEDED(w, wsize);
	/* These must be after realloc (u or v may be the same as w).  */
	up    = u->d;
	vp    = v->d;
    }
    wp = w->d;
    wsign = 0;

    if( !vsize ) {  /* simple */
	MPN_COPY(wp, up, usize );
	wsize = usize;
	wsign = usign;
    }
    else if( usign != vsign ) { /* different sign */
	/* This test is right since USIZE >= VSIZE */
	if( usize != vsize ) {
	    mpihelp_sub(wp, up, usize, vp, vsize);
	    wsize = usize;
	    MPN_NORMALIZE(wp, wsize);
	    wsign = usign;
	}
	else if( mpihelp_cmp(up, vp, usize) < 0 ) {
	    mpihelp_sub_n(wp, vp, up, usize);
	    wsize = usize;
	    MPN_NORMALIZE(wp, wsize);
	    if( !usign )
		wsign = 1;
	}
	else {
	    mpihelp_sub_n(wp, up, vp, usize);
	    wsize = usize;
	    MPN_NORMALIZE(wp, wsize);
	    if( usign )
		wsign = 1;
	}
    }
    else { /* U and V have same sign. Add them. */
	mpi_limb_t cy = mpihelp_add(wp, up, usize, vp, vsize);
	wp[usize] = cy;
	wsize = usize + cy;
	if( usign )
	    wsign = 1;
    }

    w->nlimbs = wsize;
    w->sign = wsign;
}
mpi-add.c

The first if block allows us to assume that the size of u is no smaller than that of v. Then the destination MPI w is resized to ensure that it is at least one limb larger than u, to ensure there is enough space for a possibly carry. Following the resizing, the one of the previously mentioned operations on limb arrays, mpihelp_sub_n or mpihelp_add, is invoked to add the limb arrays (mpihelp_add is an inlined version of mpihelp_add_n, defined in mpi-inline.h)

Concluding Remarks

I had wished to be more through, but after the above, I am both exhausted and disgusted. If the gentle reader wishes to dive further, then power to them, but I advise on the contrary.

Setting up mp-wp

Friday, April 20th, 2018

mp-wp has recently been genesised, and if you're reading this, then it's approximately working. This article doesn't touch how mp-wp works, but simply linearizes my back-and-forth experience setting up the site.

1: Gentoo Setup

  1. Get yourself a Gentoo box to host the website. If you have no intention using Gentoo, then much of this guide will still help, but there's no warranty (as usual, sadly).
  2. Set up your hostname by editing /etc/conf.d/hostname:
    hostname="blog"
  3. Add your hostname to /etc/hosts to make apache happy:
    127.0.0.1 blog
  4. Create a user and a directory for the site:
    useradd wpuser
    mkdir -p /www/blog
    chown -R wpuser:wpuser /www/blog

2: Flags, Masks, and Emerging

  1. Establish the following USE flags:
    www-servers/apache apache2_modules_access_compat
    dev-lang/php apache2 mysql
  2. Establish the following package mask:
    >dev-lang/php-5.6.34-r1
  3. Now emerge the software:
    $ emerge --ask apache php mysql

3: Apache

  1. Put the global server name in /etc/apache2/vhosts.d/default_vhost.include to shut Apache up:
    ...
    ServerName blog.esthlos.com
    ...
  2. While in /etc/apache2/vhosts.d/default_vhost.include, set the DocumentRoot and Directory of the website:
    ...
    DocumentRoot "/www/blog"
    
    # This should be changed to whatever you set DocumentRoot to.
    
    ...
  3. Enable PHP support in Apache in /etc/conf.d/apache2:
    APACHE2_OPTS="... -D PHP ..."

4: MySQL

Here we follow the Gentoo wiki guide.

  1. Set the root password and initialize the database:
    emerge --config =dev-db/mysql-[version]
  2. Start MySQL:
    rc-service mysql start
  3. (Optional) Make MySQL start on boot:
    rc-update add mysql default
  4. Create a SQL database, following the wordpress guide:
    $ mysql -u root -p
    Enter password:
    Welcome to the MySQL monitor.  Commands end with ; or g.
    Your MySQL connection id is 5340 to server version: 3.23.54
     
    Type 'help;' or 'h' for help. Type 'c' to clear the buffer.
     
    mysql> CREATE DATABASE wp;
    Query OK, 1 row affected (0.00 sec)
     
    mysql> GRANT ALL PRIVILEGES ON wp.* TO "wpuser"@"localhost"
        -> IDENTIFIED BY "password";
    Query OK, 0 rows affected (0.00 sec)
      
    mysql> FLUSH PRIVILEGES;
    Query OK, 0 rows affected (0.01 sec)
    
    mysql> EXIT
    Bye
    $

5: mp-wp

  1. Obtain the genesis of mp-wp, along with hanbot's key, and press the thing into its parts.
  2. Move the pressed contents (not the directory itself) into the directory you created for the site, then change permissions:
    $ mv mp-wp/* /www/blog
    chown -R wpuser:wpuser /www/blog
  3. There are three ~.htaccess~ files:
    1. Configure .htaccess to allow from IPs you wish to administrate from:
      ...
      
      Order deny,allow
      Deny from all
      Allow from ...
      
      ...
    2. Configure wp-admin/.htaccess similarly to the above, but for the entire directory:
      Order deny,allow
      Deny from all
      Allow from ...
      
    3. Configure wp-includes/js/.htaccess
    to allow all, so that users can access mp-wp's Javascript (I believe this is correct: check with your local representative).
  4. Fill in your wp-config.php like so:
    ...
    /** The name of the database for WordPress */
    define('DB_NAME', 'wp');
    
    /** MySQL database username */
    define('DB_USER', 'wpuser');
    
    /** MySQL database password */
    define('DB_PASSWORD', '');
    
    /** MySQL hostname */
    define('DB_HOST', 'blog');
    
    /** Database Charset to use in creating database tables. */
    define('DB_CHARSET', 'utf8');
    ...

Bonus Round: MathJax

  1. Get a copy.
  2. Place the copy in //wp-includes/mj
  3. Give Apache read permissions on the directory.
  4. Place the following in the element in you theme's header.php:
    <script type="text/x-mathjax-config">
      MathJax.Hub.Config({
          extensions: ["tex2jax.js"],
              jax: ["input/TeX","output/HTML-CSS"],
    	      tex2jax: {inlineMath: [["$","$"],["(",")"]]}
    	        });
    		</script>
    <script type="text/javascript" src="/wp-includes/mj/MathJax.js?config=TeX-AMS_HTML"></script>
    

A Vtron

Saturday, March 17th, 2018
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.