recognise differently-named shaN programs

This commit is contained in:
Fraser Tweedale 2011-04-08 10:08:11 +10:00
parent bd1bbc21fa
commit f5b2d650bb
3 changed files with 28 additions and 13 deletions

View file

@ -35,7 +35,7 @@ backends = catMaybes $ map genBackend [1, 256, 512, 224, 384]
genBackend :: SHASize -> Maybe (Backend Annex) genBackend :: SHASize -> Maybe (Backend Annex)
genBackend size genBackend size
| supported size = Just b | shaCommand size /= "" = Just b
| otherwise = Nothing | otherwise = Nothing
where where
b = Backend.File.backend b = Backend.File.backend
@ -43,12 +43,14 @@ genBackend size
, getKey = keyValue size , getKey = keyValue size
, fsckKey = Backend.File.checkKey $ checkKeyChecksum size , fsckKey = Backend.File.checkKey $ checkKeyChecksum size
} }
supported 1 = SysConfig.sha1sum
supported 256 = SysConfig.sha256sum shaCommand :: SHASize -> String
supported 224 = SysConfig.sha224sum shaCommand 1 = SysConfig.sha1
supported 384 = SysConfig.sha384sum shaCommand 256 = SysConfig.sha256
supported 512 = SysConfig.sha512sum shaCommand 224 = SysConfig.sha224
supported _ = False shaCommand 384 = SysConfig.sha384
shaCommand 512 = SysConfig.sha512
shaCommand _ = ""
shaName :: SHASize -> String shaName :: SHASize -> String
shaName size = "SHA" ++ show size shaName size = "SHA" ++ show size
@ -63,7 +65,7 @@ shaN size file = do
then error $ command ++ " parse error" then error $ command ++ " parse error"
else return $ head bits else return $ head bits
where where
command = "sha" ++ (show size) ++ "sum" command = shaCommand size
{- A key is a checksum of its contents. -} {- A key is a checksum of its contents. -}
keyValue :: SHASize -> FilePath -> Annex (Maybe Key) keyValue :: SHASize -> FilePath -> Annex (Maybe Key)

View file

@ -72,13 +72,25 @@ selectCmd k cmds = search cmds
where where
search [] = do search [] = do
testEnd $ Config k (BoolConfig False) testEnd $ Config k (BoolConfig False)
error $ "* need one of these commands, but none are available: " ++ show cmds error $ "* need one of these commands, but none are available: " ++ show (map (head . words) cmds)
search (c:cs) = do search (c:cs) = do
ret <- system $ quiet c ret <- system $ quiet c
if (ret == ExitSuccess) if (ret == ExitSuccess)
then return $ Config k (StringConfig c) then return $ Config k (StringConfig c)
else search cs else search cs
whichCmd :: ConfigKey -> [String] -> Test
whichCmd k cmds = search cmds
where
search [] = do
testEnd $ Config k (StringConfig "")
return $ Config k (StringConfig "")
search (c:cs) = do
ret <- system $ quiet c
if (ret == ExitSuccess)
then return $ Config k (StringConfig $ head $ words c)
else search cs
quiet :: String -> String quiet :: String -> String
quiet s = s ++ " >/dev/null 2>&1" quiet s = s ++ " >/dev/null 2>&1"

View file

@ -20,10 +20,11 @@ tests = [
shaTestCases :: [Int] -> [TestCase] shaTestCases :: [Int] -> [TestCase]
shaTestCases l = map make l shaTestCases l = map make l
where where make n =
make n = let
let cmd = "sha" ++ show n ++ "sum" cmds = map (\x -> "sha" ++ show n ++ x ++ " </dev/null") ["", "sum"]
in TestCase cmd $ requireCmd cmd (cmd ++ " </dev/null") key = "sha" ++ show n
in TestCase key $ whichCmd key cmds
tmpDir :: String tmpDir :: String
tmpDir = "tmp" tmpDir = "tmp"