drunken-bishop (empty) → 0.1.0.0
raw patch · 5 files changed
+422/−0 lines, 5 filesdep +arraydep +basedep +bytestring
Dependencies added: array, base, bytestring, cryptohash-sha256, drunken-bishop, pureMD5
Files
- Data/Digest/DrunkenBishop.hs +181/−0
- LICENSE +12/−0
- README.md +129/−0
- drunken-bishop.cabal +46/−0
- src/Main.hs +54/−0
+ Data/Digest/DrunkenBishop.hs view
@@ -0,0 +1,181 @@+{-|+Module: Data.Digest.DrunkenBishop+Copyright: (c) Getty Ritter, 2020+License: BSD+Maintainer: Getty Ritter <drunken-bishop@infinitenegativeutility.com>+Stability: stable++The [Drunken Bishop+algorithm](http://www.dirk-loss.de/sshvis/drunken_bishop.pdf) is the+binary fingerprint visualization algorithm used by OpenSSH when+generating and verifying keys. The intended use is as a visual aid for+"at a glance" comparing two keys by using the rough visual shape of+the output as a heuristic.++This module provides the 'drunkenBishop' function which should behave+identically to the OpenSSH visual fingerprinting algorithm: it takes a+bytestring and produces a string representing a 17x9 ASCII art image+which serves as the fingerprint for the input. It also exposes a few+configuration details to allow customization of the operation of the+algorithm: swapping out MD5 for another hash function, or using a+different-sized board, or using a different ASCII art visualization.+-}++{-# LANGUAGE BinaryLiterals #-}++module Data.Digest.DrunkenBishop+ ( -- * Drunken Bishop+ drunkenBishop,+ -- * Configurable Drunken Bishop+ DrunkenBishopOptions(..),+ drunkenBishopDefaultOptions,+ drunkenBishopWithOptions+ ) where++import Data.Array+import Data.Bits+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.Digest.Pure.MD5 (md5DigestBytes, md5)+import Data.Word (Word8)++type Board = Array (Int, Int) Word8++mkBoard :: (Int, Int) -> Board+mkBoard (width, height) = array bound [(i, 0) | i <- range bound]+ where+ bound = ((0, 0), (width -1, height -1))++toDirections :: BS.ByteString -> [Dir]+toDirections bs = case BS.uncons bs of+ Just (x, xs) ->+ toDir (x `shift` (-6))+ : toDir (x `shift` (-4))+ : toDir (x `shift` (-2))+ : toDir x+ : toDirections xs+ Nothing -> []++data Dir = UL | UR | DL | DR deriving (Eq, Show)++toDir :: Word8 -> Dir+toDir x = go (x .&. 0b11)+ where+ go 0b00 = UL+ go 0b01 = UR+ go 0b10 = DL+ go 0b11 = DR+ go _ = error "unreachable"++move :: (Int, Int) -> Dir -> (Int, Int) -> (Int, Int)+move (width, height) d (a, b) = snap (go d (a, b))+ where+ go UL (x, y) = (x - 1, y - 1)+ go UR (x, y) = (x + 1, y - 1)+ go DL (x, y) = (x - 1, y + 1)+ go DR (x, y) = (x + 1, y + 1)+ snap (x, y) = (clamp x 0 (width - 1), clamp y 0 (height - 1))++clamp :: Ord a => a -> a -> a -> a+clamp n low high+ | n < low = low+ | n > high = high+ | otherwise = n++-- | The default mapping from byte to ASCII character used by+-- OpenSSH. The intention of this mapping was to have characters of+-- increasing "noise" as the byte value goes up, with 15 and 16+-- instead mapping to special "begin" and "end" characters.+drunkenBishopOpenSSHCharMap :: Word8 -> Char+drunkenBishopOpenSSHCharMap n = case n of+ 00 -> ' '+ 01 -> '.'+ 02 -> 'o'+ 03 -> '+'+ 04 -> '='+ 05 -> '*'+ 06 -> 'B'+ 07 -> 'O'+ 08 -> 'X'+ 09 -> '@'+ 10 -> '%'+ 11 -> '&'+ 12 -> '#'+ 13 -> '/'+ 14 -> '^'+ 15 -> 'S'+ 16 -> 'E'+ _ -> '?'++-- | Once we've converted a hash into a sequence of two-bit 'Dir'+-- values, we can walk it, incrementing the values of board locations+-- as we pass them+runSteps :: (Int, Int) -> (Int, Int) -> [Dir] -> Board -> Board+runSteps _ pos [] b = b // [(pos, 16)]+runSteps size pos (d : ds) b+ | b ! pos == 15 = runSteps size newPos ds b+ | otherwise = runSteps size newPos ds (b // [(newPos, clamp ((b ! newPos) + 1) 0 14)])+ where+ newPos = move size d pos++-- | Convert a finalized board into a string+renderBoard :: DrunkenBishopOptions input -> Board -> String+renderBoard opts board =+ unlines+ [ foldr (:) "" [drunkenBishopCharMap opts (board ! (x, y)) | x <- [0 .. width -1]]+ | y <- [0 .. height -1]+ ]+ where+ (width, height) = drunkenBishopBoardSize opts++-- | A set of configuration options for specializing the Drunken+-- Bishop algorithm.+data DrunkenBishopOptions input = DrunkenBishopOptions+ { drunkenBishopHash :: input -> BS.ByteString,+ -- ^ The hashing function to use in order to convert an input+ -- value into a hash usable for a Drunken Bishop run.+ drunkenBishopBoardSize :: (Int, Int),+ -- ^ The board size used for a Drunken Bishop run.+ drunkenBishopInitialPosition :: Maybe (Int, Int),+ -- ^ The initial position of the bishop on the board. If this is+ -- 'Nothing', then the initial position will be @(width `div` 2,+ -- height `div` 2)@.+ drunkenBishopCharMap :: Word8 -> Char+ -- ^ The mapping from bytes to characters used for visualizing a+ -- Drunken Bishop run. The values @0x0@ through @0xE@ correspond+ -- to how many times the bishop has visited the cell in the course+ -- of a walk, while the values @0xE@ and @0xF@ are 'special' in+ -- that they represent the starting and ending position of the+ -- bishop, respectively.+ }++-- | The options used by the OpenSSH implementation of Drunken+-- Bishop. This uses the MD5 hash algorithm, starting the bishop at+-- the center of a a 17x9 grid, and uses [the character table+-- described here](http://www.dirk-loss.de/sshvis/drunken_bishop.pdf).+drunkenBishopDefaultOptions :: DrunkenBishopOptions BSL.ByteString+drunkenBishopDefaultOptions =+ DrunkenBishopOptions+ { drunkenBishopHash = md5DigestBytes . md5,+ drunkenBishopBoardSize = (17, 9),+ drunkenBishopInitialPosition = Nothing,+ drunkenBishopCharMap = drunkenBishopOpenSSHCharMap+ }++-- | Run the Drunken Bishop algorithm with the options chosen by+-- OpenSSH. See the documentation on 'drunkenBishopDefaultOptions' for+-- specifics on what those are.+drunkenBishop :: BSL.ByteString -> String+drunkenBishop = drunkenBishopWithOptions drunkenBishopDefaultOptions++-- | Run the Drunken Bishop algorithm with the provided set of options.+drunkenBishopWithOptions :: DrunkenBishopOptions input -> input -> String+drunkenBishopWithOptions opts bs = renderBoard opts finalBoard+ where+ (width, height) = drunkenBishopBoardSize opts+ initialBoard = mkBoard (width, height) // [(initialPosition, 15)]+ bishopPath = toDirections (drunkenBishopHash opts bs)+ finalBoard = runSteps (width, height) initialPosition bishopPath initialBoard+ initialPosition = case drunkenBishopInitialPosition opts of+ Nothing -> (width `div` 2, height `div` 2)+ Just pos -> pos
+ LICENSE view
@@ -0,0 +1,12 @@+Copyright (c) 2016, Getty Ritter+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,129 @@+# `drunken-bishop`++The [Drunken Bishop](http://www.dirk-loss.de/sshvis/drunken_bishop.pdf) algorithm is a visual fingerprinting algorithm originally implemented by OpenSSH for visualizing key fingerprints. This package implements OpenSSH's visualization while also offering extra configuration to allow for specialized uses.++## Basic usage++The `Data.Digest.DrunkenBishop(drunkenBishop)` function takes a bytestring and produces a multiline string representing the visualization of the hash of that string.++```haskell+>>> :set -XOverloadedStrings+>>> putStrLn (drunkenBishop "hello!")++ .+ . o+ = o+ . ^ B .+ o = . o ++ ..+.+ = E+ +o..=+ .. ..++```++## Configurable usage++The `Data.Digest.DrunkenBishop(DrunkenBishopOptions)` type contains several fields which can be configured to change the operation of the algorithm. The default used by the `drunkenBishop` function are kept in an instance of this type called `drunkenBishopDefaultOptions`.++The `drunkenBishopBoardSize` field can set the size of the overall fingerprint image. Note that smaller images will produce "noisier" fingerprints, while larger images will likely produce "sparser" fingerprints.++```haskell+> :set -XOverloadedStrings+> let opts = drunkenBishopDefaultOptions { drunkenBishopBoardSize = (9, 9) }+> putStrLn (drunkenBishopWithOptions opts "hello!")++ .+ ...+ .+..+ . ^++.+ o.=.oo+ .o.+ =.E+ oo..= .+ .. ..+```++The `drunkenBishopInitialPosition` field can change the initial position of the bishop:++```haskell+> :set -XOverloadedStrings+> let opts = drunkenBishopDefaultOptions { drunkenBishopInitialPosition = Just (0, 0) }+> putStrLn (drunkenBishopWithOptions opts "hello!")+S . ..+ . o ..+o o.+.+.. ++ .+ .... . o+ . ..o..+ .o.ooo E+ oo..o.+ .. .++```++The `drunkenBishopCharMap` field can change the ASCII visualizer used for the cells of the visualization algorithm:++```haskell+> :set -XOverloadedStrings+> import Data.Char (chr)+> let opts = drunkenBishopDefaultOptions { drunkenBishopCharMap = \ c -> chr (fromIntegral (c + 65)) }+> putStrLn (drunkenBishopWithOptions opts "hello!")+AAAAAAAAAAAAAAAAA+AAAAAAAAAAAAABAAA+AAAAAAAAAABACAAAA+AAAAAAAAAEACAAAAA+AAAAAABAOAGABAAAA+AAAAAAACAEABACADA+AAAAAAAABBDBDAEAQ+AAAAAAAAADCBBEAAA+AAAAAAAAABBAABBAA+```++Finally, the `drunkenBishopHash` field can change the hash function used by the Drunken Bishop algorithm. This is parametric and can take any type, but must produce a strict `ByteString`. Note that the default MD5 hash produces 128-bit values, so hash functions that produce more values will produce considerably "noisier" fingerprints unless you also change the fingerprint size. The following example uses `hashlazy` from the `cryptohash-sha256` package as an example:++```haskell+> :set -XOverloadedStrings+> import Crypto.Hash.SHA256 (hashlazy)+> let opts = drunkenBishopDefaultOptions { drunkenBishopHash = hashlazy }+> putStrLn (drunkenBishopWithOptions opts "hello!")+ .oo++ . .= o+ . o . o + .+ o . = . . = ..+ . = = ^ . . =o+ = + o +. o++ o ooo=.o . o+ . ..= =.o o.+ .o.E.. o...++```++## The `drunken-bishop` executable++The accompanying `drunken-bishop` executable takes a list of files, or if none are provided, a string on stdin, runs it through the fingerprinting routine, and prints it with a simple ASCII art frame. It accepts a few of the configuration options described above, as well.++```+$ printf "hello!" | drunken-bishop++-----------------++| |+| . |+| . o |+| = o |+| . ^ B . |+| o = . o + |+| ..+.+ = E|+| +o..= |+| .. .. |++-----------------++$ printf "hello!" | drunken-bishop --sha256++-----------------++| .oo+ |+| . .= o |+| . o . o + .|+| o . = . . = ..|+| . = = ^ . . =o |+| = + o +. o+|+| o ooo=.o . o|+| . ..= =.o o.|+| .o.E.. o...|++-----------------++```
+ drunken-bishop.cabal view
@@ -0,0 +1,46 @@+name: drunken-bishop+version: 0.1.0.0+synopsis: An implementation of the Drunken Bishop visual fingerprinting algorithm+description: The [Drunken Bishop](http://www.dirk-loss.de/sshvis/drunken_bishop.pdf)+ algorithm is a visual fingerprinting algorithm originally+ implemented by OpenSSH for visualizing key fingerprints. This+ package implements OpenSSH's visualization while also offering+ extra configuration to allow for specialized uses.+ .+ The Drunken Bishop algorithm was designed heuristically, and+ therefore __should not be considered cryptographically strong__.+license: BSD3+license-file: LICENSE+author: Getty Ritter <drunken-bishop@infinitenegativeutility.com>+maintainer: Getty Ritter <drunken-bishop@infinitenegativeutility.com>+copyright: ©2020 Getty Ritter+category: Cryptography+build-type: Simple+cabal-version: 1.18+extra-source-files:+ README.md++library+ exposed-modules: Data.Digest.DrunkenBishop+ ghc-options: -Wall+ build-depends: base >=4.7 && <5+ , array >= 0.5.4 && <0.6+ , bytestring >= 0.10.10 && <0.11+ , pureMD5 >= 2.1.3 && <2.2+ default-language: Haskell2010++flag no-exe+ description: Do not build the drunken-bishop executable+ default: True++executable drunken-bishop+ if flag(no-exe)+ buildable: False+ hs-source-dirs: src+ main-is: Main.hs+ ghc-options: -Wall+ build-depends: base >=4.7 && <5+ , drunken-bishop+ , bytestring >= 0.10.10 && <0.11+ , cryptohash-sha256 >= 0.11.101 && <0.12+ default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,54 @@+module Main (main) where++import Crypto.Hash.SHA256 (hashlazy)+import qualified Data.ByteString.Lazy as BS+import Data.Digest.DrunkenBishop+import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), getOpt)+import System.Environment (getArgs)++readSize :: String -> (Int, Int)+readSize str = case reads str of+ [(x, 'x' : rest)] -> case reads rest of+ [(y, "")] -> (x, y)+ _ -> error msg+ _ -> error msg+ where+ msg = "Unable to parse " ++ str ++ " as an [Int]x[Int] pair"++options :: [OptDescr (DrunkenBishopOptions BS.ByteString -> DrunkenBishopOptions BS.ByteString)]+options =+ [ Option+ ['s']+ ["size"]+ (ReqArg (\o opts -> opts {drunkenBishopBoardSize = readSize o}) "[WIDTH]x[HEIGHT]")+ "The size of the art fingerprint",+ Option+ ['p']+ ["position"]+ (ReqArg (\o opts -> opts {drunkenBishopInitialPosition = Just (readSize o)}) "[X]x[Y]")+ "The initial position of the bishop",+ Option+ []+ ["sha256"]+ (NoArg (\opts -> opts {drunkenBishopHash = hashlazy}))+ "Use SHA256 instead of MD5 for the source hash"+ ]++main :: IO ()+main = do+ argv <- getArgs+ let (opts, files) = case getOpt Permute options argv of+ (fs, args, []) -> (foldr ($) drunkenBishopDefaultOptions fs, args)+ (_, _, errs) -> error (unlines errs)+ f <- case files of+ [] -> BS.getContents+ _ -> mconcat (map BS.readFile files)+ let boardWidth = fst (drunkenBishopBoardSize opts)+ frame = "+" ++ replicate boardWidth '-' ++ "+"+ putStrLn frame+ mapM_+ putStrLn+ [ "|" ++ ln ++ "|"+ | ln <- lines (drunkenBishopWithOptions opts f)+ ]+ putStrLn frame