diff options
Diffstat (limited to 'Remote/Git.hs')
| -rw-r--r-- | Remote/Git.hs | 39 |
1 files changed, 22 insertions, 17 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index 34bdd83a1..5eb6fbc9e 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -45,10 +45,13 @@ import Utility.CopyFile #endif import Utility.Env import Utility.Batch +import Utility.SimpleProtocol import Remote.Helper.Git import Remote.Helper.Messages import qualified Remote.Helper.Ssh as Ssh import qualified Remote.GCrypt +import qualified Remote.P2P +import P2P.Address import Annex.Path import Creds import Annex.CatFile @@ -95,20 +98,20 @@ list autoinit = do -} gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) gitSetup Nothing _ c _ = do - let location = fromMaybe (error "Specify location=url") $ + let location = fromMaybe (giveup "Specify location=url") $ Url.parseURIRelaxed =<< M.lookup "location" c g <- Annex.gitRepo u <- case filter (\r -> Git.location r == Git.Url location) (Git.remotes g) of [r] -> getRepoUUID r - [] -> error "could not find existing git remote with specified location" - _ -> error "found multiple git remotes with specified location" + [] -> giveup "could not find existing git remote with specified location" + _ -> giveup "found multiple git remotes with specified location" return (c, u) gitSetup (Just u) _ c _ = do inRepo $ Git.Command.run [ Param "remote" , Param "add" - , Param $ fromMaybe (error "no name") (M.lookup "name" c) - , Param $ fromMaybe (error "no location") (M.lookup "location" c) + , Param $ fromMaybe (giveup "no name") (M.lookup "name" c) + , Param $ fromMaybe (giveup "no location") (M.lookup "location" c) ] return (c, u) @@ -130,7 +133,9 @@ configRead autoinit r = do gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc | Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc - | otherwise = go <$> remoteCost gc defcst + | otherwise = case repoP2PAddress r of + Nothing -> go <$> remoteCost gc defcst + Just addr -> Remote.P2P.chainGen addr r u c gc where defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost go cst = Just new @@ -202,7 +207,7 @@ 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 $ error "configlist failed")) "configlist" [] configlistfields + v <- Ssh.onRemote r (pipedconfig, return (Left $ giveup "configlist failed")) "configlist" [] configlistfields case v of Right r' | haveconfig r' -> return r' @@ -321,7 +326,7 @@ inAnnex rmt key showChecking r ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key)) ( return True - , error "not found" + , giveup "not found" ) checkremote = Ssh.inAnnex r key checklocal = guardUsable r (cantCheck r) $ @@ -352,12 +357,12 @@ dropKey r key commitOnCleanup r $ onLocal r $ do ensureInitialized whenM (Annex.Content.inAnnex key) $ do - Annex.Content.lockContentForRemoval key - Annex.Content.removeAnnex - logStatus key InfoMissing + Annex.Content.lockContentForRemoval key $ \lock -> do + Annex.Content.removeAnnex lock + logStatus key InfoMissing Annex.Content.saveState True return True - | Git.repoIsHttp (repo r) = error "dropping from http remote not supported" + | Git.repoIsHttp (repo r) = giveup "dropping from http remote not supported" | otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r @@ -386,7 +391,7 @@ lockKey r key callback , std_out = CreatePipe , std_err = UseHandle nullh } - v <- liftIO $ tryIO $ hGetLine hout + v <- liftIO $ tryIO $ getProtocolLine hout let signaldone = void $ tryNonAsync $ liftIO $ mapM_ tryNonAsync [ hPutStrLn hout "" , hFlush hout @@ -404,7 +409,7 @@ lockKey r key callback void $ waitForProcess p failedlock Right l - | l == Ssh.contentLockedMarker -> bracket_ + | l == Just Ssh.contentLockedMarker -> bracket_ noop signaldone (withVerifiedCopy LockedCopy r checkexited callback) @@ -414,7 +419,7 @@ lockKey r key callback failedlock | otherwise = failedlock where - failedlock = error "can't lock content" + failedlock = giveup "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) @@ -444,7 +449,7 @@ copyFromRemote' r key file dest meterupdate | Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p)) =<< Ssh.rsyncParamsRemote False r Download key dest file - | otherwise = error "copying from non-ssh, non-http remote not supported" + | otherwise = giveup "copying from non-ssh, non-http remote not supported" where {- Feed local rsync's progress info back to the remote, - by forking a feeder thread that runs @@ -547,7 +552,7 @@ copyToRemote' r key file meterupdate unlocked <- isDirect <||> versionSupportsUnlockedPointers Ssh.rsyncHelper (Just meterupdate) =<< Ssh.rsyncParamsRemote unlocked r Upload key object file - | otherwise = error "copying to non-ssh repo not supported" + | otherwise = giveup "copying to non-ssh repo not supported" where copylocal Nothing = return False copylocal (Just (object, checksuccess)) = do |