Run ssh with -n whenever input is not being piped into it
authorJoey Hess <joeyh@joeyh.name>
Wed, 15 Feb 2017 19:08:46 +0000 (15:08 -0400)
committerJoey Hess <joeyh@joeyh.name>
Wed, 15 Feb 2017 19:08:46 +0000 (15:08 -0400)
... to avoid it consuming stdin that it shouldn't.

This fixes git-annex-checkpresentkey --batch remote, which didn't output
results for all keys passed into it.

Other git-annex commands that communicate with a remote over ssh may also
have been consuming stdin that they shouldn't have, which could have
impacted using them in eg, shell scripts. For example, a shell script
reading files from stdin and passing them to git annex drop would be
impacted by this bug, whenever git annex drop ran git-annex-shell
checkpresent, it would consume part/all of the stdin that the shell script
was supposed to consume.

Fixed by adding a ConsumeStdin parameter to Annex.Ssh.sshOptions, which
is used throughout git-annex to run ssh (in order for ssh connection
caching to work). Every call site was checked to see if it used
CreatePipe for stdin, and if not was marked NoConsumeStdin.

14 files changed:
Annex/Ssh.hs
Assistant/WebApp/Configurators/Ssh.hs
CHANGELOG
Command/Map.hs
Remote/Bup.hs
Remote/Ddar.hs
Remote/GCrypt.hs
Remote/Git.hs
Remote/Helper/Ssh.hs
Remote/Rsync.hs
RemoteDaemon/Transport/GCrypt.hs
RemoteDaemon/Transport/Ssh.hs
doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys.mdwn
doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys/comment_1_f0d17735d01a04c3c2adeb5ab4c2c0ce._comment [new file with mode: 0644]

index 512f0375c2de7ec71b4bf66d4dbec1878bdbfa0d..285680f25db7f14ce693de4484f221be2d06ae2d 100644 (file)
@@ -1,6 +1,6 @@
 {- git-annex ssh interface, with connection caching
  -
- - Copyright 2012-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -8,6 +8,7 @@
 {-# LANGUAGE CPP #-}
 
 module Annex.Ssh (
+       ConsumeStdin(..),
        sshOptions,
        sshCacheDir,
        sshReadPort,
@@ -41,10 +42,15 @@ import Annex.Perms
 import Annex.LockPool
 #endif
 
+{- Some ssh commands are fed stdin on a pipe and so should be allowed to
+ - consume it. But ssh commands that are not piped stdin should generally
+ - not be allowed to consume the process's stdin. -}
+data ConsumeStdin = ConsumeStdin | NoConsumeStdin
+
 {- Generates parameters to ssh to a given host (or user@host) on a given
  - port. This includes connection caching parameters, and any ssh-options. -}
-sshOptions :: (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
-sshOptions (host, port) gc opts = go =<< sshCachingInfo (host, port)
+sshOptions :: ConsumeStdin -> (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
+sshOptions cs (host, port) gc opts = go =<< sshCachingInfo (host, port)
   where
        go (Nothing, params) = ret params
        go (Just socketfile, params) = do
@@ -55,6 +61,9 @@ sshOptions (host, port) gc opts = go =<< sshCachingInfo (host, port)
                , map Param (remoteAnnexSshOptions gc)
                , opts
                , portParams port
+               , case cs of
+                       ConsumeStdin -> []
+                       NoConsumeStdin -> [Param "-n"]
                , [Param "-T"]
                ]
 
index 950290249cf892cc63dbdc325da2dc5a120332e7..66f45d6ec9912c52c2049a66c17d71f3e3fd1f76 100644 (file)
@@ -746,7 +746,9 @@ testGitLabUrl glu = case parseGitLabUrl glu of
        probeuuid sshdata = do
                r <- inRepo $ Git.Construct.fromRemoteLocation (fromJust $ sshRepoUrl sshdata)
                getUncachedUUID . either (const r) fst <$>
-                       Remote.Helper.Ssh.onRemote r (Git.Config.fromPipe r, return (Left $ error "configlist failed")) "configlist" [] []
+                       Remote.Helper.Ssh.onRemote NoConsumeStdin r
+                               (Git.Config.fromPipe r, return (Left $ error "configlist failed"))
+                               "configlist" [] []
        verifysshworks sshdata = inRepo $ Git.Command.runBool
                [ Param "send-pack"
                , Param (fromJust $ sshRepoUrl sshdata)
index 94d3e2595982e775dfe4952a5a8a5fd9c1a2b53b..7fbbf01b282efd4a038629274e5bfd623e5c53d6 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -2,6 +2,13 @@ git-annex (6.20170215) UNRELEASED; urgency=medium
 
   * sync, merge: Fail when the current branch has no commits yet, instead
     of not merging in anything from remotes and appearing to succeed.
+  * Run ssh with -n whenever input is not being piped into it,
+    to avoid it consuming stdin that it shouldn't.
+    This fixes git-annex-checkpresentkey --batch remote,
+    which didn't output results for all keys passed into it. Other
+    git-annex commands that communicate with a remote over ssh may also
+    have been consuming stdin that they shouldn't have, which could have
+    impacted using them in eg, shell scripts.
 
  -- Joey Hess <id@joeyh.name>  Tue, 14 Feb 2017 15:54:25 -0400
 
index b04beb477cc0ded916a7714b8e8399ed6df803fc..eb08037c665b685568cd0fcd9bc034c3a5e084e5 100644 (file)
@@ -16,6 +16,7 @@ import qualified Git.Config
 import qualified Git.Construct
 import qualified Remote
 import qualified Annex
+import Annex.Ssh
 import Annex.UUID
 import Logs.UUID
 import Logs.Trust
@@ -219,10 +220,11 @@ tryScan r
          where
                p = proc pcmd $ toCommand params
 
-       configlist = Ssh.onRemote r (pipedconfig, return Nothing) "configlist" [] []
+       configlist = Ssh.onRemote NoConsumeStdin r
+               (pipedconfig, return Nothing) "configlist" [] []
        manualconfiglist = do
                gc <- Annex.getRemoteGitConfig r
-               sshparams <- Ssh.toRepo r gc [Param sshcmd]
+               sshparams <- Ssh.toRepo NoConsumeStdin r gc [Param sshcmd]
                liftIO $ pipedconfig "ssh" sshparams
          where
                sshcmd = "sh -c " ++ shellEscape
index 9bdb22edd09d49a3c448a0b5f5d74da03d194e27..5594bac9f80b806f744b1d1b498735adaa6b0bf8 100644 (file)
@@ -28,6 +28,7 @@ import Remote.Helper.Messages
 import Utility.Hash
 import Utility.UserInfo
 import Annex.UUID
+import Annex.Ssh
 import Utility.Metered
 
 type BupRepo = String
@@ -213,7 +214,7 @@ storeBupUUID u buprepo = do
 onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a
 onBupRemote r a command params = do
        c <- Annex.getRemoteGitConfig r
-       sshparams <- Ssh.toRepo r c [Param $
+       sshparams <- Ssh.toRepo NoConsumeStdin r c [Param $
                        "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)]
        liftIO $ a "ssh" sshparams
   where
index 603eccd5e11da4c420c97ffa80b7e3da738e98ff..1469284996e9cb17d044ae87e9d3fe78091460c5 100644 (file)
@@ -118,11 +118,11 @@ splitRemoteDdarRepo ddarrepo =
 
 {- Return the command and parameters to use for a ddar call that may need to be
  - made on a remote repository. This will call ssh if needed. -}
-ddarRemoteCall :: DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam])
-ddarRemoteCall ddarrepo cmd params
+ddarRemoteCall :: ConsumeStdin -> DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam])
+ddarRemoteCall cs ddarrepo cmd params
        | ddarLocal ddarrepo = return ("ddar", localParams)
        | otherwise = do
-               os <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) []
+               os <- sshOptions cs (host, Nothing) (ddarRepoConfig ddarrepo) []
                return ("ssh", os ++ remoteParams)
   where
        (host, ddarrepo') = splitRemoteDdarRepo ddarrepo
@@ -130,13 +130,13 @@ ddarRemoteCall ddarrepo cmd params
        remoteParams = Param host : Param "ddar" : Param [cmd] : Param ddarrepo' : params
 
 {- Specialized ddarRemoteCall that includes extraction command and flags -}
-ddarExtractRemoteCall :: DdarRepo -> Key -> Annex (String, [CommandParam])
-ddarExtractRemoteCall ddarrepo k =
-       ddarRemoteCall ddarrepo 'x' [Param "--force-stdout", Param $ key2file k]
+ddarExtractRemoteCall :: ConsumeStdin -> DdarRepo -> Key -> Annex (String, [CommandParam])
+ddarExtractRemoteCall cs ddarrepo k =
+       ddarRemoteCall cs ddarrepo 'x' [Param "--force-stdout", Param $ key2file k]
 
 retrieve :: DdarRepo -> Retriever
 retrieve ddarrepo = byteRetriever $ \k sink -> do
-       (cmd, params) <- ddarExtractRemoteCall ddarrepo k
+       (cmd, params) <- ddarExtractRemoteCall NoConsumeStdin ddarrepo k
        let p = (proc cmd $ toCommand params) { std_out = CreatePipe }
        (_, Just h, _, pid) <- liftIO $ createProcess p
        liftIO (hClose h >> forceSuccessProcess p pid)
@@ -147,7 +147,8 @@ retrieveCheap _ _ _ = return False
 
 remove :: DdarRepo -> Remover
 remove ddarrepo key = do
-       (cmd, params) <- ddarRemoteCall ddarrepo 'd' [Param $ key2file key]
+       (cmd, params) <- ddarRemoteCall NoConsumeStdin ddarrepo 'd'
+               [Param $ key2file key]
        liftIO $ boolSystem cmd params
 
 ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool)
@@ -158,7 +159,8 @@ ddarDirectoryExists ddarrepo
                        Left _ -> Right False
                        Right status -> Right $ isDirectory status
        | otherwise = do
-               ps <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) []
+               ps <- sshOptions NoConsumeStdin (host, Nothing)
+                       (ddarRepoConfig ddarrepo) []
                exitCode <- liftIO $ safeSystem "ssh" (ps ++ params)
                case exitCode of
                        ExitSuccess -> return $ Right True
@@ -178,7 +180,7 @@ ddarDirectoryExists ddarrepo
 {- Use "ddar t" to determine if a given key is present in a ddar archive -}
 inDdarManifest :: DdarRepo -> Key -> Annex (Either String Bool)
 inDdarManifest ddarrepo k = do
-       (cmd, params) <- ddarRemoteCall ddarrepo 't' []
+       (cmd, params) <- ddarRemoteCall NoConsumeStdin ddarrepo 't' []
        let p = proc cmd $ toCommand params
        liftIO $ catchMsgIO $ withHandle StdoutHandle createProcessSuccess p $ \h -> do
                contents <- hGetContents h
index 78b1eed3ccc88611f6e35eff03051a11fda9cfbf..79020f40c38fd8cdeaedb25f3c84aca10dbccd62 100644 (file)
@@ -159,7 +159,7 @@ rsyncTransport r gc
                let rsyncpath = if "/~/" `isPrefixOf` path
                        then drop 3 path
                        else path
-               opts <- sshOptions (host, Nothing) gc []
+               opts <- sshOptions ConsumeStdin (host, Nothing) gc []
                return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell)
        othertransport = return ([], loc, AccessDirect)
 
@@ -263,7 +263,8 @@ setupRepo gcryptid r
 
        {-  Ask git-annex-shell to configure the repository as a gcrypt
         -  repository. May fail if it is too old. -}
-       gitannexshellsetup = Ssh.onRemote r (boolSystem, return False)
+       gitannexshellsetup = Ssh.onRemote NoConsumeStdin r
+               (boolSystem, return False)
                "gcryptsetup" [ Param gcryptid ] []
 
        denyNonFastForwards = "receive.denyNonFastForwards"
@@ -398,7 +399,7 @@ getGCryptId fast r gc
        | Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
                liftIO (catchMaybeIO $ Git.Config.read r)
        | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
-               [ Ssh.onRemote r (Git.Config.fromPipe r, return (Left $ error "configlist failed")) "configlist" [] []
+               [ Ssh.onRemote NoConsumeStdin r (Git.Config.fromPipe r, return (Left $ error "configlist failed")) "configlist" [] []
                , getConfigViaRsync r gc
                ]
        | otherwise = return (Nothing, r)
index a0b590654dd75a986919234867bacdc4433a9469..604056fc21b85a84c13cf022b5e17eee155e158a 100644 (file)
@@ -210,7 +210,9 @@ tryGitConfigRead :: Bool -> Git.Repo -> Annex Git.Repo
 tryGitConfigRead autoinit r 
        | haveconfig r = return r -- already read
        | Git.repoIsSsh r = store $ do
-               v <- Ssh.onRemote r (pipedconfig, return (Left $ giveup "configlist failed")) "configlist" [] configlistfields
+               v <- Ssh.onRemote NoConsumeStdin r
+                       (pipedconfig, return (Left $ giveup "configlist failed"))
+                       "configlist" [] configlistfields
                case v of
                        Right r'
                                | haveconfig r' -> return r'
@@ -384,7 +386,8 @@ lockKey r key callback
                                                )
        | Git.repoIsSsh (repo r) = do
                showLocking r
-               Just (cmd, params) <- Ssh.git_annex_shell (repo r) "lockcontent"
+               Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
+                       (repo r) "lockcontent"
                        [Param $ key2file key] []
                (Just hin, Just hout, Nothing, p) <- liftIO $ 
                        withFile devNull WriteMode $ \nullh ->
@@ -477,7 +480,8 @@ copyFromRemote' r key file dest meterupdate
                u <- getUUID
                let fields = (Fields.remoteUUID, fromUUID u)
                        : maybe [] (\f -> [(Fields.associatedFile, f)]) file
-               Just (cmd, params) <- Ssh.git_annex_shell (repo r) "transferinfo" 
+               Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
+                       (repo r) "transferinfo" 
                        [Param $ key2file key] fields
                v <- liftIO (newEmptySV :: IO (MSampleVar Integer))
                pidv <- liftIO $ newEmptyMVar
@@ -583,7 +587,7 @@ copyToRemote' r key file meterupdate
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
 fsckOnRemote r params
        | Git.repoIsUrl r = do
-               s <- Ssh.git_annex_shell r "fsck" params []
+               s <- Ssh.git_annex_shell NoConsumeStdin r "fsck" params []
                return $ case s of
                        Nothing -> return False
                        Just (c, ps) -> batchCommand c ps
@@ -665,7 +669,8 @@ commitOnCleanup r a = go `after` a
                                Annex.Branch.commit "update"
                | otherwise = void $ do
                        Just (shellcmd, shellparams) <-
-                               Ssh.git_annex_shell (repo r) "commit" [] []
+                               Ssh.git_annex_shell NoConsumeStdin
+                                       (repo r) "commit" [] []
                        
                        -- Throw away stderr, since the remote may not
                        -- have a new enough git-annex shell to
index dff16b6568525db16c1670815a7f1620776d96b7..7f64b464546dc487c0ed9d20b32fbc2cbcd6b95d 100644 (file)
@@ -26,17 +26,17 @@ import Config
 {- Generates parameters to ssh to a repository's host and run a command.
  - Caller is responsible for doing any neccessary shellEscaping of the
  - passed command. -}
-toRepo :: Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
-toRepo r gc sshcmd = do
+toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
+toRepo cs r gc sshcmd = do
        let opts = map Param $ remoteAnnexSshOptions gc
        let host = fromMaybe (giveup "bad ssh url") $ Git.Url.hostuser r
-       params <- sshOptions (host, Git.Url.port r) gc opts
+       params <- sshOptions cs (host, Git.Url.port r) gc opts
        return $ params ++ Param host : sshcmd
 
 {- Generates parameters to run a git-annex-shell command on a remote
  - repository. -}
-git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] -> Annex (Maybe (FilePath, [CommandParam]))
-git_annex_shell r command params fields
+git_annex_shell :: ConsumeStdin -> Git.Repo -> String -> [CommandParam] -> [(Field, String)] -> Annex (Maybe (FilePath, [CommandParam]))
+git_annex_shell cs r command params fields
        | not $ Git.repoIsUrl r = do
                shellopts <- getshellopts
                return $ Just (shellcmd, shellopts ++ fieldopts)
@@ -49,7 +49,7 @@ git_annex_shell r command params fields
                                : map shellEscape (toCommand shellopts) ++
                        uuidcheck u ++
                        map shellEscape (toCommand fieldopts)
-               sshparams <- toRepo r gc [Param sshcmd]
+               sshparams <- toRepo cs r gc [Param sshcmd]
                return $ Just ("ssh", sshparams)
        | otherwise = return Nothing
   where
@@ -76,14 +76,15 @@ git_annex_shell r command params fields
  - Or, if the remote does not support running remote commands, returns
  - a specified error value. -}
 onRemote 
-       :: Git.Repo
+       :: ConsumeStdin
+       -> Git.Repo
        -> (FilePath -> [CommandParam] -> IO a, Annex a)
        -> String
        -> [CommandParam]
        -> [(Field, String)]
        -> Annex a
-onRemote r (with, errorval) command params fields = do
-       s <- git_annex_shell r command params fields
+onRemote cs r (with, errorval) command params fields = do
+       s <- git_annex_shell cs r command params fields
        case s of
                Just (c, ps) -> liftIO $ with c ps
                Nothing -> errorval
@@ -92,7 +93,7 @@ onRemote r (with, errorval) command params fields = do
 inAnnex :: Git.Repo -> Key -> Annex Bool
 inAnnex r k = do
        showChecking r
-       onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []
+       onRemote NoConsumeStdin r (check, cantCheck r) "inannex" [Param $ key2file k] []
   where
        check c p = dispatch =<< safeSystem c p
        dispatch ExitSuccess = return True
@@ -101,7 +102,7 @@ inAnnex r k = do
 
 {- Removes a key from a remote. -}
 dropKey :: Git.Repo -> Key -> Annex Bool
-dropKey r key = onRemote r (boolSystem, return False) "dropkey"
+dropKey r key = onRemote NoConsumeStdin r (boolSystem, return False) "dropkey"
        [ Param "--quiet", Param "--force"
        , Param $ key2file key
        ]
@@ -133,7 +134,7 @@ rsyncParamsRemote unlocked r direction key file afile = do
                -- compatability.
                : (Fields.direct, if unlocked then "1" else "")
                : maybe [] (\f -> [(Fields.associatedFile, f)]) afile
-       Just (shellcmd, shellparams) <- git_annex_shell (repo r)
+       Just (shellcmd, shellparams) <- git_annex_shell ConsumeStdin (repo r)
                (if direction == Download then "sendkey" else "recvkey")
                [ Param $ key2file key ]
                fields
index dbaf2acc9185c3d939ae863315077cf695d26f81..52ec9010448dcd420b0c07857d4327b86ca15b2d 100644 (file)
@@ -122,7 +122,7 @@ rsyncTransport gc url
                                let (port, sshopts') = sshReadPort sshopts
                                    userhost = takeWhile (/=':') url
                                -- Connection caching
-                               (Param "ssh":) <$> sshOptions
+                               (Param "ssh":) <$> sshOptions ConsumeStdin
                                        (userhost, port) gc
                                        (map Param $ loginopt ++ sshopts')
                        "rsh":rshopts -> return $ map Param $ "rsh" :
index ec71b18420a5100dca444b28092821f4f4bafecd..2ebd1618962d134a7da8ba924791a8d8b20d598a 100644 (file)
@@ -14,12 +14,13 @@ import RemoteDaemon.Transport.Ssh (transportUsingCmd)
 import Git.GCrypt
 import Remote.Helper.Ssh
 import Remote.GCrypt (accessShellConfig)
+import Annex.Ssh
 
 transport :: Transport
 transport rr@(RemoteRepo r gc) url h@(TransportHandle (LocalRepo g) _) ichan ochan
        | accessShellConfig gc = do
                r' <- encryptedRemote g r
-               v <- liftAnnex h $ git_annex_shell r' "notifychanges" [] []
+               v <- liftAnnex h $ git_annex_shell ConsumeStdin r' "notifychanges" [] []
                case v of
                        Nothing -> noop
                        Just (cmd, params) -> 
index 6f8e8323e8b1631db6cda55159dc036641a4d8dd..fdb75e8715cfe34320c895f9e7310a44a9402d13 100644 (file)
@@ -23,7 +23,7 @@ import Control.Concurrent.Async
 
 transport :: Transport
 transport rr@(RemoteRepo r _) url h ichan ochan = do
-       v <- liftAnnex h $ git_annex_shell r "notifychanges" [] []
+       v <- liftAnnex h $ git_annex_shell ConsumeStdin r "notifychanges" [] []
        case v of
                Nothing -> noop
                Just (cmd, params) -> transportUsingCmd cmd params rr url h ichan ochan
index fd1334024f9f103c8823d5027198d28b3b60055e..ff761904db16a953e672f880814cdb3d6ffe7bcf 100644 (file)
@@ -59,3 +59,5 @@ Arch Linux (installed from 'community')
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 I only find (what I think are) bugs because I use it and I use it because I like it. I like it because it works (except for when I find actual bugs :]).
+
+> [[fixed|done]] --[[Joey]]
diff --git a/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys/comment_1_f0d17735d01a04c3c2adeb5ab4c2c0ce._comment b/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys/comment_1_f0d17735d01a04c3c2adeb5ab4c2c0ce._comment
new file mode 100644 (file)
index 0000000..16d278f
--- /dev/null
@@ -0,0 +1,26 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2017-02-15T18:04:29Z"
+ content="""
+I am able to reproduce this, and it only happens when the remote being
+checked is a ssh remote, not a local directory.
+
+So, presumably something in the verification that the remote has the
+content is sometimes consuming the rest of stdin.
+
+The different numbers processed each time are probably due to buffering. If
+the command feeding the list of keys takes a while to print them all, and
+parts of its output are being thrown away, then that would explain the
+different numbers processed.
+
+Using ssh -n to run git-annex-shell checkpresentkey avoids the problem.
+
+This could also impact git-annex being used in some script, when the script
+is intended to consume stdin, but git-annex runs ssh, which consumes it
+instead. Other commands like `git annex drop` could be affected
+too in such situations.
+
+I've put in a comprehensive fix to all of git-annex's calls to ssh
+that don't provide some other stdin.
+"""]]