--debug is passed along to git-annex-shell when git-annex is in debug mode.

Assistant/Threads/WebApp.hs

@@ -49,7 +49,6 @@ import Network.Socket (SockAddr, HostName)
 import Data.Text (pack, unpack)
 import qualified Network.Wai.Handler.WarpTLS as TLS
 import Network.Wai.Middleware.RequestLogger
-import System.Log.Logger
 
 mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
 
@@ -138,9 +137,3 @@ getTlsSettings = do
 #else
 	return Nothing
 #endif
-
-{- Checks if debugging is actually enabled. -}
-debugEnabled :: IO Bool
-debugEnabled = do
-	l <- getRootLogger
-	return $ getLevel l <= Just DEBUG

Assistant/WebApp/Configurators/Preferences.hs

@@ -30,7 +30,7 @@ data PrefsForm = PrefsForm
 	, numCopies :: Int
 	, autoStart :: Bool
 	, autoUpgrade :: AutoUpgrade
-	, debugEnabled :: Bool
+	, enableDebug :: Bool
 	}
 
 prefsAForm :: PrefsForm -> MkAForm PrefsForm
@@ -44,7 +44,7 @@ prefsAForm d = PrefsForm
 	<*> areq (selectFieldList autoUpgradeChoices)
 		(bfs autoUpgradeLabel) (Just $ autoUpgrade d)
 	<*> areq (checkBoxField `withNote` debugnote)
-		"Enable debug logging" (Just $ debugEnabled d)
+		"Enable debug logging" (Just $ enableDebug d)
   where
 	diskreservenote = [whamlet|<br>Avoid downloading files from other repositories when there is too little free disk space.|]
 	numcopiesnote = [whamlet|<br>Only drop a file after verifying that other repositories contain this many copies.|]
@@ -98,8 +98,8 @@ storePrefs p = do
 		liftIO $ if autoStart p
 			then addAutoStartFile here
 			else removeAutoStartFile here
-	setConfig (annexConfig "debug") (boolConfig $ debugEnabled p)
+	setConfig (annexConfig "debug") (boolConfig $ enableDebug p)
-	liftIO $ if debugEnabled p
+	liftIO $ if enableDebug p
 		then enableDebugOutput 
 		else disableDebugOutput
 

Messages.hs

@@ -32,6 +32,7 @@ module Messages (
 	setupConsole,
 	enableDebugOutput,
 	disableDebugOutput,
+	debugEnabled,
 	commandProgressDisabled,
 ) where
 
@@ -191,6 +192,12 @@ enableDebugOutput = updateGlobalLogger rootLoggerName $ setLevel DEBUG
 disableDebugOutput :: IO ()
 disableDebugOutput = updateGlobalLogger rootLoggerName $ setLevel NOTICE
 
+{- Checks if debugging is enabled. -}
+debugEnabled :: IO Bool
+debugEnabled = do
+	l <- getRootLogger
+	return $ getLevel l <= Just DEBUG
+
 {- Should commands that normally output progress messages have that
  - output disabled? -}
 commandProgressDisabled :: Annex Bool

Remote/Helper/Ssh.hs

@@ -38,22 +38,30 @@ toRepo r gc sshcmd = do
  - repository. -}
 git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] -> Annex (Maybe (FilePath, [CommandParam]))
 git_annex_shell r command params fields
-	| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts ++ fieldopts)
+	| not $ Git.repoIsUrl r = do
+		shellopts <- getshellopts
+		return $ Just (shellcmd, shellopts ++ fieldopts)
 	| Git.repoIsSsh r = do
 		gc <- Annex.getRemoteGitConfig r
 		u <- getRepoUUID r
-		sshparams <- toRepo r gc [Param $ sshcmd u gc]
+		shellopts <- getshellopts
+		let sshcmd = unwords $
+			fromMaybe shellcmd (remoteAnnexShell gc)
+				: map shellEscape (toCommand shellopts) ++
+			uuidcheck u ++
+			map shellEscape (toCommand fieldopts)
+		sshparams <- toRepo r gc [Param sshcmd]
 		return $ Just ("ssh", sshparams)
 	| otherwise = return Nothing
   where
 	dir = Git.repoPath r
 	shellcmd = "git-annex-shell"
-	shellopts = Param command : File dir : params
+	getshellopts = do
-	sshcmd u gc = unwords $
+		debug <- liftIO debugEnabled
-		fromMaybe shellcmd (remoteAnnexShell gc)
+		let params' = if debug
-			: map shellEscape (toCommand shellopts) ++
+			then Param "--debug" : params
-		uuidcheck u ++
+			else params
-		map shellEscape (toCommand fieldopts)
+		return (Param command : File dir : params')
 	uuidcheck NoUUID = []
 	uuidcheck (UUID u) = ["--uuid", u]
 	fieldopts

debian/changelog

@@ -3,6 +3,7 @@ git-annex (5.20150813) UNRELEASED; urgency=medium
   * --debug log messages are now timestamped with fractional seconds.
   * Sped up downloads of files from ssh remotes, reducing the
     non-data-transfer overhead 6x.
+  * --debug is passed along to git-annex-shell when git-annex is in debug mode.
 
  -- Joey Hess <id@joeyh.name>  Wed, 12 Aug 2015 14:31:01 -0400