diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs index 2bd161351d..75df8ebf17 100644 --- a/Assistant/WebApp/Configurators/Preferences.hs +++ b/Assistant/WebApp/Configurators/Preferences.hs @@ -18,9 +18,9 @@ import qualified Git import Config import Config.Files import Utility.DataUnits +import Git.Config import qualified Data.Text as T -import System.Log.Logger data PrefsForm = PrefsForm { diskReserve :: Text @@ -68,7 +68,7 @@ getPrefs = PrefsForm <$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig) <*> (annexNumCopies <$> Annex.getGitConfig) <*> inAutoStartFile - <*> ((==) <$> (pure $ Just DEBUG) <*> (liftIO $ getLevel <$> getRootLogger)) + <*> (annexDebug <$> Annex.getGitConfig) storePrefs :: PrefsForm -> Annex () storePrefs p = do @@ -79,8 +79,10 @@ storePrefs p = do liftIO $ if autoStart p then addAutoStartFile here else removeAutoStartFile here - liftIO $ updateGlobalLogger rootLoggerName $ setLevel $ - if debugEnabled p then DEBUG else WARNING + setConfig (annexConfig "debug") (boolConfig $ debugEnabled p) + liftIO $ if debugEnabled p + then enableDebugOutput + else disableDebugOutput getPreferencesR :: Handler RepHtml getPreferencesR = postPreferencesR diff --git a/CmdLine.hs b/CmdLine.hs index 8f4c992699..d9a4103696 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -48,6 +48,8 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do checkfuzzy forM_ fields $ uncurry Annex.setField sequence_ flags + whenM (annexDebug <$> Annex.getGitConfig) $ + liftIO enableDebugOutput prepCommand cmd params tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd] where diff --git a/Messages.hs b/Messages.hs index b2fcba881b..0357da12df 100644 --- a/Messages.hs +++ b/Messages.hs @@ -31,7 +31,9 @@ module Messages ( showCustom, showHeader, showRaw, - setupConsole + setupConsole, + enableDebugOutput, + disableDebugOutput ) where import Text.JSON @@ -220,6 +222,12 @@ setupConsole = do fileEncoding stdout fileEncoding stderr +enableDebugOutput :: IO () +enableDebugOutput = updateGlobalLogger rootLoggerName $ setLevel DEBUG + +disableDebugOutput :: IO () +disableDebugOutput = updateGlobalLogger rootLoggerName $ setLevel NOTICE + handle :: IO () -> IO () -> Annex () handle json normal = withOutputType go where diff --git a/Option.hs b/Option.hs index d59af43c7a..64ba56f6d2 100644 --- a/Option.hs +++ b/Option.hs @@ -16,7 +16,6 @@ module Option ( ) where import System.Console.GetOpt -import System.Log.Logger import Common.Annex import qualified Annex @@ -40,6 +39,8 @@ common = "enable JSON output" , Option ['d'] ["debug"] (NoArg setdebug) "show debug messages" + , Option [] ["no-debug"] (NoArg unsetdebug) + "don't show debug messages" , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) "specify key-value backend to use" ] @@ -48,7 +49,8 @@ common = setfast v = Annex.changeState $ \s -> s { Annex.fast = v } setauto v = Annex.changeState $ \s -> s { Annex.auto = v } setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } - setdebug = liftIO $ updateGlobalLogger rootLoggerName $ setLevel DEBUG + setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True } + unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False } matcher :: [Option] matcher = diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 888795cbbc..d5d234ca93 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -35,6 +35,7 @@ data GitConfig = GitConfig , annexHttpHeaders :: [String] , annexHttpHeadersCommand :: Maybe String , annexAutoCommit :: Bool + , annexDebug :: Bool , annexWebOptions :: [String] , annexWebDownloadCommand :: Maybe String , annexCrippledFileSystem :: Bool @@ -59,6 +60,7 @@ extractGitConfig r = GitConfig , annexHttpHeaders = getlist (annex "http-headers") , annexHttpHeadersCommand = getmaybe (annex "http-headers-command") , annexAutoCommit = getbool (annex "autocommit") True + , annexDebug = getbool (annex "debug") False , annexWebOptions = getwords (annex "web-options") , annexWebDownloadCommand = getmaybe (annex "web-download-command") , annexCrippledFileSystem = getbool (annex "crippledfilesystem") False diff --git a/debian/changelog b/debian/changelog index e51c769c30..c433d2bf04 100644 --- a/debian/changelog +++ b/debian/changelog @@ -28,6 +28,8 @@ git-annex (4.20130602) UNRELEASED; urgency=low area, since it does not keep track of associated files.) Closes: #712060 * status: No longer shows dead repositories. + * annex.debug can now be set to enable debug logging by default. + The webapp's debugging check box does this. -- Joey Hess Mon, 10 Jun 2013 12:52:44 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 18bc05ad27..f0da25e146 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -622,6 +622,10 @@ subdirectories). Show debug messages. +* --no-debug + + Disable debug messages. + * --from=repository Specifies a repository that content will be retrieved from, or that @@ -903,6 +907,10 @@ Here are all the supported configuration settings. Set to false to prevent the git-annex assistant from automatically committing changes to files in the repository. +* `annex.debug` + + Set to true to enable debug logging by default. + * `annex.version` Automatically maintained, and used to automate upgrades between versions.