rsync special remote: Include annex-rsync-options when running rsync to test a key's presence.

Also, use the new withQuietOutput function to avoid running the shell to
/dev/null stderr in two other places.

Annex/Ssh.hs

@@ -99,17 +99,14 @@ sshCleanup = do
 		stopssh socketfile = do
 			let (host, port) = socket2hostport socketfile
 			(_, params) <- sshInfo (host, port)
-			void $ liftIO $ do
+			-- "ssh -O stop" is noisy on stderr even with -q
-				-- "ssh -O stop" is noisy on stderr even with -q
+			void $ liftIO $ catchMaybeIO $
-				let cmd = unwords $ toCommand $
+				withQuietOutput createProcessSuccess $
-					[ Params "-O stop"
+					proc "ssh" $ toCommand $
-					] ++ params ++ [Param host]
+						[ Params "-O stop"
-				boolSystem "sh"
+						] ++ params ++ [Param host]
-					[ Param "-c"
+			-- Cannot remove the lock file; other processes may
-					, Param $ "ssh " ++ cmd ++ " >/dev/null 2>/dev/null"
+			-- be waiting on our exclusive lock to use it.
-					]
-				-- Cannot remove the lock file; other processes may
-				-- be waiting on our exclusive lock to use it.
 
 hostport2socket :: String -> Maybe Integer -> FilePath
 hostport2socket host Nothing = host

Remote/Git.hs

@@ -429,10 +429,12 @@ commitOnCleanup r a = go `after` a
 			| otherwise = void $ do
 				Just (shellcmd, shellparams) <-
 					git_annex_shell r "commit" [] []
+				
 				-- Throw away stderr, since the remote may not
 				-- have a new enough git-annex shell to
 				-- support committing.
-				let cmd = shellcmd ++ " "
+				liftIO $ catchMaybeIO $ do
-					++ unwords (map shellEscape $ toCommand shellparams)
+					print "!!!!!!!!!!!!!"
-					++ ">/dev/null 2>/dev/null"
+					withQuietOutput createProcessSuccess $
-				liftIO $ boolSystem "sh" [Param "-c", Param cmd]
+						proc shellcmd $
+							toCommand shellparams

Remote/Rsync.hs

@@ -166,9 +166,12 @@ checkPresent r o k = do
 	-- to connect, and the file not being present.
 	Right <$> check
 	where
- 		check = untilTrue (rsyncUrls o k) $ \u ->
+ 		check = untilTrue (rsyncUrls o k) $ \u -> 
-			liftIO $ boolSystem "sh" [Param "-c", Param (cmd u)]
+			liftIO $ catchBoolIO $ do
-		cmd u = "rsync --quiet " ++ shellEscape u ++ " 2>/dev/null"
+				withQuietOutput createProcessSuccess $
+					proc "rsync" $ toCommand $
+						rsyncOptions o ++ [Param u]
+				return True
 
 {- Rsync params to enable resumes of sending files safely,
  - ensure that files are only moved into place once complete

Utility/Process.hs

@@ -23,6 +23,7 @@ module Utility.Process (
 	createBackgroundProcess,
 	withHandle,
 	withBothHandles,
+	withQuietOutput,
 	createProcess,
 	runInteractiveProcess,
 	stdinHandle,
@@ -185,6 +186,19 @@ withBothHandles creator p a = creator p' $ a . bothHandles
 			, std_err = Inherit
 			}
 
+{- Forces the CreateProcessRunner to run quietly;
+ - both stdout and stderr are discarded. -}
+withQuietOutput
+	:: CreateProcessRunner
+	-> CreateProcess
+	-> IO ()
+withQuietOutput creator p = withFile "/dev/null" WriteMode $ \devnull -> do
+	let p' = p
+		{ std_out = UseHandle devnull
+		, std_err = UseHandle devnull
+		}
+	creator p' $ const $ return ()
+
 {- Extract a desired handle from createProcess's tuple.
  - These partial functions are safe as long as createProcess is run
  - with appropriate parameters to set up the desired handle.

debian/changelog

@@ -29,6 +29,8 @@ git-annex (3.20121018) UNRELEASED; urgency=low
     which doesn't work with LDAP or NIS.
   * assistant: Can use XMPP to notify other nodes that cannot be directly
     pushed to about pushes.
+  * rsync special remote: Include annex-rsync-options when running rsync
+    to test a key's presence.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 17 Oct 2012 14:24:10 -0400
 

doc/bugs/Calls_to_rsync_don__39__t_always_use__annex-rsync-options.mdwn

@@ -30,3 +30,6 @@ OS: Ubuntu 12.04
 Please provide any additional information below.
 
 I think this fix is as easy as including the annex-rsync-options wherever rsync is called.
+
+> I belive there was only the one place this was neglected. [[done]]
+> --[[Joey]]