I was reading about the drunken bishop algorithm for fingerprint visualization in openssh. I thought it might be a lark to implement it in emacs lisp.
Bishop Peter finds himself in the middle of an ambient atrium. There are walls on all four sides and apparently there is no exit. The floor is paved with square tiles, strictly alternating between black and white. His head heavily aching—probably from too much wine he had before—he starts wandering around randomly. Well, to be exact, he only makes diagonal steps—just like a bishop on a chess board. When he hits a wall, he moves to the side, which takes him from the black tiles to the white tiles (or vice versa). And after each move, he places a coin on the floor, to remember that he has been there before. After 64 steps, just when no coins are left, Peter suddenly wakes up. What a strange dream!
First I need a way to address the bits of the bytes that make up a string (hash):
(defun hexstr-to-ints (hexstr)
(mapcar (lambda (i)
(string-to-number (substring hexstr i (+ i 2)) 16))
(number-sequence 0 (1- (length hexstr)) 2)))A boring start, I'll admit, but it works:
(hexstr-to-ints "cc")
(204)
(hexstr-to-ints "abadcafe")
(171 173 202 254)From the integer values I need to pull out the bit pairs and will eventually convert those into the bishop's movements (↖ ↗ ↙ ↘) but doing things iteratively as I worked my way through the paper I wanted to first verify I was extracting the bits, then interpreting them as movement, and only then translating those to the final "moves". In practice those are all the same kind of thing only varying their output so I came up with this:
(defun int-to-seq (n lst)
(let ((moves nil))
(dotimes (_ 4 (reverse moves))
(push (nth (logand n 3) lst) moves)
(setf n (lsh n -2)))))Which is expecting a list to switch on for the 4 cases. That makes each of those cases I describe look like this:
(defun int-to-bits (n) (int-to-seq n '((0 0) (0 1) (1 0) (1 1))))
(defun int-to-icons (n) (int-to-seq n '(↖ ↗ ↙ ↘)))
(defun int-to-dy-dx (n) (int-to-seq n '((-1 -1) (-1 1) (1 -1) (1 1))))I wanted to check my work because the paper does a nice job explaining things so thoroughly, e.g.
The visualization algorithm splits the fingerprint into 64 pairs of 2 bits. Figure 6 shows in which order these bit pairs are processed during the 64 steps of the algorithm: byte-wise from left to right and least significant bits first.
Fingerprint fc : 94 : b0 : c1 : ... : b7 Bits 11 11 11 00 : 10 01 01 00 : 10 11 00 00 : 11 00 00 01 : ... : 10 11 01 11 Step 4 3 2 1 8 7 6 5 12 11 10 9 16 15 14 13 ... 64 63 62 61
(mapcar #'int-to-bits (hexstr-to-ints "fc94b0c1"))
(((0 0) (1 1) (1 1) (1 1)) ((0 0) (0 1) (0 1) (1 0)) ((0 0) (0 0) (1 1) (1 0)) ((0 1) (0 0) (0 0) (1 1)))
You can see I decided to use the list index position for the "step" described, resulting in a visual re-ordering from the table. A similar check can be made against the movement described for pathological (least movement) fingerprints:
Movement: ↖ ↘ ↖ ↘ ...
Bit values: 11 00 11 00 binary = 0xcc hex
Fingerprint: cc:cc:cc:cc:cc:cc:cc:cc:cc:cc:cc:cc:cc:cc:cc:cc
(mapcar #'int-to-bits (hexstr-to-ints "cccc"))
(((0 0) (1 1) (0 0) (1 1)) ((0 0) (1 1) (0 0) (1 1)))
(mapcar #'int-to-icons (hexstr-to-ints "cccc"))
((↖ ↘ ↖ ↘) (↖ ↘ ↖ ↘))
Rather than implement the walk as a sequence of absolute position
index points on the grid I found it easier to mechanically advance
at each step using the offset for each possible move type, which I'm
calling dy and dx. Those values come from
the helper function above and look like this:
(mapcar #'int-to-dy-dx (hexstr-to-ints "abadcafe"))
(((1 1) (1 -1) (1 -1) (1 -1)) ((-1 1) (1 1) (1 -1) (1 -1)) ((1 -1) (1 -1) (-1 -1) (1 1)) ((1 -1) (1 1) (1 1) (1 1)))The bishop's movement is bounded at the edges of the field:
If Peter is at the border of the field, he cannot go through the wall, but has to slide to the side.
Which I implemented with a simple clamp function:
(defun clamp (min n max)
(cond ((> n max) max)
((< n min) min)
(t n)))That covers most of the necessary setup. All that remains is to initialize the field as an array of arrays with zero values, set the starting place in the middle, and for each movement (pair of dy dx) update the current position, incrementing the value there each time it is visited.
(defun walk (hash-str)
(let* ((-field (make-vector 9 nil))
(field (dotimes (i (length -field) -field)
(aset -field i (make-vector 17 0))))
(moves (mapcan #'int-to-dy-dx (hexstr-to-ints hash-str)))
(row-start (/ (length field) 2))
(col-start (/ (length (elt field 0)) 2))
(row row-start)
(column col-start))
(dolist (move moves)
(let ((dy (car move))
(dx (cadr move)))
(setf column (clamp 0 (+ column dx) (1- (length (elt field 0)))))
(setf row (clamp 0 (+ row dy) (1- (length field))))
(setf (aref (aref field row) column)
(clamp 0 (1+ (aref (aref field row) column)) 16))))
(setf (aref (aref field row-start) col-start) 15)
(setf (aref (aref field row) column) 16)
field))
This is a little bit crufty with the "internal" let binding for the
outer array and the loop defining the inner arrays returning the
outer array. That being said, it works and I don't have too much a
problem with it for being relatively small. The heart of the thing
is the dolist (move moves) which is just a for
move in moves loop to set the value of row-column.
I pick out row-start and col-start in
order to overwrite their values at the end to designate the start
and end points. The specific numbers used for start and end are a
little mysterious without understanding how the values are used.
The numeric grid isn't quite the intended result and still needs to
be decorated with the mapping of times a tile was visited to symbols
given as:
| Value | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 |
| Character | . | o | + | = | * | B | O | X | @ | % | & | # | / | ^ | S | E |
I also wanted to put a little border around the ASCII art
for aesthetic reasons completeness.
(defun decorate (field)
(with-current-buffer (get-buffer-create "*drunken-bishop*")
(erase-buffer)
(let ((width (length (aref field 0))))
(insert "+" (make-string width ?-) "+\n")
(dotimes (row-idx (length field))
(insert "|")
(dotimes (col-idx width)
(insert (aref " .o+=*BOX@%&#/^SE" (aref (aref field row-idx) col-idx))))
(insert "|\n"))
(insert "+" (make-string width ?-) "+"))))
I'm writing the output to a dedicated buffer, similar to how I
handled output
in Ook. make-string
simplifies the horizontal lines but otherwise things are very simple
due to the fixed width nature of the field. Symbols are directly
indexed in the doubly nested loop over field positions.
Of course, this whole thing comes from the openssh ecosystem and you
can view the real thing by setting VisualHostKey=true
when invoking ssh. In theory then I could confirm my drunken bishop
ASCII art against the output of my own server's host key:
$ ssh -o VisualHostKey=yes nprescott.com
Host key fingerprint is SHA256:hy3n0NU75rb+rWLEADC1/nI/L9ICjSGit0v2zWnDExo
+--[ED25519 256]--+
| oo. |
| ... . |
| .. . . |
| . ...+.. . |
| . . .S+=o + |
| . . E +B. oo . |
| .o. +.o+o o |
| o...o=+o.*. ..|
| ....+o +.*=oo|
+----[SHA256]-----+There's one minor thing, which is the fingerprint being reported in base64 while my implementation is expecting base16. That is only a little annoying to work around because openssh omits padding and emacs requires it, but the result is worth it. I could also have specified MD5 as the fingerprinting algorithm, as that is what was in use when the paper was written. It happens though that I find my server's MD5 fingerprint less visually interesting so I handle the base64 like this:
(decorate
(walk
(mapconcat (lambda (byte) (format "%02x" byte))
(base64-decode-string "hy3n0NU75rb+rWLEADC1/nI/L9ICjSGit0v2zWnDExo=") "")))
+-----------------+
| oo. |
| ... . |
| .. . . |
| . ...+.. . |
| . . .S+=o + |
| . . E +B. oo . |
| .o. +.o+o o |
| o...o=+o.*. ..|
| ....+o +.*=oo|
+-----------------+Identical!