diff options
-rw-r--r-- | Annex.hs | 3 | ||||
-rw-r--r-- | Backend/File.hs | 5 | ||||
-rw-r--r-- | Commands.hs | 54 | ||||
-rw-r--r-- | Core.hs | 23 | ||||
-rw-r--r-- | GitQueue.hs | 5 | ||||
-rw-r--r-- | GitRepo.hs | 173 | ||||
-rw-r--r-- | LocationLog.hs | 2 | ||||
-rw-r--r-- | Remotes.hs | 29 | ||||
-rw-r--r-- | UUID.hs | 14 | ||||
-rw-r--r-- | Utility.hs | 34 | ||||
-rw-r--r-- | debian/changelog | 8 | ||||
-rw-r--r-- | doc/bugs/scp_interrupt_to_background.mdwn | 2 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 4 | ||||
-rw-r--r-- | git-annex.hs | 11 |
14 files changed, 184 insertions, 183 deletions
@@ -61,7 +61,6 @@ gitRepoChange :: Git.Repo -> Annex () gitRepoChange r = do state <- get put state { Internals.repo = r } - return () {- Returns the backends being used. -} backends :: Annex [Backend] @@ -74,7 +73,6 @@ backendsChange :: [Backend] -> Annex () backendsChange b = do state <- get put state { Internals.backends = b } - return () {- Returns the full list of supported backends. -} supportedBackends :: Annex [Backend] @@ -95,7 +93,6 @@ flagChange :: FlagName -> Flag -> Annex () flagChange name val = do state <- get put state { Internals.flags = M.insert name val $ Internals.flags state } - return () {- Gets the value of a String flag (or "" if there is no such String flag) -} flagGet :: FlagName -> Annex String diff --git a/Backend/File.hs b/Backend/File.hs index 4b9a3b45b..b45354752 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -129,7 +129,7 @@ checkRemoveKey key = do "Could only verify the existence of " ++ (show have) ++ " out of " ++ (show need) ++ " necessary copies" - if (not $ null bad) then showTriedRemotes bad else return () + showTriedRemotes bad showLocations key hint return False @@ -146,7 +146,8 @@ showLocations key = do if (null uuidsf) then showLongNote $ "No other repository is known to contain the file." else showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids - + +showTriedRemotes [] = return () showTriedRemotes remotes = showLongNote $ "I was unable to access these remotes: " ++ (Remotes.list remotes) diff --git a/Commands.hs b/Commands.hs index 6974b697c..41e9ad54d 100644 --- a/Commands.hs +++ b/Commands.hs @@ -14,6 +14,7 @@ import System.Directory import System.Path import Data.String.Utils import Control.Monad (filterM) +import Monad (when, unless) import List import IO @@ -115,6 +116,8 @@ options = [ "allow actions that may lose annexed data" , Option ['q'] ["quiet"] (NoArg (storebool "quiet" True)) "avoid verbose output" + , Option ['v'] ["verbose"] (NoArg (storebool "quiet" False)) + "allow verbose output" , Option ['b'] ["backend"] (ReqArg (storestring "backend") "NAME") "specify default key-value backend to use" , Option ['k'] ["key"] (ReqArg (storestring "key") "KEY") @@ -165,7 +168,7 @@ findWanted FilesMissing params repo = do where missing f = do e <- doesFileExist f - if (e) then return False else return True + return $ not e findWanted Description params _ = do return $ [unwords params] findWanted FilesToBeCommitted params repo = do @@ -188,19 +191,18 @@ findWanted _ params _ = return params parseCmd :: [String] -> AnnexState -> IO ([Annex Bool], [Annex Bool]) parseCmd argv state = do (flags, params) <- getopt - if (null params) - then error usage - else case (lookupCmd (params !! 0)) of - [] -> error usage - [Command name action want _] -> do - f <- findWanted want (drop 1 params) - (TypeInternals.repo state) - let actions = map (doSubCmd name action) $ - filter notstate f - let configactions = map (\f -> do - f - return True) flags - return (configactions, actions) + when (null params) $ error usage + case lookupCmd (params !! 0) of + [] -> error usage + [Command name action want _] -> do + f <- findWanted want (drop 1 params) + (TypeInternals.repo state) + let actions = map (doSubCmd name action) $ + filter notstate f + let configactions = map (\f -> do + f + return True) flags + return (configactions, actions) where -- never include files from the state directory notstate f = stateLoc /= take (length stateLoc) f @@ -270,7 +272,7 @@ getPerform :: FilePath -> Key -> Backend -> Annex (Maybe SubCmdCleanup) getPerform file key backend = do ok <- getViaTmp key (Backend.retrieveKeyFile backend key) if (ok) - then return $ Just $ return True + then return $ Just $ return True -- no cleanup needed else return Nothing {- Indicates a file's content is not wanted anymore, and should be removed @@ -326,9 +328,7 @@ dropKeyCleanup key = do setKeyStart :: FilePath -> Annex (Maybe SubCmdPerform) setKeyStart tmpfile = do keyname <- Annex.flagGet "key" - if (null keyname) - then error "please specify the key with --key" - else return () + when (null keyname) $ error "please specify the key with --key" backends <- Backend.list let key = genKey (backends !! 0) keyname return $ Just $ setKeyPerform tmpfile key @@ -367,11 +367,9 @@ fixCleanup file = do {- Stores description for the repository etc. -} initStart :: String -> Annex (Maybe SubCmdPerform) initStart description = do - if (null description) - then error $ - "please specify a description of this repository\n" ++ - usage - else return $ Just $ initPerform description + when (null description) $ error $ + "please specify a description of this repository\n" ++ usage + return $ Just $ initPerform description initPerform :: String -> Annex (Maybe SubCmdCleanup) initPerform description = do g <- Annex.gitRepo @@ -392,16 +390,14 @@ initCleanup = do fromKeyStart :: FilePath -> Annex (Maybe SubCmdPerform) fromKeyStart file = do keyname <- Annex.flagGet "key" - if (null keyname) - then error "please specify the key with --key" - else return () + when (null keyname) $ error "please specify the key with --key" backends <- Backend.list let key = genKey (backends !! 0) keyname inbackend <- Backend.hasKey key - if (not inbackend) - then error $ "key ("++keyname++") is not present in backend" - else return $ Just $ fromKeyPerform file key + unless (inbackend) $ error $ + "key ("++keyname++") is not present in backend" + return $ Just $ fromKeyPerform file key fromKeyPerform :: FilePath -> Key -> Annex (Maybe SubCmdCleanup) fromKeyPerform file key = do link <- calcGitLink file key @@ -13,6 +13,7 @@ import System.Directory import Control.Monad.State (liftIO) import System.Path import Data.String.Utils +import Monad (when, unless) import Types import Locations @@ -37,19 +38,15 @@ shutdown = do -- Runs all queued git commands. q <- Annex.queueGet - if (q == GitQueue.empty) - then return () - else do - verbose $ liftIO $ putStrLn "Recording state in git..." - liftIO $ GitQueue.run g q + unless (q == GitQueue.empty) $ do + verbose $ liftIO $ putStrLn "Recording state in git..." + liftIO $ GitQueue.run g q -- clean up any files left in the temp directory, but leave -- the tmp directory itself let tmp = annexTmpLocation g exists <- liftIO $ doesDirectoryExist tmp - if (exists) - then liftIO $ removeDirectoryRecursive $ tmp - else return () + when (exists) $ liftIO $ removeDirectoryRecursive $ tmp liftIO $ createDirectoryIfMissing True tmp return True @@ -65,11 +62,9 @@ gitAttributes repo = do commit else do content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - commit - else return () + when (all (/= attrLine) (lines content)) $ do + appendFile attributes $ attrLine ++ "\n" + commit where attrLine = stateLoc ++ "*.log merge=union" attributes = Git.attributes repo @@ -150,7 +145,7 @@ getViaTmp key action = do verbose :: Annex () -> Annex () verbose a = do q <- Annex.flagIsSet "quiet" - if (q) then return () else a + unless q a showStart :: String -> String -> Annex () showStart command file = verbose $ do liftIO $ putStr $ command ++ " " ++ file ++ " " diff --git a/GitQueue.hs b/GitQueue.hs index 6a68edb25..09b8037e6 100644 --- a/GitQueue.hs +++ b/GitQueue.hs @@ -16,6 +16,7 @@ import qualified Data.Map as M import System.IO import System.Cmd.Utils import Data.String.Utils +import Monad (unless) import qualified GitRepo as Git @@ -52,9 +53,7 @@ run repo queue = do - Complicated by commandline length limits. -} runAction :: Git.Repo -> Action -> [FilePath] -> IO () runAction repo action files = do - if (null files) - then return () - else runxargs + unless (null files) runxargs where runxargs = pOpen WriteToPipe "xargs" (["-0", "git", subcommand action] ++ (params action)) diff --git a/GitRepo.hs b/GitRepo.hs index 229b76847..fd69ec21a 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -24,6 +24,7 @@ module GitRepo ( configGet, configMap, configRead, + configTrue, run, pipeRead, attributes, @@ -47,52 +48,46 @@ import Data.String.Utils import Data.Map as Map hiding (map, split) import Network.URI import Maybe +import Char import Utility {- There are two types of repositories; those on local disk and those - accessed via an URL. -} -data Repo = - Repo { - top :: FilePath, - config :: Map String String, - remotes :: [Repo], - -- remoteName holds the name used for this repo in remotes - remoteName :: Maybe String - } | UrlRepo { - url :: URI, - config :: Map String String, - remotes :: [Repo], - remoteName :: Maybe String - } deriving (Show, Eq) +data RepoLocation = Dir FilePath | Url URI + deriving (Show, Eq) -{- Local Repo constructor. -} -repoFromPath :: FilePath -> Repo -repoFromPath dir = +data Repo = Repo { + location :: RepoLocation, + config :: Map String String, + remotes :: [Repo], + -- remoteName holds the name used for this repo in remotes + remoteName :: Maybe String +} deriving (Show, Eq) + +newFrom l = Repo { - top = dir, + location = l, config = Map.empty, remotes = [], remoteName = Nothing } +{- Local Repo constructor. -} +repoFromPath :: FilePath -> Repo +repoFromPath dir = newFrom $ Dir dir + {- Remote Repo constructor. Throws exception on invalid url. -} repoFromUrl :: String -> Repo -repoFromUrl url = - UrlRepo { - url = fromJust $ parseURI url, - config = Map.empty, - remotes = [], - remoteName = Nothing - } +repoFromUrl url + | startswith "file://" url = repoFromPath $ uriPath u + | otherwise = newFrom $ Url u + where u = fromJust $ parseURI url {- User-visible description of a git repo. -} -repoDescribe repo = - if (isJust $ remoteName repo) - then fromJust $ remoteName repo - else if (not $ repoIsUrl repo) - then top repo - else show (url repo) +repoDescribe Repo { remoteName = Just name } = name +repoDescribe Repo { location = Url url } = show url +repoDescribe Repo { location = Dir dir } = dir {- Constructs and returns an updated version of a repo with - different remotes list. -} @@ -101,17 +96,19 @@ remotesAdd repo rs = repo { remotes = rs } {- Returns the name of the remote that corresponds to the repo, if - it is a remote. Otherwise, "" -} -repoRemoteName r = - if (isJust $ remoteName r) - then fromJust $ remoteName r - else "" +repoRemoteName Repo { remoteName = Just name } = name +repoRemoteName _ = "" {- Some code needs to vary between URL and normal repos, - or bare and non-bare, these functions help with that. -} -repoIsUrl repo = case (repo) of - UrlRepo {} -> True - Repo {} -> False -repoIsSsh repo = repoIsUrl repo && (uriScheme $ url repo) == "ssh:" +repoIsUrl Repo { location = Url _ } = True +repoIsUrl _ = False + +repoIsSsh Repo { location = Url url } + | uriScheme url == "ssh:" = True + | otherwise = False +repoIsSsh _ = False + assertLocal repo action = if (not $ repoIsUrl repo) then action @@ -122,77 +119,74 @@ assertUrl repo action = then action else error $ "acting on local git repo " ++ (repoDescribe repo) ++ " not supported" -assertssh repo action = +assertSsh repo action = if (repoIsSsh repo) then action - else error $ "unsupported url " ++ (show $ url repo) + else error $ "unsupported url in repo " ++ (repoDescribe repo) bare :: Repo -> Bool -bare repo = - if (member b (config repo)) - then ("true" == fromJust (Map.lookup b (config repo))) - else error $ "it is not known if git repo " ++ (repoDescribe repo) ++ +bare repo = case Map.lookup "core.bare" $ config repo of + Just v -> configTrue v + Nothing -> error $ "it is not known if git repo " ++ + (repoDescribe repo) ++ " is a bare repository; config not read" - where - b = "core.bare" {- Path to a repository's gitattributes file. -} attributes :: Repo -> String -attributes repo = assertLocal repo $ do - if (bare repo) - then (top repo) ++ "/info/.gitattributes" - else (top repo) ++ "/.gitattributes" +attributes repo + | bare repo = (workTree repo) ++ "/info/.gitattributes" + | otherwise = (workTree repo) ++ "/.gitattributes" {- Path to a repository's .git directory, relative to its workTree. -} dir :: Repo -> String -dir repo = if (bare repo) then "" else ".git" +dir repo + | bare repo = "" + | otherwise = ".git" {- Path to a repository's --work-tree, that is, its top. - - - Note that for URL repositories, this is relative to the urlHost -} + - Note that for URL repositories, this is the path on the remote host. -} workTree :: Repo -> FilePath -workTree repo = - if (not $ repoIsUrl repo) - then top repo - else urlPath repo +workTree r@(Repo { location = Url _ }) = urlPath r +workTree (Repo { location = Dir d }) = d {- Given a relative or absolute filename in a repository, calculates the - name to use to refer to the file relative to a git repository's top. - This is the same form displayed and used by git. -} relative :: Repo -> String -> String -relative repo file = assertLocal repo $ drop (length absrepo) absfile +relative repo@(Repo { location = Dir d }) file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo -- will be substring of file - absrepo = case (absNormPath "/" (top repo)) of + absrepo = case (absNormPath "/" d) of Just f -> f ++ "/" - Nothing -> error $ "bad repo" ++ (top repo) + Nothing -> error $ "bad repo" ++ (repoDescribe repo) absfile = case (secureAbsNormPath absrepo file) of Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo +relative repo file = assertLocal repo $ error "internal" {- Hostname of an URL repo. (May include a username and/or port too.) -} urlHost :: Repo -> String -urlHost repo = assertUrl repo $ - (uriUserInfo a) ++ (uriRegName a) ++ (uriPort a) - where - a = fromJust $ uriAuthority $ url repo +urlHost Repo { location = Url u } = uriUserInfo a ++ uriRegName a ++ uriPort a + where a = fromJust $ uriAuthority $ u +urlHost repo = assertUrl repo $ error "internal" {- Path of an URL repo. -} urlPath :: Repo -> String -urlPath repo = assertUrl repo $ - uriPath $ url repo +urlPath Repo { location = Url u } = uriPath u +urlPath repo = assertUrl repo $ error "internal" {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: Repo -> [String] -> [String] -gitCommandLine repo params = assertLocal repo $ +gitCommandLine repo@(Repo { location = Dir d} ) params = -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(top repo)++"/"++(dir repo), "--work-tree="++(top repo)] ++ params + ["--git-dir="++d++"/"++(dir repo), "--work-tree="++d] ++ params +gitCommandLine repo _ = assertLocal repo $ error "internal" {- Runs git in the specified repo. -} run :: Repo -> [String] -> IO () run repo params = assertLocal repo $ do - r <- safeSystem "git" (gitCommandLine repo params) - return () + safeSystem "git" (gitCommandLine repo params) {- Runs a git subcommand and returns its output. -} pipeRead :: Repo -> [String] -> IO String @@ -217,23 +211,27 @@ notInRepo repo location = do {- Runs git config and populates a repo with its config. -} configRead :: Repo -> IO Repo -configRead repo = - if (not $ repoIsUrl repo) - then do - {- Cannot use pipeRead because it relies on the config having - been already read. Instead, chdir to the repo. -} - cwd <- getCurrentDirectory - bracket_ (changeWorkingDirectory (top repo)) - (\_ -> changeWorkingDirectory cwd) $ - pOpen ReadFromPipe "git" ["config", "--list"] proc - else assertssh repo $ do - pOpen ReadFromPipe "ssh" [urlHost repo, sshcommand] proc +configRead repo@(Repo { location = Dir d }) = do + {- Cannot use pipeRead because it relies on the config having + been already read. Instead, chdir to the repo. -} + cwd <- getCurrentDirectory + bracket_ (changeWorkingDirectory d) + (\_ -> changeWorkingDirectory cwd) $ + pOpen ReadFromPipe "git" ["config", "--list"] $ + hConfigRead repo +configRead repo = assertSsh repo $ do + pOpen ReadFromPipe "ssh" [urlHost repo, sshcommand] $ hConfigRead repo where - sshcommand = "cd " ++ (shellEscape $ urlPath repo) ++ " && git config --list" - proc h = do - val <- hGetContentsStrict h - let r = repo { config = configParse val } - return r { remotes = configRemotes r } + sshcommand = "cd " ++ (shellEscape $ urlPath repo) ++ + " && git config --list" +hConfigRead repo h = do + val <- hGetContentsStrict h + let r = repo { config = configParse val } + return r { remotes = configRemotes r } + +{- Checks if a string fron git config is a true value. -} +configTrue :: String -> Bool +configTrue s = map toLower s == "true" {- Calculates a list of a repo's configured remotes, by parsing its config. -} configRemotes :: Repo -> [Repo] @@ -244,9 +242,8 @@ configRemotes repo = map construct remotes isremote k = (startswith "remote." k) && (endswith ".url" k) remotename k = (split "." k) !! 1 construct (k,v) = (gen v) { remoteName = Just $ remotename k } - gen v = if (isURI v) - then repoFromUrl v - else repoFromPath v + gen v | isURI v = repoFromUrl v + | otherwise = repoFromPath v {- Parses git config --list output into a config map. -} configParse :: String -> Map.Map String String diff --git a/LocationLog.hs b/LocationLog.hs index 10a637708..f92dee652 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -163,6 +163,6 @@ mapLog map log = then Map.insert (uuid log) log map else map where - better = case (Map.lookup (uuid log) map) of + better = case Map.lookup (uuid log) map of Just l -> (date l <= date log) Nothing -> True diff --git a/Remotes.hs b/Remotes.hs index 665de38ae..a432e1b5d 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -28,6 +28,7 @@ import System.Directory import System.Posix.Directory import List import Maybe +import Monad (when, unless) import Types import qualified GitRepo as Git @@ -65,9 +66,9 @@ keyPossibilities key = do let cheap = filter (not . Git.repoIsUrl) allremotes let expensive = filter Git.repoIsUrl allremotes doexpensive <- filterM cachedUUID expensive - if (not $ null doexpensive) - then Core.showNote $ "getting UUID for " ++ (list doexpensive) ++ "..." - else return () + unless (null doexpensive) $ do + Core.showNote $ "getting UUID for " ++ + (list doexpensive) ++ "..." let todo = cheap ++ doexpensive if (not $ null todo) then do @@ -139,10 +140,10 @@ repoNotIgnored r = do let name = if (not $ null fromName) then fromName else toName if (not $ null name) then return $ match name - else return $ notignored g + else return $ not $ ignored g where match name = name == Git.repoRemoteName r - notignored g = "true" /= config g + ignored g = Git.configTrue $ config g config g = Git.configGet g configkey "" configkey = "remote." ++ (Git.repoRemoteName r) ++ ".annex-ignore" @@ -152,15 +153,13 @@ commandLineRemote = do fromName <- Annex.flagGet "fromrepository" toName <- Annex.flagGet "torepository" let name = if (not $ null fromName) then fromName else toName - if (null name) - then error "no remote specified" - else do - g <- Annex.gitRepo - let match = filter (\r -> name == Git.repoRemoteName r) $ - Git.remotes g - if (null match) - then error $ "there is no git remote named \"" ++ name ++ "\"" - else return $ match !! 0 + when (null name) $ error "no remote specified" + g <- Annex.gitRepo + let match = filter (\r -> name == Git.repoRemoteName r) $ + Git.remotes g + when (null match) $ error $ + "there is no git remote named \"" ++ name ++ "\"" + return $ match !! 0 {- The git configs for the git repo's remotes is not read on startup - because reading it may be expensive. This function tries to read the @@ -186,7 +185,7 @@ tryGitConfigRead r = do where exchange [] new = [] exchange (old:ls) new = - if ((Git.repoRemoteName old) == (Git.repoRemoteName new)) + if (Git.repoRemoteName old == Git.repoRemoteName new) then new:(exchange ls new) else old:(exchange ls new) @@ -63,10 +63,7 @@ getUUID r = do where uncached r = Git.configGet r "annex.uuid" "" cached r g = Git.configGet g (cachekey r) "" - updatecache g r u = do - if (g /= r) - then setConfig (cachekey r) u - else return () + updatecache g r u = when (g /= r) $ setConfig (cachekey r) u cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" {- Make sure that the repo has an annex.uuid setting. -} @@ -74,11 +71,9 @@ prepUUID :: Annex () prepUUID = do g <- Annex.gitRepo u <- getUUID g - if ("" == u) - then do - uuid <- liftIO $ genUUID - setConfig configkey uuid - else return () + when ("" == u) $ do + uuid <- liftIO $ genUUID + setConfig configkey uuid {- Changes a git config setting in both internal state and .git/config -} setConfig :: String -> String -> Annex () @@ -88,7 +83,6 @@ setConfig key value = do -- re-read git config and update the repo's state g' <- liftIO $ Git.configRead g Annex.gitRepoChange g' - return () {- Filters a list of repos to ones that have listed UUIDs. -} reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo] diff --git a/Utility.hs b/Utility.hs index ab90c5160..233825b65 100644 --- a/Utility.hs +++ b/Utility.hs @@ -16,10 +16,11 @@ module Utility ( ) where import System.IO -import System.Cmd +import System.Cmd.Utils import System.Exit +import System.Posix.Process +import System.Posix.Process.Internals import System.Posix.Signals -import Data.Typeable import System.Posix.IO import Data.String.Utils import System.Path @@ -102,17 +103,30 @@ relPathDirToDir from to = {- Run a system command, and returns True or False - if it succeeded or failed. - - - An error is thrown if the command exits due to SIGINT, - - to propigate ctrl-c. + - SIGINT(ctrl-c) is allowed to propigate and will terminate the program. -} boolSystem :: FilePath -> [String] -> IO Bool boolSystem command params = do - r <- rawSystem command params - case r of - ExitSuccess -> return True - ExitFailure e -> if Just e == cast sigINT - then error $ command ++ "interrupted" - else return False + -- Going low-level because all the high-level system functions + -- block SIGINT etc. We need to block SIGCHLD, but allow + -- SIGINT to do its default program termination. + let sigset = addSignal sigCHLD emptySignalSet + oldint <- installHandler sigINT Default Nothing + oldset <- getSignalMask + blockSignals sigset + childpid <- forkProcess $ childaction oldint oldset + mps <- getProcessStatus True False childpid + restoresignals oldint oldset + case mps of + Just (Exited ExitSuccess) -> return True + _ -> return False + where + restoresignals oldint oldset = do + installHandler sigINT oldint Nothing + setSignalMask oldset + childaction oldint oldset = do + restoresignals oldint oldset + executeFile command True params Nothing {- Escapes a filename to be safely able to be exposed to the shell. -} shellEscape f = "'" ++ quote ++ "'" diff --git a/debian/changelog b/debian/changelog index 72ae91c02..77e01482f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +git-annex (0.03) UNRELEASED; urgency=low + + * Fix support for file:// remotes. + * Add --verbose + * Fix SIGINT handling. + + -- Joey Hess <joeyh@debian.org> Thu, 28 Oct 2010 13:46:59 -0400 + git-annex (0.02) unstable; urgency=low * Can scp annexed files from remote hosts, and check remote hosts for diff --git a/doc/bugs/scp_interrupt_to_background.mdwn b/doc/bugs/scp_interrupt_to_background.mdwn index 700c81c65..381f5cd73 100644 --- a/doc/bugs/scp_interrupt_to_background.mdwn +++ b/doc/bugs/scp_interrupt_to_background.mdwn @@ -1,2 +1,2 @@ When getting a file with scp, SIGINT is blocked, exposing the git -subcommand fork to background bug again. +subcommand fork to background bug again. [[done]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 3c48e9dc3..47fbb3760 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -153,6 +153,10 @@ Many git-annex subcommands will stage changes for later `git commit` by you. Avoid the default verbose logging of what is done; only show errors and progress displays. +* --verbose + + Enable verbose logging. + * --backend=name Specify the default key-value backend to use, adding it to the front diff --git a/git-annex.hs b/git-annex.hs index e9e7ff027..5011fade2 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -8,6 +8,7 @@ import IO (try) import System.IO import System.Environment +import Monad import qualified Annex import Types @@ -42,12 +43,8 @@ tryRun' state errnum (a:as) = do tryRun' state (errnum + 1) as Right (True,state') -> tryRun' state' errnum as Right (False,state') -> tryRun' state' (errnum + 1) as -tryRun' state errnum [] = do - if (errnum > 0) - then error $ (show errnum) ++ " failed" - else return () +tryRun' state errnum [] = + when (errnum > 0) $ error $ (show errnum) ++ " failed" {- Exception pretty-printing. -} -showErr e = do - hPutStrLn stderr $ "git-annex: " ++ (show e) - return () +showErr e = hPutStrLn stderr $ "git-annex: " ++ (show e) |