summaryrefslogtreecommitdiff
path: root/Utility/ExternalSHA.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-05-08 11:17:09 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-05-08 11:17:09 -0400
commitff6b397dab5cac810061c386c28fa87e7b2b420b (patch)
treec7ac7985c9a505995a799620fd757c4b32942c24 /Utility/ExternalSHA.hs
parent2578c950fc47d3edfd30375d91e0d415c4f32be0 (diff)
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.
Diffstat (limited to 'Utility/ExternalSHA.hs')
-rw-r--r--Utility/ExternalSHA.hs67
1 files changed, 67 insertions, 0 deletions
diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs
new file mode 100644
index 000000000..21241d302
--- /dev/null
+++ b/Utility/ExternalSHA.hs
@@ -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