d38854f3d1
Run the same code git-annex used to get the sha, including its sanity checking. Much better than old grep. Should detect FreeBSD systems with sha commands that output in stange format.
67 lines
1.9 KiB
Haskell
67 lines
1.9 KiB
Haskell
{- Calculating a SHA checksum with an external command.
|
|
-
|
|
- This is often faster than using Haskell libraries.
|
|
-
|
|
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Utility.ExternalSHA (externalSHA) where
|
|
|
|
import Utility.SafeCommand
|
|
import Utility.Process
|
|
import Utility.FileSystemEncoding
|
|
import Utility.Misc
|
|
|
|
import System.Process
|
|
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
|
|
ls <- lines <$> readsha (toCommand [File file])
|
|
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
|