diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-10 21:55:59 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-10 21:55:59 -0400 |
commit | d19bbd29d8f473eae1aa1fa76c22e5374922c108 (patch) | |
tree | ffb8391884b271a822f1e031d1051219093b267a /Assistant/MakeRemote.hs | |
parent | a41255723c55d0046e8a9953a7ebaef9d2196bb5 (diff) |
pairing probably works now (untested)
Diffstat (limited to 'Assistant/MakeRemote.hs')
-rw-r--r-- | Assistant/MakeRemote.hs | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs new file mode 100644 index 000000000..1b3e6dd7d --- /dev/null +++ b/Assistant/MakeRemote.hs @@ -0,0 +1,107 @@ +{- 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.ThreadedMonad +import Assistant.DaemonStatus +import Assistant.ScanRemotes +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 qualified Data.Text as T +import qualified Data.Map as M + +{- Sets up and begins syncing with a new ssh or rsync remote. -} +makeSshRemote :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Bool -> SshData -> IO () +makeSshRemote st dstatus scanremotes forcersync sshdata = do + r <- runThreadState st $ + addRemote $ maker (sshRepoName sshdata) sshurl + syncNewRemote st dstatus scanremotes 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 = d + | 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 the name of the remote. -} +makeRsyncRemote :: String -> String -> Annex String +makeRsyncRemote name location = makeRemote name location $ const $ do + (u, c) <- Command.InitRemote.findByName name + c' <- R.setup Rsync.remote u $ M.union config c + describeUUID u name + configSet u c' + where + config = M.fromList + [ ("encryption", "shared") + , ("rsyncurl", location) + , ("type", "rsync") + ] + +{- 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 "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 + r <- fromRepo id + if (null $ filter samelocation $ Git.remotes r) + then do + let name = uniqueRemoteName r basename 0 + 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. -} +uniqueRemoteName :: Git.Repo -> String -> Int -> String +uniqueRemoteName r basename n + | null namecollision = name + | otherwise = uniqueRemoteName r basename (succ n) + where + namecollision = filter samename (Git.remotes r) + samename x = Git.remoteName x == Just name + name + | n == 0 = basename + | otherwise = basename ++ show n |