diff options
author | Joey Hess <joey@kitenet.net> | 2011-01-19 18:08:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-01-19 18:08:50 -0400 |
commit | dbb76c22d0f4f979fe90eeeff233dbbbfcf2346d (patch) | |
tree | 9b0f1bbb4bb4893bd06cde9c01f21dedfc44fa8e | |
parent | 27325f212bfdf915d16eadfa9fc51b416d4177c0 (diff) |
Support using the uuidgen command if the uuid command is not available.
-rw-r--r-- | UUID.hs | 10 | ||||
-rw-r--r-- | configure.hs | 94 | ||||
-rw-r--r-- | debian/changelog | 6 | ||||
-rw-r--r-- | doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn | 7 | ||||
-rw-r--r-- | doc/install.mdwn | 1 |
5 files changed, 81 insertions, 37 deletions
@@ -33,6 +33,7 @@ import Types import Locations import qualified Annex import Utility +import qualified SysConfig type UUID = String @@ -42,7 +43,14 @@ configkey="annex.uuid" {- Generates a UUID. There is a library for this, but it's not packaged, - so use the command line tool. -} genUUID :: IO UUID -genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h +genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h + where + command = SysConfig.uuid + params = if (command == "uuid") + -- request a random uuid be generated + then ["-m"] + -- uuidgen generates random uuid by default + else [] {- Looks up a repo's UUID. May return "" if none is known. - diff --git a/configure.hs b/configure.hs index 1abdc8914..9f50328d3 100644 --- a/configure.hs +++ b/configure.hs @@ -5,24 +5,33 @@ import System.Cmd import System.Exit import System.Directory -type Test = IO Bool -data TestCase = TestCase String String Test -data Config = Config String Bool +type ConfigKey = String +data ConfigValue = BoolConfig Bool | StringConfig String +data Config = Config ConfigKey ConfigValue + +type Test = IO Config +type TestName = String +data TestCase = TestCase TestName Test instance Show Config where show (Config key value) = unlines [ - key ++ " :: Bool" - , key ++ " = " ++ show value + key ++ " :: " ++ valuetype value + , key ++ " = " ++ showvalue value ] + where + valuetype (BoolConfig _) = "Bool" + valuetype (StringConfig _) = "String" + showvalue (BoolConfig b) = show b + showvalue (StringConfig s) = show s tests :: [TestCase] tests = [ - TestCase "cp -a" "cp_a" $ testCp "-a" - , TestCase "cp -p" "cp_p" $ testCp "-p" - , TestCase "cp --reflink=auto" "cp_reflink_auto" $ testCp "--reflink=auto" - , TestCase "uuid" "uuid" $ requireCmd "uuid" "uuid" - , TestCase "xargs -0" "xargs_0" $ requireCmd "xargs -0" "xargs -0 </dev/null" - , TestCase "rsync" "rsync" $ requireCmd "rsync" "rsync --version >/dev/null" + TestCase "cp -a" $ testCp "cp_a" "-a" + , TestCase "cp -p" $ testCp "cp_p" "-p" + , TestCase "cp --reflink=auto" $ testCp "cp_reflink_auto" "--reflink=auto" + , TestCase "uuid" $ selectCmd "uuid" ["uuid", "uuidgen"] + , TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0" "xargs -0 </dev/null" + , TestCase "rsync" $ requireCmd "rsync" "rsync" "rsync --version >/dev/null" ] tmpDir :: String @@ -31,34 +40,49 @@ tmpDir = "tmp" testFile :: String testFile = tmpDir ++ "/testfile" -quiet :: String -> String -quiet s = s ++ " >/dev/null 2>&1" - -requireCmd :: String -> String -> Test -requireCmd c cmdline = do - ret <- testCmd $ quiet cmdline - if ret - then return True - else do - testEnd False +requireCmd :: ConfigKey -> String -> String -> Test +requireCmd k c cmdline = do + ret <- testCmd k cmdline + handle ret + where + handle r@(Config _ (BoolConfig True)) = return r + handle r = do + testEnd r error $ "** the " ++ c ++ " command is required to use git-annex" -testCp :: String -> Test -testCp option = testCmd $ quiet $ "cp " ++ option ++ " " ++ testFile ++ - " " ++ testFile ++ ".new" +testCp :: ConfigKey -> String -> Test +testCp k option = testCmd k $ + "cp " ++ option ++ " " ++ testFile ++ " " ++ testFile ++ ".new" -testCmd :: String -> Test -testCmd c = do - ret <- system c - return $ ret == ExitSuccess +testCmd :: ConfigKey -> String -> Test +testCmd k c = do + ret <- system $ quiet c + return $ Config k (BoolConfig $ ret == ExitSuccess) + +selectCmd :: ConfigKey -> [String] -> Test +selectCmd k cmds = search cmds + where + search [] = do + testEnd $ Config k (BoolConfig False) + error $ "* need one of these commands, but none are available: " ++ show cmds + search (c:cs) = do + ret <- system $ quiet c + if (ret == ExitSuccess) + then return $ Config k (StringConfig c) + else search cs + +quiet :: String -> String +quiet s = s ++ " >/dev/null 2>&1" -testStart :: String -> IO () +testStart :: TestName -> IO () testStart s = do putStr $ " checking " ++ s ++ "..." hFlush stdout -testEnd :: Bool -> IO () -testEnd r = putStrLn $ " " ++ show r +testEnd :: Config -> IO () +testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes" +testEnd (Config _ (BoolConfig False)) = putStrLn $ " no" +testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s writeSysConfig :: [Config] -> IO () writeSysConfig config = writeFile "SysConfig.hs" body @@ -73,12 +97,12 @@ writeSysConfig config = writeFile "SysConfig.hs" body runTests :: [TestCase] -> IO [Config] runTests [] = return [] -runTests ((TestCase tname key t):ts) = do +runTests ((TestCase tname t):ts) = do testStart tname - val <- t - testEnd val + c <- t + testEnd c rest <- runTests ts - return $ (Config key val):rest + return $ c:rest setup :: IO () setup = do diff --git a/debian/changelog b/debian/changelog index 9ca3ea82b..23358486d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +git-annex (0.19) UNRELEASED; urgency=low + + * Support using the uuidgen command if the uuid command is not available. + + -- Joey Hess <joeyh@debian.org> Wed, 19 Jan 2011 18:07:51 -0400 + git-annex (0.18) unstable; urgency=low * Bugfix: `copy --to` and `move --to` forgot to stage location log changes diff --git a/doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn b/doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn index 83d1ae664..2b9c77367 100644 --- a/doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn +++ b/doc/bugs/configure_script_should_detect_uuidgen_instead_of_just_uuid.mdwn @@ -1 +1,6 @@ -On RHEL5 (and clones) systems uuidgen is available as an alternative to uuid, the configure script fails, it should probably detect either uuid or uuidgen, or let the user decide? - also uuidgen behaves differently from uuid on debian. +On RHEL5 (and clones) systems uuidgen is available as an alternative to +uuid, the configure script fails, it should probably detect either uuid or +uuidgen, or let the user decide? - also uuidgen behaves differently from +uuid on debian. + +> uuidgen is now supported. --[[Joey]] [[done]] diff --git a/doc/install.mdwn b/doc/install.mdwn index bad1d9f25..732660c50 100644 --- a/doc/install.mdwn +++ b/doc/install.mdwn @@ -5,6 +5,7 @@ To build and use git-annex, you will need: * MissingH: <http://github.com/jgoerzen/missingh/wiki> * pcre-light: <http://hackage.haskell.org/package/pcre-light> * `uuid`: <http://www.ossp.org/pkg/lib/uuid/> + (or uuidgen from util-linux) * `xargs`: <http://savannah.gnu.org/projects/findutils/> * `rsync`: <http://rsync.samba.org/> * Then just [[download]] git-annex and run: `make; make install` |