summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-09 17:21:02 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-09 17:31:02 -0400
commit841e9fc078f114a7d1942d433a7f50af8f8552d4 (patch)
tree3aad8922a3428258bd22c9c1bd80328f318fdeec /Remote
parent43efb9173bbf23d35106d980fc36c07c6c29a4e6 (diff)
improve display when lockcontent fails
/dev/null stderr; ssh is still able to display a password prompt despite this Show some messages so the user knows it's locking a remote, and knows if that locking failed.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Git.hs26
-rw-r--r--Remote/Helper/Messages.hs27
2 files changed, 31 insertions, 22 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs
index c2bd307ad..80c0579cc 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -364,7 +364,7 @@ dropKey r key
lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r
lockKey r key callback
| not $ Git.repoIsUrl (repo r) =
- guardUsable (repo r) cantlock $ do
+ guardUsable (repo r) failedlock $ do
inorigrepo <- Annex.makeRunner
-- Lock content from perspective of remote,
-- and then run the callback in the original
@@ -372,13 +372,17 @@ lockKey r key callback
onLocal r $ Annex.Content.lockContentShared key $
liftIO . inorigrepo . callback
| Git.repoIsSsh (repo r) = do
+ showLocking r
Just (cmd, params) <- Ssh.git_annex_shell (repo r) "lockcontent"
[Param $ key2file key] []
- (Just hin, Just hout, Nothing, p) <- liftIO $ createProcess $
- (proc cmd (toCommand params))
- { std_in = CreatePipe
- , std_out = CreatePipe
- }
+ (Just hin, Just hout, Nothing, p) <- liftIO $
+ withFile devNull WriteMode $ \nullh ->
+ createProcess $
+ (proc cmd (toCommand params))
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = UseHandle nullh
+ }
-- Wait for either the process to exit, or for it to
-- indicate the content is locked.
v <- liftIO $ race
@@ -393,21 +397,23 @@ lockKey r key callback
let checkexited = not . isJust <$> getProcessExitCode p
case v of
Left _exited -> do
+ showNote "lockcontent failed"
liftIO $ do
hClose hin
hClose hout
- cantlock
+ failedlock
Right l
| l == Ssh.contentLockedMarker -> bracket_
noop
signaldone
(withVerifiedCopy LockedCopy r checkexited callback)
| otherwise -> do
+ showNote "lockcontent failed"
signaldone
- cantlock
- | otherwise = cantlock
+ failedlock
+ | otherwise = failedlock
where
- cantlock = error "can't lock content"
+ failedlock = error "can't lock content"
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs
index 377f2d231..6e72758fb 100644
--- a/Remote/Helper/Messages.hs
+++ b/Remote/Helper/Messages.hs
@@ -13,20 +13,23 @@ import Common.Annex
import qualified Git
import qualified Types.Remote as Remote
-class Checkable a where
- descCheckable :: a -> String
+class Describable a where
+ describe :: a -> String
-instance Checkable Git.Repo where
- descCheckable = Git.repoDescribe
+instance Describable Git.Repo where
+ describe = Git.repoDescribe
-instance Checkable (Remote.RemoteA a) where
- descCheckable = Remote.name
+instance Describable (Remote.RemoteA a) where
+ describe = Remote.name
-instance Checkable String where
- descCheckable = id
+instance Describable String where
+ describe = id
-showChecking :: Checkable a => a -> Annex ()
-showChecking v = showAction $ "checking " ++ descCheckable v
+showChecking :: Describable a => a -> Annex ()
+showChecking v = showAction $ "checking " ++ describe v
-cantCheck :: Checkable a => a -> e
-cantCheck v = error $ "unable to check " ++ descCheckable v
+cantCheck :: Describable a => a -> e
+cantCheck v = error $ "unable to check " ++ describe v
+
+showLocking :: Describable a => a -> Annex ()
+showLocking v = showAction $ "locking " ++ describe v