diff options
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/ExternalSHA.hs | 67 |
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 |