blob: 0defbaa16f89faefdc4557a6afe216ecffbbfd60 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{- Calculating a SHA checksum with an external command.
-
- This is typically a bit faster than using Haskell libraries,
- by around 1% to 10%. Worth it for really big files.
-
- Copyright 2011-2013 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.ExternalSHA (externalSHA) where
import Utility.SafeCommand
import Utility.Process
import Utility.FileSystemEncoding
import Utility.Misc
import Utility.Exception
import Data.List
import Data.Char
import System.IO
import Control.Applicative
import Prelude
externalSHA :: String -> Int -> FilePath -> IO (Either String String)
externalSHA command shasize file = do
ls <- lines <$> catchDefaultIO "" (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
|
