configure: Better checking that sha commands output in the desired format.

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.
This commit is contained in:
Joey Hess 2013-05-08 11:17:09 -04:00
parent cda0ed5d25
commit d38854f3d1
4 changed files with 86 additions and 48 deletions

67
Utility/ExternalSHA.hs Normal file
View file

@ -0,0 +1,67 @@
{- 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