esthlos-v: Release with Working Keccak

Posted 2018-10-14

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.

One Response to “esthlos-v: Release with Working Keccak”

  1. Hey, any progress on the lispy diff? Care to drop into #trinque on freenode sometime?

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