summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Ssh.hs15
-rw-r--r--CHANGELOG7
-rw-r--r--Command/Map.hs6
-rw-r--r--Remote/Bup.hs3
-rw-r--r--Remote/Ddar.hs22
-rw-r--r--Remote/GCrypt.hs7
-rw-r--r--Remote/Git.hs15
-rw-r--r--Remote/Helper/Ssh.hs25
-rw-r--r--Remote/Rsync.hs2
-rw-r--r--RemoteDaemon/Transport/GCrypt.hs3
-rw-r--r--RemoteDaemon/Transport/Ssh.hs2
-rw-r--r--doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys.mdwn2
-rw-r--r--doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys/comment_1_f0d17735d01a04c3c2adeb5ab4c2c0ce._comment26
13 files changed, 96 insertions, 39 deletions
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 512f0375c..285680f25 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -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"]
]
diff --git a/CHANGELOG b/CHANGELOG
index 94d3e2595..7fbbf01b2 100644
--- 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
diff --git a/Command/Map.hs b/Command/Map.hs
index b04beb477..eb08037c6 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -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
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9bdb22edd..5594bac9f 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -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
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 603eccd5e..146928499 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -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
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 78b1eed3c..79020f40c 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -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)
diff --git a/Remote/Git.hs b/Remote/Git.hs
index a0b590654..604056fc2 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -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
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index dff16b656..7f64b4645 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -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
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index dbaf2acc9..52ec90104 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -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" :
diff --git a/RemoteDaemon/Transport/GCrypt.hs b/RemoteDaemon/Transport/GCrypt.hs
index ec71b1842..2ebd16189 100644
--- a/RemoteDaemon/Transport/GCrypt.hs
+++ b/RemoteDaemon/Transport/GCrypt.hs
@@ -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) ->
diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs
index 6f8e8323e..fdb75e871 100644
--- a/RemoteDaemon/Transport/Ssh.hs
+++ b/RemoteDaemon/Transport/Ssh.hs
@@ -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
diff --git a/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys.mdwn b/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys.mdwn
index fd1334024..ff761904d 100644
--- a/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys.mdwn
+++ b/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys.mdwn
@@ -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
index 000000000..16d278f22
--- /dev/null
+++ b/doc/bugs/checkpresentkey_batch_stops_at_97_or_98_keys/comment_1_f0d17735d01a04c3c2adeb5ab4c2c0ce._comment
@@ -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.
+"""]]