summaryrefslogtreecommitdiff
path: root/Backend
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 /Backend
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 'Backend')
-rw-r--r--Backend/SHA.hs50
1 files changed, 6 insertions, 44 deletions
diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index 258caafd1..a735ce1e5 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -12,11 +12,11 @@ import qualified Annex
import Types.Backend
import Types.Key
import Types.KeySource
+import Utility.ExternalSHA
import qualified Build.SysConfig as SysConfig
import Data.Digest.Pure.SHA
import qualified Data.ByteString.Lazy as L
-import System.Process
import Data.Char
type SHASize = Int
@@ -55,49 +55,11 @@ shaNameE size = shaName size ++ "E"
shaN :: SHASize -> FilePath -> Integer -> Annex String
shaN shasize file filesize = do
showAction "checksum"
- case shaCommand shasize filesize of
- Left sha -> liftIO $ sha <$> L.readFile file
- Right command -> liftIO $
- sanitycheck command . parse command . lines <$>
- readsha command (toCommand [File file])
- where
- parse command [] = bad command
- parse command (l:_)
- | null sha = bad command
- -- sha is prefixed with \ when filename contains certian chars
- | "\\" `isPrefixOf` sha = drop 1 sha
- | otherwise = sha
- where
- sha = fst $ separate (== ' ') l
- bad command = error $ command ++ " parse error"
-
- {- sha commands output the filename, so need to set fileEncoding -}
- readsha command args =
- withHandle StdoutHandle createProcessSuccess p $ \h -> do
- fileEncoding h
- output <- hGetContentsStrict h
- hClose h
- return output
- where
- p = (proc command args) { std_out = CreatePipe }
-
- {- Check that we've correctly parsing the output of the command,
- - by making sure the sha we read is of the expected length. -}
- sanitycheck command sha
- | length sha /= expectedlen =
- error $ "Failed to parse the output of " ++ command
- | any (`notElem` "0123456789abcdef") sha' =
- error $ "Unexpected character in output of " ++ command ++ "\"" ++ sha ++ "\""
- | otherwise = sha'
- where
- sha' = map toLower sha
- expectedlen = case shasize of
- 1 -> 40
- 256 -> 64
- 512 -> 128
- 224 -> 56
- 384 -> 96
- _ -> 0
+ liftIO $ case shaCommand shasize filesize of
+ Left sha -> sha <$> L.readFile file
+ Right command ->
+ either error return
+ =<< externalSHA command shasize file
shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String
shaCommand shasize filesize