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

4 files changed, 24 insertions, 15 deletions

diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index fd78ba8d8..33d11a0d5 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/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
diff --git a/Messages.hs b/Messages.hs
index c6d033402..026fca51e 100644
--- a/Messages.hs
+++ b/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
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 1e4daa1ad..162c34f4e 100644
--- a/Remote/Helper/Ssh.hs
+++ b/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
-	sshcmd u gc = unwords $
-		fromMaybe shellcmd (remoteAnnexShell gc)
-			: map shellEscape (toCommand shellopts) ++
-		uuidcheck u ++
-		map shellEscape (toCommand fieldopts)
+	getshellopts = do
+		debug <- liftIO debugEnabled
+		let params' = if debug
+			then Param "--debug" : params
+			else params
+		return (Param command : File dir : params')
 	uuidcheck NoUUID = []
 	uuidcheck (UUID u) = ["--uuid", u]
 	fieldopts
diff --git a/debian/changelog b/debian/changelog
index cbb2601eb..0b5c84edb 100644
--- a/debian/changelog
+++ b/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