partially complete gcrypt remote (local send done; rest not)
This is a git-remote-gcrypt encrypted special remote. Only sending files in to the remote works, and only for local repositories. Most of the work so far has involved making initremote work. A particular problem is that remote setup in this case needs to generate its own uuid, derivied from the gcrypt-id. That required some larger changes in the code to support. For ssh remotes, this will probably just reuse Remote.Rsync's code, so should be easy enough. And for downloading from a web remote, I will need to factor out the part of Remote.Git that does that. One particular thing that will need work is supporting hot-swapping a local gcrypt remote. I think it needs to store the gcrypt-id in the git config of the local remote, so that it can check it every time, and compare with the cached annex-uuid for the remote. If there is a mismatch, it can change both the cached annex-uuid and the gcrypt-id. That should work, and I laid some groundwork for it by already reading the remote's config when it's local. (Also needed for other reasons.) This commit was sponsored by Daniel Callahan.
This commit is contained in:
parent
0ab6764fe9
commit
7c1a9cdeb9
17 changed files with 306 additions and 92 deletions
|
@ -13,9 +13,6 @@ module Remote.Git (
|
|||
repoAvail,
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Control.Exception.Extensible
|
||||
|
||||
import Common.Annex
|
||||
import Utility.Rsync
|
||||
import Remote.Helper.Ssh
|
||||
|
@ -47,10 +44,14 @@ import Utility.Metered
|
|||
#ifndef mingw32_HOST_OS
|
||||
import Utility.CopyFile
|
||||
#endif
|
||||
import Remote.Helper.Git
|
||||
import qualified Remote.GCrypt
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.MSampleVar
|
||||
import System.Process (std_in, std_err)
|
||||
import qualified Data.Map as M
|
||||
import Control.Exception.Extensible
|
||||
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
|
@ -91,11 +92,10 @@ configRead r = do
|
|||
(False, _, NoUUID) -> tryGitConfigRead r
|
||||
_ -> return r
|
||||
|
||||
repoCheap :: Git.Repo -> Bool
|
||||
repoCheap = not . Git.repoIsUrl
|
||||
|
||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
||||
gen r u _ gc = go <$> remoteCost gc defcst
|
||||
gen r u c gc
|
||||
| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc
|
||||
| otherwise = go <$> remoteCost gc defcst
|
||||
where
|
||||
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
|
||||
go cst = new
|
||||
|
@ -112,14 +112,12 @@ gen r u _ gc = go <$> remoteCost gc defcst
|
|||
, hasKeyCheap = repoCheap r
|
||||
, whereisKey = Nothing
|
||||
, config = M.empty
|
||||
, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
||||
then Just $ Git.repoPath r
|
||||
else Nothing
|
||||
, localpath = localpathCalc r
|
||||
, repo = r
|
||||
, gitconfig = gc
|
||||
{ remoteGitConfig = Just $ extractGitConfig r }
|
||||
, readonly = Git.repoIsHttp r
|
||||
, globallyAvailable = not $ Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
||||
, globallyAvailable = globallyAvailableCalc r
|
||||
, remotetype = remote
|
||||
}
|
||||
|
||||
|
@ -131,13 +129,6 @@ repoAvail r
|
|||
| Git.repoIsLocalUnknown r = return False
|
||||
| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
|
||||
|
||||
{- Avoids performing an action on a local repository that's not usable.
|
||||
- Does not check that the repository is still available on disk. -}
|
||||
guardUsable :: Git.Repo -> a -> Annex a -> Annex a
|
||||
guardUsable r onerr a
|
||||
| Git.repoIsLocalUnknown r = return onerr
|
||||
| otherwise = a
|
||||
|
||||
{- Tries to read the config for a specified remote, updates state, and
|
||||
- returns the updated repo. -}
|
||||
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
|
||||
|
@ -154,8 +145,9 @@ tryGitConfigRead r
|
|||
headers <- getHttpHeaders
|
||||
store $ geturlconfig headers
|
||||
| Git.GCrypt.isEncrypted r = do
|
||||
-- Generate a UUID from the gcrypt-id
|
||||
g <- gitRepo
|
||||
case Git.GCrypt.remoteRepoId g r of
|
||||
case Git.GCrypt.remoteRepoId g (Git.remoteName r) of
|
||||
Nothing -> return r
|
||||
Just v -> store $ liftIO $ setUUID r $
|
||||
genUUIDInNameSpace gCryptNameSpace v
|
||||
|
@ -261,17 +253,6 @@ inAnnex r key
|
|||
unknown = Left $ "unable to check " ++ Git.repoDescribe r
|
||||
showchecking = showAction $ "checking " ++ Git.repoDescribe r
|
||||
|
||||
{- Runs an action on a local repository inexpensively, by making an annex
|
||||
- monad using that repository. -}
|
||||
onLocal :: Git.Repo -> Annex a -> IO a
|
||||
onLocal r a = do
|
||||
s <- Annex.new r
|
||||
Annex.eval s $ do
|
||||
-- No need to update the branch; its data is not used
|
||||
-- for anything onLocal is used to do.
|
||||
Annex.BranchState.disableUpdate
|
||||
a
|
||||
|
||||
keyUrls :: Git.Repo -> Key -> [String]
|
||||
keyUrls r key = map tourl locs
|
||||
where
|
||||
|
@ -415,15 +396,16 @@ copyToRemote r key file p
|
|||
(\d -> rsyncOrCopyFile params object d p)
|
||||
)
|
||||
|
||||
rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
|
||||
rsyncHelper callback params = do
|
||||
showOutput -- make way for progress bar
|
||||
ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
|
||||
( return True
|
||||
, do
|
||||
showLongNote "rsync failed -- run git annex again to resume file transfer"
|
||||
return False
|
||||
)
|
||||
{- Runs an action on a local repository inexpensively, by making an annex
|
||||
- monad using that repository. -}
|
||||
onLocal :: Git.Repo -> Annex a -> IO a
|
||||
onLocal r a = do
|
||||
s <- Annex.new r
|
||||
Annex.eval s $ do
|
||||
-- No need to update the branch; its data is not used
|
||||
-- for anything onLocal is used to do.
|
||||
Annex.BranchState.disableUpdate
|
||||
a
|
||||
|
||||
{- Copys a file with rsync unless both locations are on the same
|
||||
- filesystem. Then cp could be faster. -}
|
||||
|
@ -456,6 +438,16 @@ rsyncOrCopyFile rsyncparams src dest p =
|
|||
dorsync = rsyncHelper (Just p) $
|
||||
rsyncparams ++ [File src, File dest]
|
||||
|
||||
rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
|
||||
rsyncHelper callback params = do
|
||||
showOutput -- make way for progress bar
|
||||
ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
|
||||
( return True
|
||||
, do
|
||||
showLongNote "rsync failed -- run git annex again to resume file transfer"
|
||||
return False
|
||||
)
|
||||
|
||||
{- Generates rsync parameters that ssh to the remote and asks it
|
||||
- to either receive or send the key's content. -}
|
||||
rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue