diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2011, Kevin Cantu +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + +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 +OWNER 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. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,222 @@ +-- | +-- Module : Main +-- Copyright : (c) 2011 Kevin Cantu +-- +-- License : BSD-style +-- Maintainer : Kevin Cantu +-- Stability : experimental +-- +-- A demo program providing a command line `blakesum` utility which behaves +-- much like the sha512sum or shasum software available for various platforms +module Main (main) where + +import Data.Digest.BLAKE +import qualified Data.ByteString.Lazy as B +import System +--import System.IO +import IO +import System.Console.GetOpt +import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy.Encoding as E +import Data.Word + + +-- command line options +data Options = Options { help :: Bool + , check :: Bool + , algorithm :: Integer + , salt_ :: B.ByteString + } + + +-- command line defaults +defaultOpts :: Options +defaultOpts = Options { help = False + , check = False + , algorithm = 512 + , salt_ = B.take 32 $ B.repeat 0 + } + + +-- command line description +-- this format is kinda bone headed: +-- [Option short [long] (property setter-function hint) description] +options :: [ OptDescr (Options -> IO Options) ] +options = [ Option "a" ["algorithm"] + (ReqArg + (\arg opt -> let alg = read arg :: Integer + in + if elem alg [256,512,224,384] + then return opt { algorithm = alg } + else error "please choose a working algorithm size") + "BITS") + "256, 512, 224, 384 (default: 512)" + + , Option "c" ["check"] + (NoArg $ \opt -> return opt { check = True }) + "check saved hashes" + + , Option "s" ["salt"] + (ReqArg + (\arg opt -> let s = (read ("[" ++ arg ++ "]")) :: [Word8] + in + if (length $ filter (<0) s) > 0 + then error "please specify a salt of positive numbers" + else return opt { salt_ = B.pack s }) + "SALT") + "one positive uint per byte, salt: \"0,0,...0,0\"" + + , Option "h" ["help"] + (NoArg $ \_ -> do + prg <- getProgName + hPutStrLn stderr $ usageInfo prg options + exitWith ExitSuccess) + "display this help and exit" + + , Option "v" ["version"] + (NoArg $ \_ -> do + me <- getProgName + hPutStrLn stderr $ me ++ " version 0.5" + exitWith ExitSuccess) + "display version and exit" + ] + + +-- apply a function (which uses the path) to a list of files and/or stdin +fileMapWithPath :: ( FilePath -> B.ByteString -> IO () ) -> [FilePath] -> IO () +fileMapWithPath f paths = + let + -- apply f to stdin + stdinF :: IO () + stdinF = B.getContents >>= f "-" + + -- apply f to a file (or stdin, when "-") + fileF :: FilePath -> IO () + fileF "-" = stdinF + fileF path = (B.readFile path >>= f path) `catch` (\e -> hPutStrLn stderr (show e)) + in + case paths of + [] -> stdinF + _ -> mapM_ fileF paths + + +-- apply a function to a list of files and/or stdin +fileMap :: ( B.ByteString -> IO () ) -> [FilePath] -> IO () +fileMap f paths = fileMapWithPath (\_ -> f) paths + + + +-- compute a hash, return text +getHash256 :: B.ByteString -> B.ByteString -> T.Text +getHash256 salt message = textDigest $ blake256 salt message +getHash224 :: B.ByteString -> B.ByteString -> T.Text +getHash224 salt message = textDigest $ blake224 salt message +getHash512 :: B.ByteString -> B.ByteString -> T.Text +getHash512 salt message = textDigest $ blake512 salt message +getHash384 :: B.ByteString -> B.ByteString -> T.Text +getHash384 salt message = textDigest $ blake384 salt message + + +-- print out the BLAKE hash followed by the file name +printHash :: (B.ByteString -> B.ByteString -> T.Text) + -> B.ByteString + -> String + -> B.ByteString + -> IO () + +printHash getHash salt path message = + do + hash <- return $ getHash salt message + B.putStrLn $ E.encodeUtf8 $ T.concat [hash, T.pack " *", T.pack path] + + +-- check one hash line (i.e., aas98d4a654...5756 *README.txt) +checkHash :: (B.ByteString -> B.ByteString -> T.Text) + -> B.ByteString + -> T.Text + -> IO () + +checkHash getHash salt line = + let + [savedHash, path] = T.splitOn (T.pack " *") line + printStatus status = B.putStrLn $ E.encodeUtf8 $ T.append path $ T.pack $ ": " ++ status + in + (do + message <- B.readFile (T.unpack path) + + printStatus $ if savedHash == getHash salt message + then "OK" + else "FAILED" + + ) `catch` (\e -> hPutStrLn stderr (show e) + >> printStatus "FAILED open or read") + + +-- print hashes of given files +printHashes :: Num a => a -> B.ByteString -> [FilePath] -> IO () +printHashes alg salt paths = + let + printHash' = + case alg of + 256 -> printHash getHash256 + 224 -> printHash getHash224 + 512 -> printHash getHash512 + 384 -> printHash getHash384 + _ -> error "unavailable algorithm size" + in + fileMapWithPath (printHash' salt) paths + + +-- check hashes within given files +checkHashes :: Num a => a -> B.ByteString -> [FilePath] -> IO () +checkHashes alg salt paths = + let + -- check message (file) of hashes + checkHashesInMessage f salt' = mapM_ (checkHash f salt') + + + checkHashes' = + case alg of + 256 -> checkHashesInMessage getHash256 + 224 -> checkHashesInMessage getHash224 + 512 -> checkHashesInMessage getHash512 + 384 -> checkHashesInMessage getHash384 + _ -> error "unavailable algorithm size" + in + fileMap ((checkHashes' salt) . T.lines . E.decodeUtf8) paths + + +main :: IO () +main = + do + args <- getArgs + + -- call getOpt with the option description + -- ignoring errors + let (actions, nonOptions, _) = getOpt Permute options args + + -- process the defaults with those actions + -- returns command line properties + opts <- foldl (>>=) (return defaultOpts) actions + + -- assign the results + -- via destructuring assignment + let Options { check = check' + , algorithm = algorithm' + , salt_ = salt' + } = opts + + let salt'' = case algorithm' of + 256 | B.length salt' == 16 -> salt' + 512 | B.length salt' == 32 -> salt' + _ -> error "salt should be 32 (default) or 16 bytes" + + -- are we in check mode? + let run = if check' + then checkHashes -- verify hashes listed in given files + else printHashes -- output hashes of given files + + -- either check or print hashes + run algorithm' salt'' nonOptions + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/blakesum-demo.cabal b/blakesum-demo.cabal new file mode 100644 --- /dev/null +++ b/blakesum-demo.cabal @@ -0,0 +1,39 @@ +name: blakesum-demo +version: 0.5 +synopsis: The BLAKE SHA-3 candidate hashes, in Haskell +description: + . + This provides an executable which relies on the `blakesum` library, `Data.Digest.BLAKE`. + . + Usage: + blakesum [--algorithm=BITS] [--check] [--salt=SALT] FILE(S) + . + Contributions and optimizations are welcome! + . +category: Cryptography +stability: experimental +license: BSD3 +license-file: LICENSE +author: Kevin Cantu +maintainer: Kevin Cantu +copyright: (c) 2011 Kevin Cantu +homepage: https://github.com/killerswan/Haskell-BLAKE +bug-reports: https://github.com/killerswan/Haskell-BLAKE/issues +build-type: Simple +cabal-version: >=1.8 + +source-repository head + type: git + location: https://github.com/killerswan/Haskell-BLAKE + +executable blakesum + main-is: Main.hs + hs-source-dirs: . + build-depends: base >= 4 && < 5, + blakesum >= 0 && < 1, + bytestring >= 0 && < 1, + haskell98 >= 1 && < 2, + text >= 0 && < 1, + vector >= 0 && < 1 + +