## Archive for the ‘Uncategorized’ Category

### esthlos-v: Release with Working Keccak

Sunday, October 14th, 2018

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:

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

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.

### 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

## 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 vpatchesv_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 ofv_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 subpatchs_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.