921f29c004
Clean up from 9769235d6b.
In some cases, looking up a remote by name even though it has no UUID is
desirable. This includes git annex sync, which can operate on remotes
without an annex, and XMPP pairing, which runs addRemote (with calls
byName) before the UUID of the XMPP remote has been configured in git.
115 lines
3.5 KiB
Haskell
115 lines
3.5 KiB
Haskell
{- git-annex assistant remote creation utilities
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.MakeRemote where
|
|
|
|
import Assistant.Common
|
|
import Assistant.Ssh
|
|
import Assistant.Sync
|
|
import qualified Types.Remote as R
|
|
import qualified Remote
|
|
import Remote.List
|
|
import qualified Remote.Rsync as Rsync
|
|
import qualified Git
|
|
import qualified Git.Command
|
|
import qualified Command.InitRemote
|
|
import Logs.UUID
|
|
import Logs.Remote
|
|
import Git.Remote
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.Map as M
|
|
|
|
{- Sets up and begins syncing with a new ssh or rsync remote. -}
|
|
makeSshRemote :: Bool -> SshData -> Assistant Remote
|
|
makeSshRemote forcersync sshdata = do
|
|
r <- liftAnnex $
|
|
addRemote $ maker (sshRepoName sshdata) sshurl
|
|
syncNewRemote r
|
|
return r
|
|
where
|
|
rsync = forcersync || rsyncOnly sshdata
|
|
maker
|
|
| rsync = makeRsyncRemote
|
|
| otherwise = makeGitRemote
|
|
sshurl = T.unpack $ T.concat $
|
|
if rsync
|
|
then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
|
|
else [T.pack "ssh://", u, h, d, T.pack "/"]
|
|
where
|
|
u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
|
|
h = sshHostName sshdata
|
|
d
|
|
| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
|
|
| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
|
|
|
|
{- Runs an action that returns a name of the remote, and finishes adding it. -}
|
|
addRemote :: Annex String -> Annex Remote
|
|
addRemote a = do
|
|
name <- a
|
|
void remoteListRefresh
|
|
maybe (error "failed to add remote") return
|
|
=<< Remote.byName (Just name)
|
|
|
|
{- Inits a rsync special remote, and returns its name. -}
|
|
makeRsyncRemote :: String -> String -> Annex String
|
|
makeRsyncRemote name location = makeRemote name location $
|
|
const $ makeSpecialRemote name Rsync.remote config
|
|
where
|
|
config = M.fromList
|
|
[ ("encryption", "shared")
|
|
, ("rsyncurl", location)
|
|
, ("type", "rsync")
|
|
]
|
|
|
|
{- Inits a special remote. -}
|
|
makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex ()
|
|
makeSpecialRemote name remotetype config = do
|
|
(u, c) <- Command.InitRemote.findByName name
|
|
c' <- R.setup remotetype u $ M.union config c
|
|
describeUUID u name
|
|
configSet u c'
|
|
|
|
{- Returns the name of the git remote it created. If there's already a
|
|
- remote at the location, returns its name. -}
|
|
makeGitRemote :: String -> String -> Annex String
|
|
makeGitRemote basename location = makeRemote basename location $ \name ->
|
|
void $ inRepo $ Git.Command.runBool
|
|
[Param "remote", Param "add", Param name, Param location]
|
|
|
|
{- If there's not already a remote at the location, adds it using the
|
|
- action, which is passed the name of the remote to make.
|
|
-
|
|
- Returns the name of the remote. -}
|
|
makeRemote :: String -> String -> (String -> Annex ()) -> Annex String
|
|
makeRemote basename location a = do
|
|
g <- gitRepo
|
|
if not (any samelocation $ Git.remotes g)
|
|
then do
|
|
|
|
let name = uniqueRemoteName basename 0 g
|
|
a name
|
|
return name
|
|
else return basename
|
|
where
|
|
samelocation x = Git.repoLocation x == location
|
|
|
|
{- Generate an unused name for a remote, adding a number if
|
|
- necessary.
|
|
-
|
|
- Ensures that the returned name is a legal git remote name. -}
|
|
uniqueRemoteName :: String -> Int -> Git.Repo -> String
|
|
uniqueRemoteName basename n r
|
|
| null namecollision = name
|
|
| otherwise = uniqueRemoteName legalbasename (succ n) r
|
|
where
|
|
namecollision = filter samename (Git.remotes r)
|
|
samename x = Git.remoteName x == Just name
|
|
name
|
|
| n == 0 = legalbasename
|
|
| otherwise = legalbasename ++ show n
|
|
legalbasename = makeLegalName basename
|