remove git-annex-shell compat code
* Removed support for accessing git remotes that use versions of git-annex older than 6.20180312. * git-annex-shell: Removed several commands that were only needed to support git-annex versions older than 6.20180312. (lockcontent, recvkey, sendkey, transferinfo, commit) The P2P protocol was added in that version, and used ever since, so this code was only needed for interop with older versions. "git-annex-shell commit" is used by newer git-annex versions, though unnecessarily so, because the p2pstdio command makes a single commit at shutdown. Luckily, it was run with stderr and stdout sent to /dev/null, and non-zero exit status or other exceptions are caught and ignored. So, that was able to be removed from git-annex-shell too. git-annex-shell inannex, recvkey, sendkey, and dropkey are still used by gcrypt special remotes accessed over ssh, so those had to be kept. It would probably be possible to convert that to using the P2P protocol, but it would be another multi-year transition. Some git-annex-shell fields were able to be removed. I hoped to remove all of them, and the very concept of them, but unfortunately autoinit is used by git-annex sync, and gcrypt uses remoteuuid. The main win here is really in Remote.Git, removing piles of hairy fallback code. Sponsored-by: Luke Shumaker
This commit is contained in:
Joey Hess
parent
5e3fe816ef
commit
7bdc7350a5
16 changed files with 82 additions and 428 deletions
177
Remote/Git.hs
177
Remote/Git.hs
|
|
@ -48,7 +48,6 @@ import Logs.Location
|
|||
import Utility.Metered
|
||||
import Utility.Env
|
||||
import Utility.Batch
|
||||
import Utility.SimpleProtocol
|
||||
import Remote.Helper.Git
|
||||
import Remote.Helper.Messages
|
||||
import Remote.Helper.ExportImport
|
||||
|
|
@ -70,7 +69,6 @@ import qualified Utility.RawFilePath as R
|
|||
#endif
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.MSampleVar
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import Network.URI
|
||||
|
|
@ -413,9 +411,7 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key
|
|||
( return True
|
||||
, giveup "not found"
|
||||
)
|
||||
checkremote =
|
||||
let fallback = Ssh.inAnnex repo key
|
||||
in P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt) fallback) key
|
||||
checkremote = P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt)) key
|
||||
checklocal = ifM duc
|
||||
( guardUsable repo (cantCheck repo) $
|
||||
maybe (cantCheck repo) return
|
||||
|
|
@ -458,9 +454,7 @@ dropKey' repo r st@(State connpool duc _ _ _) key
|
|||
, giveup "remote does not have expected annex.uuid value"
|
||||
)
|
||||
| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
|
||||
| otherwise = commitOnCleanup repo r st $ do
|
||||
let fallback = Ssh.dropKey' repo key
|
||||
P2PHelper.remove (Ssh.runProto r connpool (return False) fallback) key
|
||||
| otherwise = P2PHelper.remove (Ssh.runProto r connpool (return False)) key
|
||||
|
||||
lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
|
||||
lockKey r st key callback = do
|
||||
|
|
@ -482,63 +476,20 @@ lockKey' repo r st@(State connpool duc _ _ _) key callback
|
|||
)
|
||||
| Git.repoIsSsh repo = do
|
||||
showLocking r
|
||||
let withconn = Ssh.withP2PSshConnection r connpool fallback
|
||||
let withconn = Ssh.withP2PSshConnection r connpool failedlock
|
||||
P2PHelper.lock withconn Ssh.runProtoConn (uuid r) key callback
|
||||
| otherwise = failedlock
|
||||
where
|
||||
fallback = withNullHandle $ \nullh -> do
|
||||
Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
|
||||
repo "lockcontent"
|
||||
[Param $ serializeKey key] []
|
||||
let p = (proc cmd (toCommand params))
|
||||
{ std_in = CreatePipe
|
||||
, std_out = CreatePipe
|
||||
, std_err = UseHandle nullh
|
||||
}
|
||||
bracketIO (createProcess p) cleanupProcess fallback'
|
||||
|
||||
fallback' (Just hin, Just hout, Nothing, p) = do
|
||||
v <- liftIO $ tryIO $ getProtocolLine hout
|
||||
let signaldone = void $ tryNonAsync $ liftIO $ mapM_ tryNonAsync
|
||||
[ hPutStrLn hout ""
|
||||
, hFlush hout
|
||||
, hClose hin
|
||||
, hClose hout
|
||||
, void $ waitForProcess p
|
||||
]
|
||||
let checkexited = not . isJust <$> getProcessExitCode p
|
||||
case v of
|
||||
Left _exited -> do
|
||||
showNote "lockcontent failed"
|
||||
liftIO $ do
|
||||
hClose hin
|
||||
hClose hout
|
||||
void $ waitForProcess p
|
||||
failedlock
|
||||
Right l
|
||||
| l == Just Ssh.contentLockedMarker -> bracket_
|
||||
noop
|
||||
signaldone
|
||||
(withVerifiedCopy LockedCopy r checkexited callback)
|
||||
| otherwise -> do
|
||||
showNote "lockcontent failed"
|
||||
signaldone
|
||||
failedlock
|
||||
fallback' _ = error "internal"
|
||||
|
||||
failedlock = giveup "can't lock content"
|
||||
|
||||
{- Tries to copy a key's content from a remote's annex to a file. -}
|
||||
copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote = copyFromRemote' False
|
||||
|
||||
copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote' forcersync r st key file dest meterupdate vc = do
|
||||
copyFromRemote r st key file dest meterupdate vc = do
|
||||
repo <- getRepo r
|
||||
copyFromRemote'' repo forcersync r st key file dest meterupdate vc
|
||||
copyFromRemote'' repo r st key file dest meterupdate vc
|
||||
|
||||
copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate vc
|
||||
copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc
|
||||
| Git.repoIsHttp repo = do
|
||||
iv <- startVerifyKeyContentIncrementally vc key
|
||||
gc <- Annex.getGitConfig
|
||||
|
|
@ -566,90 +517,12 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest met
|
|||
then return v
|
||||
else giveup "failed to retrieve content from remote"
|
||||
Nothing -> giveup "content is not present in remote"
|
||||
| Git.repoIsSsh repo = if forcersync
|
||||
then do
|
||||
(ok, v) <- fallback meterupdate
|
||||
if ok
|
||||
then return v
|
||||
else giveup "failed to retrieve content from remote"
|
||||
else P2PHelper.retrieve
|
||||
| Git.repoIsSsh repo =
|
||||
P2PHelper.retrieve
|
||||
(gitconfig r)
|
||||
(\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p))
|
||||
(Ssh.runProto r connpool (return (False, UnVerified)))
|
||||
key file dest meterupdate vc
|
||||
| otherwise = giveup "copying from non-ssh, non-http remote not supported"
|
||||
where
|
||||
fallback p = unVerified $ feedprogressback $ \p' -> do
|
||||
oh <- mkOutputHandlerQuiet
|
||||
Ssh.rsyncHelper oh (Just (combineMeterUpdate p' p))
|
||||
=<< Ssh.rsyncParamsRemote False r Download key dest file
|
||||
|
||||
{- Feed local rsync's progress info back to the remote,
|
||||
- by forking a feeder thread that runs
|
||||
- git-annex-shell transferinfo at the same time
|
||||
- git-annex-shell sendkey is running.
|
||||
-
|
||||
- To avoid extra password prompts, this is only done when ssh
|
||||
- connection caching is supported.
|
||||
- Note that it actually waits for rsync to indicate
|
||||
- progress before starting transferinfo, in order
|
||||
- to ensure ssh connection caching works and reuses
|
||||
- the connection set up for the sendkey.
|
||||
-
|
||||
- Also note that older git-annex-shell does not support
|
||||
- transferinfo, so stderr is dropped and failure ignored.
|
||||
-}
|
||||
feedprogressback a = ifM (isJust <$> sshCacheDir)
|
||||
( feedprogressback' a
|
||||
, a $ const noop
|
||||
)
|
||||
feedprogressback' a = do
|
||||
u <- getUUID
|
||||
let AssociatedFile afile = file
|
||||
let fields = (Fields.remoteUUID, fromUUID u)
|
||||
: maybe [] (\f -> [(Fields.associatedFile, fromRawFilePath f)]) afile
|
||||
Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
|
||||
repo "transferinfo"
|
||||
[Param $ serializeKey key] fields
|
||||
v <- liftIO (newEmptySV :: IO (MSampleVar Integer))
|
||||
pv <- liftIO $ newEmptyMVar
|
||||
tid <- liftIO $ forkIO $ void $ tryIO $ do
|
||||
bytes <- readSV v
|
||||
p <- createProcess $
|
||||
(proc cmd (toCommand params))
|
||||
{ std_in = CreatePipe
|
||||
, std_err = CreatePipe
|
||||
}
|
||||
putMVar pv p
|
||||
hClose $ stderrHandle p
|
||||
let h = stdinHandle p
|
||||
let send b = do
|
||||
hPrint h b
|
||||
hFlush h
|
||||
send bytes
|
||||
forever $
|
||||
send =<< readSV v
|
||||
let feeder = \n -> do
|
||||
meterupdate n
|
||||
writeSV v (fromBytesProcessed n)
|
||||
|
||||
-- It can easily take 0.3 seconds to clean up after
|
||||
-- the transferinfo, and all that's involved is shutting
|
||||
-- down the process and associated thread cleanly. So,
|
||||
-- do it in the background.
|
||||
let cleanup = forkIO $ do
|
||||
void $ tryIO $ killThread tid
|
||||
void $ tryNonAsync $
|
||||
maybe noop (void . waitForProcess . processHandle)
|
||||
=<< tryTakeMVar pv
|
||||
|
||||
let forcestop = do
|
||||
void $ tryIO $ killThread tid
|
||||
void $ tryNonAsync $
|
||||
maybe noop cleanupProcess
|
||||
=<< tryTakeMVar pv
|
||||
|
||||
bracketIO noop (const cleanup) (const $ a feeder)
|
||||
`onException` liftIO forcestop
|
||||
|
||||
copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
|
||||
#ifndef mingw32_HOST_OS
|
||||
|
|
@ -681,9 +554,9 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
|
|||
copylocal =<< Annex.Content.prepSendAnnex' key
|
||||
, giveup "remote does not have expected annex.uuid value"
|
||||
)
|
||||
| Git.repoIsSsh repo = commitOnCleanup repo r st $
|
||||
| Git.repoIsSsh repo =
|
||||
P2PHelper.store (gitconfig r)
|
||||
(Ssh.runProto r connpool (return False) . copyremotefallback)
|
||||
(Ssh.runProto r connpool (return False))
|
||||
key file meterupdate
|
||||
|
||||
| otherwise = giveup "copying to non-ssh repo not supported"
|
||||
|
|
@ -715,16 +588,6 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
|
|||
)
|
||||
unless res $
|
||||
giveup "failed to send content to remote"
|
||||
copyremotefallback p = either (const False) id
|
||||
<$> tryNonAsync (copyremotefallback' p)
|
||||
copyremotefallback' p = Annex.Content.sendAnnex key noop $ \object -> do
|
||||
-- This is too broad really, but recvkey normally
|
||||
-- verifies content anyway, so avoid complicating
|
||||
-- it with a local sendAnnex check and rollback.
|
||||
let unlocked = True
|
||||
oh <- mkOutputHandlerQuiet
|
||||
Ssh.rsyncHelper oh (Just p)
|
||||
=<< Ssh.rsyncParamsRemote unlocked r Upload key object file
|
||||
|
||||
fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
|
||||
fsckOnRemote r params
|
||||
|
|
@ -820,21 +683,7 @@ commitOnCleanup repo r st a = go `after` a
|
|||
| not $ Git.repoIsUrl repo = onLocalFast st $
|
||||
doQuietSideAction $
|
||||
Annex.Branch.commit =<< Annex.Branch.commitMessage
|
||||
| otherwise = do
|
||||
Just (shellcmd, shellparams) <-
|
||||
Ssh.git_annex_shell NoConsumeStdin
|
||||
repo "commit" [] []
|
||||
|
||||
-- Throw away stderr, since the remote may not
|
||||
-- have a new enough git-annex shell to
|
||||
-- support committing.
|
||||
liftIO $ void $ catchMaybeIO $ withNullHandle $ \nullh ->
|
||||
let p = (proc shellcmd (toCommand shellparams))
|
||||
{ std_out = UseHandle nullh
|
||||
, std_err = UseHandle nullh
|
||||
}
|
||||
in withCreateProcess p $ \_ _ _ ->
|
||||
forceSuccessProcess p
|
||||
| otherwise = noop
|
||||
|
||||
wantHardLink :: Annex Bool
|
||||
wantHardLink = (annexHardLink <$> Annex.getGitConfig)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue