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