bisect-binary (empty) → 0.1
raw patch · 8 files changed
+615/−0 lines, 8 filesdep +basedep +bytestringdep +directorysetup-changed
Dependencies added: base, bytestring, directory, filepath, hashable, haskeline, integer-logarithms, optparse-applicative, process, terminal-size, time, yaml
Files
- ChangeLog.md +5/−0
- LICENSE +20/−0
- README.md +111/−0
- Setup.hs +2/−0
- bisect-binary.cabal +51/−0
- src/Braille.hs +22/−0
- src/Intervals.hs +113/−0
- src/Main.hs +291/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for bisect-binary++## 0.1++* First version.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 Joachim Breitner++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,111 @@+bisect-binary+=============++This little program helps with the following task:++You need to analyse some binary file (e.g., the firmware for some+microcontroller). You want to understand how it does certain things, but the+file is big. One approach to help you in the process is to erase parts of the file+(by overwriting it with binary zeros) and see if the file still does what it+should be doing. If it does, then you know that the interesting parts are in+another part of the file.++`binary-binary` assists in this process by doing the book-keeping and zeroing+out parts of the file.+++Screenshot+----------++The following screenshot shows `bisect-binary` in action, as it determins which+part of a “Hello World” program written in Haskell are actually needed:+It is taken from a [Asciinema demo], and edited to fit your screen.++```+$ bisect-binary -i hello -o hello-test -c 'chmod +x hello-test; timeout -k2s 2s ./hello-test+…+12.7% zeroes 131072B new 897000B left [⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⠛⠛⠛⠛⠛⠛⠁⠀⠀⠀⠀⠀⠀⠀⠀⣠⣤⣤⣤⣤⣤⣤⡄] [YNRUQ?] n+Segmentation fault+12.7% zeroes 131072B new 897000B left [⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠙⠛⠛⠛⠛⠛⠋⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⣤⣤⣤⣤⣤⣤⡄] [YNRUQ?] n+hello-test: internal error: stg_ap_p_ret+(GHC version 8.0.2 for x86_64_unknown_linux)+Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug+Aborted+12.7% zeroes 131072B new 897000B left [⠀⠀⠀⠀⠀⠈⠛⠛⠛⠛⠛⠛⠁⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⣤⣤⣤⣤⣤⣤⡄] [YNRUQ?] n+Hello World!+12.7% zeroes 65536B new 897000B left [⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⠛⣻⣿⣥⣤⣤⣤⣤⡄] [YNRUQ?] y+Hello World!+15.9% zeroes 65536B new 864232B left [⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠙⠛⠛⢋⣤⣤⣤⣤⣤⣤⣤⣤⡄] [YNRUQ?] y+```++[Asciinema demo]: https://asciinema.org/a/7FcXeDU1BTa0SvynqSLezuaQ0?speed=2++Installation+------------++Install Haskell, and run `cabal install bisect-binary`. You will find the+binary in `~/.cabal/bin/bisect-binary`, and may want to move that to your+`$PATH`.++Usage+-----++Run `bisect-binary` with the input file, the output file, and optionally a+command to run on every try (which could, for example, flash the+microcontroller with the binary):++```+$ bisect-binary --help+Binary file bisector++Usage: bisect-binary (-i|--input FILE) (-o|--output FILE) [-c|--command COMMAND]+ Fills a file with as much zeroes as possible++Available options:+ -h,--help Show this help text+ -i,--input FILE input file+ -o,--output FILE output file+ -c,--command COMMAND command to run+```++Now `bisect-binary` will zero out parts of the file and ask you if the result is+now good or bad, as seen in the screenshot above. Your options are:++ * `Y`: Mark this example as good. It will remember which portions it zeroed out and from now+ on only add to it+ * `N`: Mark this example as bad. It will revert to the previous good version and try out+ other parts of the file.+ * `R`: Re-run the command.+ * `U`: Undo the last marking.+ * `Q`: Quit the program.++Upon quitting, `bisect-binary` will leave `output` in the last known state.++A persisent file name `output-file.bisect.log` is kept, so you can quit and+restart at any time without losing your work.++The status line tells you:+ * how much of the file could be zeroed out sucessfully.+ * how many bytes it is now adding to that.+ * how many bytes of the file may be relevant for your task+ * a status bar describing the progress:++ * The top row visualizes the part of the file that we know we can zero out for sure.+ * The bottom row visualizes the part that we are zeroing out next.++ Two dots indicate _all_ bytes in this part, one dot indicates _some_ bytes.++Contact+-------++Please reports bugs and missing features at the [GitHub bugtracker]. This is+also where you can find the [source code].++`bisect-binary` was written by [Joachim Breitner] and is licensed under a permissive MIT+[license].++[GitHub bugtracker]: https://github.com/nomeata/bisect-binary/issues+[source code]: https://github.com/nomeata/bisect-binary+[Joachim Breitner]: http://www.joachim-breitner.de/+[license]: https://github.com/nomeata/gipeda/blob/LICENSE+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bisect-binary.cabal view
@@ -0,0 +1,51 @@+name: bisect-binary+version: 0.1+synopsis: Determine relevant parts of binary data+description:+ This little program helps with the following task:+ .+ You need to analyse some binary file (e.g., the firmware for some+ microcontroller). You want to understand how it does certain things, but the+ file is big. One approach to help you in the process is to erase parts of the file+ (by overwriting it with binary zeros) and see if the file still does what it+ should be doing. If it does, then you know that the interesting parts are in+ another part of the file.+ .+ `binary-binary` assists in this process by doing the book-keeping and zeroing+ out parts of the file.+homepage: http://github.com/nomeata/bisect-binary+license: MIT+license-file: LICENSE+author: Joachim Breitner+maintainer: mail@joachim-breitner.de+copyright: 2017 Joachim Breitner+category: Development+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10+tested-with: GHC ==8.0.2, GHC ==8.2.2++executable bisect-binary+ main-is: Main.hs+ other-modules: Intervals, Braille+ other-extensions: LambdaCase, DeriveGeneric+ build-depends: base >=4.9 && <4.12+ build-depends: bytestring+ build-depends: directory+ build-depends: filepath+ build-depends: optparse-applicative >=0.13 && <0.14+ build-depends: yaml >=0.8 && <0.9+ build-depends: haskeline >=0.7 && <0.8+ build-depends: time+ build-depends: hashable+ build-depends: integer-logarithms+ build-depends: terminal-size+ build-depends: process+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -Wno-name-shadowing++source-repository head+ type: git+ location: https://github.com/nomeata/bisect-binary+
+ src/Braille.hs view
@@ -0,0 +1,22 @@+module Braille where++import Data.Char+import Data.Bits++dotsToBrailleBar :: [Int] -> String+dotsToBrailleBar [] = ""+dotsToBrailleBar [x] = [dotsToBrailleChar x 0]+dotsToBrailleBar (x:y:xs) = dotsToBrailleChar x y : dotsToBrailleBar xs++dotsToBrailleChar :: Int -> Int -> Char+dotsToBrailleChar n m =+ chr $ 0x2800 + sum+ [ bit 0 * fromEnum (testBit n 3)+ , bit 1 * fromEnum (testBit n 2)+ , bit 2 * fromEnum (testBit n 1)+ , bit 3 * fromEnum (testBit m 3)+ , bit 4 * fromEnum (testBit m 2)+ , bit 5 * fromEnum (testBit m 1)+ , bit 6 * fromEnum (testBit n 0)+ , bit 7 * fromEnum (testBit m 0)+ ]
+ src/Intervals.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE LambdaCase, DeriveGeneric #-}++module Intervals where++import qualified Data.ByteString.Lazy as BS+import Text.Printf+import Data.List hiding (union, intersect)+import Data.Monoid ((<>))+import Data.Yaml (ToJSON, FromJSON)+import GHC.Generics (Generic)+import Data.Function+import Data.Int+import Prelude hiding (subtract)++type Offset = Int64++data Interval = I { from :: Offset, to :: Offset }+ deriving (Show,Generic)++newtype Intervals = Intervals [Interval]+ deriving (Show,Generic)++mkInterval :: Offset -> Offset -> Intervals+mkInterval f t | f < t = Intervals [I f t]+ | otherwise = Intervals []++fullIntervals :: Offset -> Intervals+fullIntervals len = mkInterval 0 len++nullInterval :: Intervals+nullInterval = Intervals []++size :: Intervals -> Offset+size (Intervals is) = sum [ t - f | I f t <- is ]++isEmpty :: Intervals -> Bool+isEmpty (Intervals is) = null is++subSetOf :: Intervals -> Intervals -> Bool+subSetOf a b = isEmpty (a `subtract` b)++intersects :: Intervals -> Intervals -> Bool+intersects a b = not $ isEmpty (a `intersect` b)++intersect :: Intervals -> Intervals -> Intervals+intersect (Intervals is1) (Intervals is2) = Intervals $ go is1 is2+ where+ go _ [] = []+ go [] _ = []+ go (i1:is1) (i2:is2)+ -- reorder for symmetry+ | to i1 < to i2 = go (i2:is2) (i1:is1)+ -- disjoint+ | from i1 >= to i2 = go (i1:is1) is2+ -- overlapping+ | otherwise = I f' (to i2) : go (i1 { from = to i2} : is1) is2+ where f' = max (from i1) (from i2)+++union :: Intervals -> Intervals -> Intervals+union (Intervals is1) (Intervals is2) = Intervals $ go is1 is2+ where+ go is [] = is+ go [] is = is+ go (i1:is1) (i2:is2)+ -- reorder for symmetry+ | to i1 < to i2 = go (i2:is2) (i1:is1)+ -- disjoint+ | from i1 > to i2 = i2 : go (i1:is1) is2+ -- overlapping+ | otherwise = go (i1 { from = f'} : is1) is2+ where f' = min (from i1) (from i2)++subtract :: Intervals -> Intervals -> Intervals+subtract (Intervals is1) (Intervals is2) = Intervals $ go is1 is2+ where+ go is [] = is+ go [] _ = []+ go (i1:is1) (i2:is2)+ -- i2 past i1+ | to i1 <= from i2 = i1 : go is1 (i2:is2)+ -- i1 past i2+ | to i2 <= from i1 = go (i1:is1) is2+ -- i1 contained in i2+ | from i2 <= from i1 , to i1 <= to i2 = go is1 (i2:is2)+ -- i2 covers beginning of i1+ | from i1 >= from i2 = i1 { from = to i2} : go is1 is2+ -- i2 covers end of i1+ | to i1 <= to i2 = i1 { to = from i2} : go is1 (i2:is2)+ -- i2 in the middle of i1+ | otherwise = I (from i1) (from i2) :+ I (to i2) (to i1) : go is1 is2+++setZeros :: BS.ByteString -> Intervals -> BS.ByteString+setZeros s (Intervals is) = foldl' go s is+ where+ go s (I f t) = prefix <> zeroes <> postfix+ where+ (tmp, postfix) = BS.splitAt t s+ (prefix, _discard) = BS.splitAt f tmp+ zeroes = BS.replicate (t-f) 0++ppInterval :: Interval -> String+ppInterval (I f t) = printf "0x%04X-0x%04X" f t++ppIntervals :: Intervals -> String+ppIntervals (Intervals xs) = intercalate " " (map ppInterval xs)++instance FromJSON Interval+instance ToJSON Interval+instance FromJSON Intervals+instance ToJSON Intervals
+ src/Main.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE LambdaCase, DeriveGeneric #-}++import qualified Data.ByteString.Lazy as BS+import Text.Printf+import System.Directory+import System.Exit+import System.FilePath+import Data.Foldable+import Data.List hiding (union, intersect)+import Options.Applicative+import Control.Monad+import Data.Monoid ((<>))+import Data.Yaml (decodeFileEither, encodeFile, prettyPrintParseException, ToJSON, FromJSON)+import Data.Bifunctor+import GHC.Generics (Generic)+import System.Console.Haskeline+import Data.Function+import Control.Monad.IO.Class+import Data.Int+import Data.Time+import Data.Hashable+import Math.NumberTheory.Logarithms+import Data.Char+import System.Process+import Prelude hiding (subtract)+import qualified System.Console.Terminal.Size++import Intervals+import Braille++-- Core idea: The intervals to try to zero out++intervalsToTry :: Offset -> [Intervals]+intervalsToTry len =+ [ mkInterval b (b+size)+ | level <- toZero big+ , let size = 2^level+ , let shift = if odd (level - big) then size`div`2 else 0+ , let upper = len - size - shift+ , b <- [upper, upper - size .. 0]+ ]+ where big = integerLog2 (fromIntegral len)+ toZero n = [n,(n-1)..0]++-- Data storage++data Log = Log+ { lgFileSize :: Offset+ , lgFileHash :: Int+ , lgLogs :: [LogEntry]+ }+ deriving (Show,Generic)++data LogEntry = LogEntry+ { leDate :: ZonedTime+ , leOk :: Bool+ , leZeroed :: Intervals+ }+ deriving (Show,Generic)++instance FromJSON Log+instance ToJSON Log+instance FromJSON LogEntry+instance ToJSON LogEntry++initLog :: BS.ByteString -> Log+initLog input = Log+ { lgFileSize = BS.length input+ , lgFileHash = hash input+ , lgLogs = []+ }++checkLog :: Log -> BS.ByteString -> InputT IO Log+checkLog log input+ | lgFileSize log /= BS.length input = do+ outputStrLn $ printf "ERROR: Log input file size was %i, current input file is %i. Aborting" (lgFileSize log) (BS.length input)+ liftIO $ exitFailure+ | lgFileHash log /= hash input = do+ outputStrLn "WARN: Log input file hash differns from actual input file hash."+ outputStrLn "Do you want to continue?"+ getInputChar "Y/N?" >>= \case+ Just 'Y' -> return log+ _ -> do+ outputStrLn "Goodbye!"+ liftIO $ exitFailure+ | otherwise = do+ outputStrLn $ printf "Loaded log file with %d previous attempts." (length (lgLogs log))+ return log++-- | Aggregate, minmal knowledge of which parts of the file are needed+--+data Digest = Digest+ { conservative :: Intervals+ -- ^ These bits can safely be zeroes+ , needed :: [Intervals]+ -- ^ At least one byte in each of these is needed.+ -- (Invariant: These are disjoint from the conservative ones)+ }+ deriving (Show,Generic)++digestLog :: Log -> Digest+digestLog log = Digest conservative needed+ where+ (okEntries, badEntries) =+ bimap (map leZeroed) (map leZeroed) $+ partition leOk (lgLogs log)++ conservative = foldl' union nullInterval okEntries+ needed = prune (map (`subtract` conservative) badEntries)++ -- could remove subsumed entries here+ prune = id++-- | It is pointless trying to zero an interval if it is a subset of what we+-- already know can be zeroes, or if any failed case in the past shows that+-- is a subset of this.+pointless :: Intervals -> Digest -> Bool+pointless try digest =+ try `subSetOf` conservative digest ||+ any (`subSetOf` try) (needed digest)++-- The main code++work :: FilePath -> FilePath -> Maybe String -> IO ()+work inputFP outputFP commandM = runInputT defaultSettings $ do+ input <- liftIO $ BS.readFile inputFP+ let len = BS.length input++ when (len == 0) $ do+ outputStrLn $ printf "%s is empty." inputFP+ liftIO $ exitSuccess++ let logFile = outputFP <.> "bisect.log"++ let revert digest = do+ statusText (conservative digest) nullInterval True >>= outputStrLn+ liftIO $ BS.writeFile outputFP $ setZeros input (conservative digest)+ outputStrLn $ printf "Reverted %s to last known good output." outputFP++ run_cmd = liftIO $ for_ commandM $ \cmd -> do+ ph <- spawnCommand cmd+ waitForProcess ph++ -- A single run+ test zeros = do+ liftIO $ BS.writeFile outputFP $ setZeros input zeros+ run_cmd++ ask log msg = fix $ \loop -> do+ getInputChar msg >>= pure . fmap toUpper >>= \case+ Just 'Y' -> do+ return True+ Just 'N' -> do+ return False+ Just 'Q' -> do+ revert (digestLog log)+ liftIO $ exitSuccess+ Just 'R' -> do+ run_cmd+ loop+ Just 'U' -> do+ let log' = log { lgLogs = init (lgLogs log) }+ steps log'+ -- code smell+ liftIO $ exitSuccess+ Just '?' -> do+ outputStrLn "Keys: Y: good. N: bad. R: rerun command. U: Undo. Q: Quit"+ loop+ _ -> loop++ statusText :: MonadIO m => Intervals -> Intervals -> Bool -> m String+ statusText conservative toTry done = liftIO $ do+ w <- getWidth+ let barw = w - 57+ let zeroPerc = 100 * fromIntegral (size conservative) / fromIntegral len+ let nonZeroBytes = len - size conservative+ return $ printf "%4.1f%% zeroes %12s %7dB left %s%s"+ (zeroPerc :: Double)+ (if done then "" else printf "%7dB new" (size toTry))+ nonZeroBytes+ (if barw > 5 then braille barw len conservative toTry else "")+ (if done then "" else " [YNRUQ?] ")+++ -- Single step of the main loop+ step log toTry+ | pointless toTry digest = return log+ | otherwise = do+ let zeros = conservative digest `union` toTry+ test zeros+ result <- statusText (conservative digest) toTry False >>= ask log+ stamp <- liftIO $ getZonedTime+ let entry = LogEntry { leDate = stamp, leOk = result, leZeroed = zeros }+ let log' = log { lgLogs = lgLogs log ++ [entry] }+ liftIO $ encodeFile logFile log'+ return $ log'+ where+ digest = digestLog log++ -- Main loop+ steps log = do+ foldM_ step log (intervalsToTry len)+ outputStrLn $ printf "Done!"+ -- TODO: What now?+++ -- Initialization+ initialLog <- liftIO (doesFileExist logFile) >>= \case+ False -> do+ outputStrLn $ printf "Cannot find %s, starting from scratch." logFile+ return (initLog input)+ True -> do+ liftIO (decodeFileEither logFile) >>= \case+ Left error -> do+ outputStrLn $ printf "ERROR: Cannot parse %s:"+ outputStrLn $ prettyPrintParseException error+ liftIO $ exitFailure+ Right log -> do+ outputStrLn $ printf "Loading log file %s." logFile+ checkLog log input++ steps initialLog++-- Argument handling++main :: IO ()+main = join . customExecParser (prefs showHelpOnError) $+ info (helper <*> parser)+ ( fullDesc+ <> header "Binary file bisector"+ <> progDesc "Fills a file with as much zeroes as possible"+ )+ where+ parser :: Parser (IO ())+ parser =+ work+ <$> strOption+ ( long "input"+ <> short 'i'+ <> metavar "FILE"+ <> help "input file"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> metavar "FILE"+ <> help "output file"+ )+ <*> optional (strOption+ ( long "command"+ <> short 'c'+ <> metavar "COMMAND"+ <> help "command to run"+ ))++-- Pretty progress bar using braille symbols:++data Cover = NoCover | SomeCover | FullCover+ deriving (Eq, Ord)++braille :: Int -> Offset -> Intervals -> Intervals -> String+braille width len lower upper = "[" ++ bar ++ "]"+ where+ bar = dotsToBrailleBar (map (toBits . go) parts)++ parts :: [Intervals] -- (width-2)*2 intervals+ parts = [mkInterval n (min (n + step) len) | n <- [0,step..len-1] ]+ where step = len `div` fromIntegral (2*(width - 2))++ descOverlap :: Intervals -> Intervals -> Cover+ descOverlap big small+ | small `subSetOf` big = FullCover+ | small `intersects` big = SomeCover+ | otherwise = NoCover++ go :: Intervals -> (Cover, Cover)+ go i = (lower `descOverlap` i, upper `descOverlap` i)++ toBits :: (Cover, Cover) -> Int+ toBits (c1, c2) = sum+ [ 1 * fromEnum (c1 >= SomeCover)+ , 2 * fromEnum (c1 >= FullCover)+ , 4 * fromEnum (c2 >= FullCover)+ , 8 * fromEnum (c2 >= SomeCover)+ ]+++getWidth :: IO Int+getWidth = maybe 80 System.Console.Terminal.Size.width <$>+ System.Console.Terminal.Size.size+