change Remote.repo to Remote.getRepo

This is groundwork for letting a repo be instantiated the first time
it's actually used, instead of at startup.

The only behavior change is that some old special cases for xmpp remotes
were removed. Where before git-annex silently did nothing with those
no-longer supported remotes, it may now fail in some way.

The additional IO action should have no performance impact as long as
it's simply return.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon
This commit is contained in:
Joey Hess 2018-06-04 14:31:55 -04:00
parent dc5550a54e
commit 67e46229a5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
36 changed files with 266 additions and 191 deletions

View file

@ -175,7 +175,7 @@ gen r u c gc
else Just $ repairRemote r
, config = c
, localpath = localpathCalc r
, repo = r
, getRepo = return r
, gitconfig = gc { remoteGitConfig = extractGitConfig r }
, readonly = Git.repoIsHttp r
, availability = availabilityCalc r
@ -328,33 +328,37 @@ tryGitConfigRead autoinit r
{- Checks if a given remote has the content for a key in its annex. -}
inAnnex :: Remote -> State -> Key -> Annex Bool
inAnnex rmt (State connpool duc) key
| Git.repoIsHttp r = checkhttp
| Git.repoIsUrl r = checkremote
inAnnex rmt st key = do
repo <- getRepo rmt
inAnnex' repo rmt st key
inAnnex' :: Git.Repo -> Remote -> State -> Key -> Annex Bool
inAnnex' repo rmt (State connpool duc) key
| Git.repoIsHttp repo = checkhttp
| Git.repoIsUrl repo = checkremote
| otherwise = checklocal
where
r = repo rmt
checkhttp = do
showChecking r
showChecking repo
ifM (Url.withUrlOptions $ \uo -> liftIO $
anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))
anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls repo rmt key))
( return True
, giveup "not found"
)
checkremote =
let fallback = Ssh.inAnnex r key
let fallback = Ssh.inAnnex repo key
in P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt) fallback) key
checklocal = ifM duc
( guardUsable r (cantCheck r) $
maybe (cantCheck r) return
=<< onLocalFast rmt (Annex.Content.inAnnexSafe key)
, cantCheck r
( guardUsable repo (cantCheck repo) $
maybe (cantCheck repo) return
=<< onLocalFast repo rmt (Annex.Content.inAnnexSafe key)
, cantCheck repo
)
keyUrls :: Remote -> Key -> [String]
keyUrls r key = map tourl locs'
keyUrls :: Git.Repo -> Remote -> Key -> [String]
keyUrls repo r key = map tourl locs'
where
tourl l = Git.repoLocation (repo r) ++ "/" ++ l
tourl l = Git.repoLocation repo ++ "/" ++ l
-- If the remote is known to not be bare, try the hash locations
-- used for non-bare repos first, as an optimisation.
locs
@ -369,10 +373,15 @@ keyUrls r key = map tourl locs'
cfg = remoteGitConfig remoteconfig
dropKey :: Remote -> State -> Key -> Annex Bool
dropKey r (State connpool duc) key
| not $ Git.repoIsUrl (repo r) = ifM duc
( guardUsable (repo r) (return False) $
commitOnCleanup r $ onLocalFast r $ do
dropKey r st key = do
repo <- getRepo r
dropKey' repo r st key
dropKey' :: Git.Repo -> Remote -> State -> Key -> Annex Bool
dropKey' repo r (State connpool duc) key
| not $ Git.repoIsUrl repo = ifM duc
( guardUsable repo (return False) $
commitOnCleanup repo r $ onLocalFast repo r $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContentForRemoval key $ \lock -> do
@ -382,25 +391,30 @@ dropKey r (State connpool duc) key
return True
, return False
)
| Git.repoIsHttp (repo r) = giveup "dropping from http remote not supported"
| otherwise = commitOnCleanup r $ do
let fallback = Ssh.dropKey (repo r) key
| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
| otherwise = commitOnCleanup repo r $ do
let fallback = Ssh.dropKey repo key
P2PHelper.remove (Ssh.runProto r connpool False fallback) key
lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
lockKey r (State connpool duc) key callback
| not $ Git.repoIsUrl (repo r) = ifM duc
( guardUsable (repo r) failedlock $ do
lockKey r st key callback = do
repo <- getRepo r
lockKey' repo r st key callback
lockKey' :: Git.Repo -> Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
lockKey' repo r (State connpool duc) key callback
| not $ Git.repoIsUrl repo = ifM duc
( guardUsable repo failedlock $ do
inorigrepo <- Annex.makeRunner
-- Lock content from perspective of remote,
-- and then run the callback in the original
-- annex monad, not the remote's.
onLocalFast r $
onLocalFast repo r $
Annex.Content.lockContentShared key $
liftIO . inorigrepo . callback
, failedlock
)
| Git.repoIsSsh (repo r) = do
| Git.repoIsSsh repo = do
showLocking r
let withconn = Ssh.withP2PSshConnection r connpool fallback
P2PHelper.lock withconn Ssh.runProtoConn (uuid r) key callback
@ -408,7 +422,7 @@ lockKey r (State connpool duc) key callback
where
fallback = do
Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
(repo r) "lockcontent"
repo "lockcontent"
[Param $ key2file key] []
(Just hin, Just hout, Nothing, p) <- liftIO $
withFile devNull WriteMode $ \nullh ->
@ -451,15 +465,20 @@ copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterU
copyFromRemote = copyFromRemote' False
copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
copyFromRemote' forcersync r (State connpool _) key file dest meterupdate
| Git.repoIsHttp (repo r) = unVerified $
Annex.Content.downloadUrl key meterupdate (keyUrls r key) dest
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (unVerified (return False)) $ do
copyFromRemote' forcersync r st key file dest meterupdate = do
repo <- getRepo r
copyFromRemote'' repo forcersync r st key file dest meterupdate
copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
copyFromRemote'' repo forcersync r (State connpool _) key file dest meterupdate
| Git.repoIsHttp repo = unVerified $
Annex.Content.downloadUrl key meterupdate (keyUrls repo r key) dest
| not $ Git.repoIsUrl repo = guardUsable repo (unVerified (return False)) $ do
params <- Ssh.rsyncParams r Download
u <- getUUID
hardlink <- wantHardLink
-- run copy from perspective of remote
onLocalFast r $ do
onLocalFast repo r $ do
ensureInitialized
v <- Annex.Content.prepSendAnnex key
case v of
@ -469,7 +488,7 @@ copyFromRemote' forcersync r (State connpool _) key file dest meterupdate
runTransfer (Transfer Download u key)
file stdRetry
(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess)
| Git.repoIsSsh (repo r) = if forcersync
| Git.repoIsSsh repo = if forcersync
then fallback meterupdate
else P2PHelper.retrieve
(\p -> Ssh.runProto r connpool (False, UnVerified) (fallback p))
@ -505,7 +524,7 @@ copyFromRemote' forcersync r (State connpool _) key file dest meterupdate
let fields = (Fields.remoteUUID, fromUUID u)
: maybe [] (\f -> [(Fields.associatedFile, f)]) afile
Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
(repo r) "transferinfo"
repo "transferinfo"
[Param $ key2file key] fields
v <- liftIO (newEmptySV :: IO (MSampleVar Integer))
pidv <- liftIO $ newEmptyMVar
@ -541,10 +560,15 @@ copyFromRemote' forcersync r (State connpool _) key file dest meterupdate
bracketIO noop (const cleanup) (const $ a feeder)
copyFromRemoteCheap :: Remote -> State -> Key -> AssociatedFile -> FilePath -> Annex Bool
copyFromRemoteCheap r st key af file = do
repo <- getRepo r
copyFromRemoteCheap' repo r st key af file
copyFromRemoteCheap' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> Annex Bool
#ifndef mingw32_HOST_OS
copyFromRemoteCheap r st key af file
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ liftIO $ do
loc <- gitAnnexLocation key (repo r) $
copyFromRemoteCheap' repo r st key af file
| not $ Git.repoIsUrl repo = guardUsable repo (return False) $ liftIO $ do
loc <- gitAnnexLocation key repo $
remoteGitConfig $ gitconfig r
ifM (doesFileExist loc)
( do
@ -554,25 +578,30 @@ copyFromRemoteCheap r st key af file
return True
, return False
)
| Git.repoIsSsh (repo r) =
| Git.repoIsSsh repo =
ifM (Annex.Content.preseedTmp key file)
( fst <$> copyFromRemote' True r st key af file nullMeterUpdate
, return False
)
| otherwise = return False
#else
copyFromRemoteCheap _ _ _ _ _ = return False
copyFromRemoteCheap' _ _ _ _ _ _ = return False
#endif
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Remote -> State -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
copyToRemote r (State connpool duc) key file meterupdate
| not $ Git.repoIsUrl (repo r) = ifM duc
( guardUsable (repo r) (return False) $ commitOnCleanup r $
copyToRemote r st key file meterupdate = do
repo <- getRepo r
copyToRemote' repo r st key file meterupdate
copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
copyToRemote' repo r (State connpool duc) key file meterupdate
| not $ Git.repoIsUrl repo = ifM duc
( guardUsable repo (return False) $ commitOnCleanup repo r $
copylocal =<< Annex.Content.prepSendAnnex key
, return False
)
| Git.repoIsSsh (repo r) = commitOnCleanup r $
| Git.repoIsSsh repo = commitOnCleanup repo r $
P2PHelper.store
(\p -> Ssh.runProto r connpool False (copyremotefallback p))
key file meterupdate
@ -589,7 +618,7 @@ copyToRemote r (State connpool duc) key file meterupdate
u <- getUUID
hardlink <- wantHardLink
-- run copy from perspective of remote
onLocalFast r $ ifM (Annex.Content.inAnnex key)
onLocalFast repo r $ ifM (Annex.Content.inAnnex key)
( return True
, do
ensureInitialized
@ -642,11 +671,11 @@ repairRemote r a = return $ do
- However, coprocesses are stopped after each call to avoid git
- processes hanging around on removable media.
-}
onLocal :: Remote -> Annex a -> Annex a
onLocal r a = do
onLocal :: Git.Repo -> Remote -> Annex a -> Annex a
onLocal repo r a = do
m <- Annex.getState Annex.remoteannexstate
go =<< maybe
(liftIO $ Annex.new $ repo r)
(liftIO $ Annex.new repo)
return
(M.lookup (uuid r) m)
where
@ -666,8 +695,8 @@ onLocal r a = do
- it gets the most current value. Caller of onLocalFast can make changes
- to the branch, however.
-}
onLocalFast :: Remote -> Annex a -> Annex a
onLocalFast r a = onLocal r $ Annex.BranchState.disableUpdate >> a
onLocalFast :: Git.Repo -> Remote -> Annex a -> Annex a
onLocalFast repo r a = onLocal repo r $ Annex.BranchState.disableUpdate >> a
{- Copys a file with rsync unless both locations are on the same
- filesystem. Then cp could be faster. -}
@ -689,18 +718,18 @@ rsyncOrCopyFile rsyncparams src dest p =
Ssh.rsyncHelper oh (Just p) $
rsyncparams ++ [File src, File dest]
commitOnCleanup :: Remote -> Annex a -> Annex a
commitOnCleanup r a = go `after` a
commitOnCleanup :: Git.Repo -> Remote -> Annex a -> Annex a
commitOnCleanup repo r a = go `after` a
where
go = Annex.addCleanup (RemoteCleanup $ uuid r) cleanup
cleanup
| not $ Git.repoIsUrl (repo r) = onLocalFast r $
| not $ Git.repoIsUrl repo = onLocalFast repo r $
doQuietSideAction $
Annex.Branch.commit "update"
| otherwise = void $ do
Just (shellcmd, shellparams) <-
Ssh.git_annex_shell NoConsumeStdin
(repo r) "commit" [] []
repo "commit" [] []
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to