diff options
| -rw-r--r-- | P2P/Address.hs | 5 | ||||
| -rw-r--r-- | Remote/Git.hs | 6 | ||||
| -rw-r--r-- | Remote/List.hs | 4 | ||||
| -rw-r--r-- | Remote/P2P.hs | 85 | ||||
| -rw-r--r-- | git-annex.cabal | 1 |
5 files changed, 99 insertions, 2 deletions
diff --git a/P2P/Address.hs b/P2P/Address.hs index 19ff82a89..09ffc7973 100644 --- a/P2P/Address.hs +++ b/P2P/Address.hs @@ -10,6 +10,7 @@ module P2P.Address where import qualified Annex import Annex.Common import Git +import Git.Types import Creds import Utility.AuthToken import Utility.Tor @@ -54,6 +55,10 @@ instance FormatP2PAddress P2PAddressAuth where authtoken <- toAuthToken (T.pack $ reverse ra) return (P2PAddressAuth addr authtoken) +repoP2PAddress :: Repo -> Maybe P2PAddress +repoP2PAddress (Repo { location = Url url }) = unformatP2PAddress (show url) +repoP2PAddress _ = Nothing + -- | Load known P2P addresses for this repository. loadP2PAddresses :: Annex [P2PAddress] loadP2PAddresses = mapMaybe unformatP2PAddress . maybe [] lines diff --git a/Remote/Git.hs b/Remote/Git.hs index 3304e2069..41fb46e82 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -49,6 +49,8 @@ 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 @@ -130,7 +132,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 diff --git a/Remote/List.hs b/Remote/List.hs index 9c231b124..a5e305622 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -23,6 +23,7 @@ import qualified Git.Config import qualified Remote.Git import qualified Remote.GCrypt +import qualified Remote.P2P #ifdef WITH_S3 import qualified Remote.S3 #endif @@ -44,6 +45,7 @@ remoteTypes :: [RemoteType] remoteTypes = [ Remote.Git.remote , Remote.GCrypt.remote + , Remote.P2P.remote #ifdef WITH_S3 , Remote.S3.remote #endif @@ -116,4 +118,4 @@ updateRemote remote = do {- Checks if a remote is syncable using git. -} gitSyncableRemote :: Remote -> Bool gitSyncableRemote r = remotetype r `elem` - [ Remote.Git.remote, Remote.GCrypt.remote ] + [ Remote.Git.remote, Remote.GCrypt.remote, Remote.P2P.remote ] diff --git a/Remote/P2P.hs b/Remote/P2P.hs new file mode 100644 index 000000000..e0428eeeb --- /dev/null +++ b/Remote/P2P.hs @@ -0,0 +1,85 @@ +{- git remotes using the git-annex P2P protocol + - + - Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.P2P ( + remote, + chainGen +) where + +import Annex.Common +import P2P.Address +import Types.Remote +import Types.GitConfig +import qualified Git +import Config +import Config.Cost +import Remote.Helper.Git +import Remote.Helper.Special + +remote :: RemoteType +remote = RemoteType { + typename = "p2p", + -- Remote.Git takes care of enumerating P2P remotes, + -- and will call chainGen on them. + enumerate = const (return []), + generate = \_ _ _ _ -> return Nothing, + setup = error "P2P remotes are set up using git-annex p2p" +} + +chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) +chainGen addr r u c gc = do + workerpool <- mkWorkerPool addr + cst <- remoteCost gc expensiveRemoteCost + let this = Remote + { uuid = u + , cost = cst + , name = Git.repoDescribe r + , storeKey = storeKeyDummy + , retrieveKeyFile = retreiveKeyFileDummy + , retrieveKeyFileCheap = \_ _ _ -> return False + , removeKey = removeKeyDummy + , lockContent = Nothing -- TODO use p2p protocol locking + , checkPresent = checkPresentDummy + , checkPresentCheap = False + , whereisKey = Nothing + , remoteFsck = Nothing + , repairRepo = Nothing + , config = c + , localpath = Nothing + , repo = r + , gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r } + , readonly = False + , availability = GloballyAvailable + , remotetype = remote + , mkUnavailable = return Nothing + , getInfo = gitRepoInfo this + , claimUrl = Nothing + , checkUrl = Nothing + } + return $ Just $ specialRemote' (specialRemoteCfg c) c + (simplyPrepare $ store this workerpool) + (simplyPrepare $ retrieve this workerpool) + (simplyPrepare $ remove this workerpool) + (simplyPrepare $ checkKey this workerpool) + this + +data WorkerPool = WorkerPool + +mkWorkerPool :: P2PAddress -> Annex WorkerPool +mkWorkerPool addr = undefined + +store :: Remote -> WorkerPool -> Storer +store r workerpool = undefined + +retrieve :: Remote -> WorkerPool -> Retriever +retrieve r workerpool = undefined + +remove :: Remote -> WorkerPool -> Remover +remove r workerpool k = undefined + +checkKey :: Remote -> WorkerPool -> CheckPresent +checkKey r workerpool k = undefined diff --git a/git-annex.cabal b/git-annex.cabal index f6d8c5482..7fcba0623 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -937,6 +937,7 @@ Executable git-annex Remote.Helper.Tor Remote.Hook Remote.List + Remote.P2P Remote.Rsync Remote.Rsync.RsyncUrl Remote.S3 |