2013-05-08 15:17:09 +00:00
|
|
|
{- Calculating a SHA checksum with an external command.
|
|
|
|
-
|
Use cryptohash rather than SHA for hashing.
This is a massive win on OSX, which doesn't have a sha256sum normally.
Only use external hash commands when the file is > 1 mb,
since cryptohash is quite close to them in speed.
SHA is still used to calculate HMACs. I don't quite understand
cryptohash's API for those.
Used the following benchmark to arrive at the 1 mb number.
1 mb file:
benchmarking sha256/internal
mean: 13.86696 ms, lb 13.83010 ms, ub 13.93453 ms, ci 0.950
std dev: 249.3235 us, lb 162.0448 us, ub 458.1744 us, ci 0.950
found 5 outliers among 100 samples (5.0%)
4 (4.0%) high mild
1 (1.0%) high severe
variance introduced by outliers: 10.415%
variance is moderately inflated by outliers
benchmarking sha256/external
mean: 14.20670 ms, lb 14.17237 ms, ub 14.27004 ms, ci 0.950
std dev: 230.5448 us, lb 150.7310 us, ub 427.6068 us, ci 0.950
found 3 outliers among 100 samples (3.0%)
2 (2.0%) high mild
1 (1.0%) high severe
2 mb file:
benchmarking sha256/internal
mean: 26.44270 ms, lb 26.23701 ms, ub 26.63414 ms, ci 0.950
std dev: 1.012303 ms, lb 925.8921 us, ub 1.122267 ms, ci 0.950
variance introduced by outliers: 35.540%
variance is moderately inflated by outliers
benchmarking sha256/external
mean: 26.84521 ms, lb 26.77644 ms, ub 26.91433 ms, ci 0.950
std dev: 347.7867 us, lb 210.6283 us, ub 571.3351 us, ci 0.950
found 6 outliers among 100 samples (6.0%)
import Crypto.Hash
import Data.ByteString.Lazy as L
import Criterion.Main
import Common
testfile :: FilePath
testfile = "/run/shm/data" -- on ram disk
main = defaultMain
[ bgroup "sha256"
[ bench "internal" $ whnfIO internal
, bench "external" $ whnfIO external
]
]
sha256 :: L.ByteString -> Digest SHA256
sha256 = hashlazy
internal :: IO String
internal = show . sha256 <$> L.readFile testfile
external :: IO String
external = do
s <- readProcess "sha256sum" [testfile]
return $ fst $ separate (== ' ') s
2013-09-22 23:45:08 +00:00
|
|
|
- This is typically a bit faster than using Haskell libraries,
|
|
|
|
- by around 1% to 10%. Worth it for really big files.
|
2013-05-08 15:17:09 +00:00
|
|
|
-
|
|
|
|
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
2014-05-10 14:01:27 +00:00
|
|
|
- License: BSD-2-clause
|
2013-05-08 15:17:09 +00:00
|
|
|
-}
|
|
|
|
|
|
|
|
module Utility.ExternalSHA (externalSHA) where
|
|
|
|
|
|
|
|
import Utility.SafeCommand
|
|
|
|
import Utility.Process
|
|
|
|
import Utility.FileSystemEncoding
|
|
|
|
import Utility.Misc
|
2014-07-14 02:27:37 +00:00
|
|
|
import Utility.Exception
|
2013-05-08 15:17:09 +00:00
|
|
|
|
|
|
|
import Data.List
|
|
|
|
import Data.Char
|
|
|
|
import Control.Applicative
|
|
|
|
import System.IO
|
|
|
|
|
|
|
|
externalSHA :: String -> Int -> FilePath -> IO (Either String String)
|
|
|
|
externalSHA command shasize file = do
|
2014-07-14 02:27:37 +00:00
|
|
|
ls <- lines <$> catchDefaultIO "" (readsha (toCommand [File file]))
|
2013-05-08 15:17:09 +00:00
|
|
|
return $ sanitycheck =<< parse ls
|
|
|
|
where
|
|
|
|
{- sha commands output the filename, so need to set fileEncoding -}
|
|
|
|
readsha args =
|
|
|
|
withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $ \h -> do
|
|
|
|
fileEncoding h
|
|
|
|
output <- hGetContentsStrict h
|
|
|
|
hClose h
|
|
|
|
return output
|
|
|
|
where
|
|
|
|
p = (proc command args) { std_out = CreatePipe }
|
|
|
|
|
|
|
|
{- The first word of the output is taken to be the sha. -}
|
|
|
|
parse [] = bad
|
|
|
|
parse (l:_)
|
|
|
|
| null sha = bad
|
|
|
|
-- sha is prefixed with \ when filename contains certian chars
|
|
|
|
| "\\" `isPrefixOf` sha = Right $ drop 1 sha
|
|
|
|
| otherwise = Right sha
|
|
|
|
where
|
|
|
|
sha = fst $ separate (== ' ') l
|
|
|
|
bad = Left $ command ++ " parse error"
|
|
|
|
|
|
|
|
{- Check that we've correctly parsing the output of the command,
|
|
|
|
- by making sure the sha we read is of the expected length
|
|
|
|
- and contains only the right characters. -}
|
|
|
|
sanitycheck sha
|
|
|
|
| length sha /= expectedSHALength shasize =
|
|
|
|
Left $ "Failed to parse the output of " ++ command
|
|
|
|
| any (`notElem` "0123456789abcdef") sha' =
|
|
|
|
Left $ "Unexpected character in output of " ++ command ++ "\"" ++ sha ++ "\""
|
|
|
|
| otherwise = Right sha'
|
|
|
|
where
|
|
|
|
sha' = map toLower sha
|
|
|
|
|
|
|
|
expectedSHALength :: Int -> Int
|
|
|
|
expectedSHALength 1 = 40
|
|
|
|
expectedSHALength 256 = 64
|
|
|
|
expectedSHALength 512 = 128
|
|
|
|
expectedSHALength 224 = 56
|
|
|
|
expectedSHALength 384 = 96
|
|
|
|
expectedSHALength _ = 0
|