summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/InitRemote.hs66
-rw-r--r--Remote.hs13
-rw-r--r--Remote/Git.hs9
-rw-r--r--Remote/S3.hs13
-rw-r--r--RemoteClass.hs8
-rw-r--r--doc/git-annex.mdwn6
6 files changed, 85 insertions, 30 deletions
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index 0d9a40cd3..39ec36653 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -12,7 +12,12 @@ import Control.Monad (when)
import Control.Monad.State (liftIO)
import Command
+import qualified Annex
import qualified Remote
+import qualified RemoteClass
+import qualified GitRepo as Git
+import Utility
+import Types
import UUID
import Messages
@@ -28,27 +33,49 @@ seek = [withString start]
start :: CommandStartString
start params = notBareRepo $ do
when (null ws) $ error "Specify a name for the remote"
+
+ (u, c) <- findByName name
+ let fullconfig = M.union config c
+ t <- findType fullconfig
+
showStart "initremote" name
- m <- Remote.readRemoteLog
- (u, c) <- case findByName name m of
- Just t -> return t
- Nothing -> do
- uuid <- liftIO $ genUUID
- return $ (uuid, M.insert nameKey name M.empty)
- return $ Just $ perform name u $ M.union config c
+ return $ Just $ perform t u $ M.union config c
where
ws = words params
name = head ws
config = Remote.keyValToMap $ tail ws
-perform :: String -> UUID -> M.Map String String -> CommandPerform
-perform name uuid config = do
- liftIO $ putStrLn $ show $ (uuid, config)
- return Nothing
+perform :: RemoteClass.RemoteType Annex -> UUID -> M.Map String String -> CommandPerform
+perform t u c = do
+ c' <- RemoteClass.setup t u c
+ return $ Just $ cleanup u c'
+
+cleanup :: UUID -> M.Map String String -> CommandCleanup
+cleanup u c = do
+ Remote.configSet u c
+ g <- Annex.gitRepo
+ logfile <- Remote.remoteLog
+ liftIO $ Git.run g "add" [File logfile]
+ liftIO $ Git.run g "commit"
+ [ Params "-q --allow-empty -m"
+ , Param "git annex initremote"
+ , File logfile
+ ]
+ return True
-findByName :: String -> M.Map UUID (M.Map String String) -> Maybe (UUID, M.Map String String)
-findByName n m = if null matches then Nothing else Just $ head matches
+{- Look up existing remote's UUID and config by name, or generate a new one -}
+findByName :: String -> Annex (UUID, M.Map String String)
+findByName name = do
+ m <- Remote.readRemoteLog
+ case findByName' name m of
+ Just i -> return i
+ Nothing -> do
+ uuid <- liftIO $ genUUID
+ return $ (uuid, M.insert nameKey name M.empty)
+
+findByName' :: String -> M.Map UUID (M.Map String String) -> Maybe (UUID, M.Map String String)
+findByName' n m = if null matches then Nothing else Just $ head matches
where
matches = filter (matching . snd) $ M.toList m
matching c = case M.lookup nameKey c of
@@ -57,6 +84,19 @@ findByName n m = if null matches then Nothing else Just $ head matches
| n' == n -> True
| otherwise -> False
+{- find the specified remote type -}
+findType :: M.Map String String -> Annex (RemoteClass.RemoteType Annex)
+findType config =
+ case M.lookup typeKey config of
+ Nothing -> error "Specify the type of remote with type="
+ Just s -> case filter (\i -> RemoteClass.typename i == s) Remote.remoteTypes of
+ [] -> error $ "Unknown remote type " ++ s
+ (t:_) -> return t
+
{- The name of a configured remote is stored in its config using this key. -}
nameKey :: String
nameKey = "name"
+
+{- The type of a remote is stored in its config using this key. -}
+typeKey :: String
+typeKey = "type"
diff --git a/Remote.hs b/Remote.hs
index f79b51262..1ca05d77b 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -15,12 +15,14 @@ module Remote (
hasKey,
hasKeyCheap,
+ remoteTypes,
byName,
nameToUUID,
keyPossibilities,
remotesWithUUID,
remotesWithoutUUID,
+ remoteLog,
readRemoteLog,
configSet,
keyValToMap
@@ -34,8 +36,6 @@ import qualified Data.Map as M
import Data.Maybe
import RemoteClass
-import qualified Remote.Git
-import qualified Remote.S3
import Types
import UUID
import qualified Annex
@@ -43,6 +43,10 @@ import Trust
import LocationLog
import Locations
import Messages
+import Utility
+
+import qualified Remote.Git
+import qualified Remote.S3
remoteTypes :: [RemoteType Annex]
remoteTypes =
@@ -150,7 +154,8 @@ configSet :: UUID -> M.Map String String -> Annex ()
configSet u c = do
m <- readRemoteLog
l <- remoteLog
- liftIO $ writeFile l $ unlines $ map toline $ M.toList $ M.insert u c m
+ liftIO $ safeWriteFile l $ unlines $ sort $
+ map toline $ M.toList $ M.insert u c m
where
toline (u', c') = u' ++ " " ++ (unwords $ mapToKeyVal c')
@@ -185,6 +190,6 @@ keyValToMap ws = M.fromList $ map (/=/) ws
v = drop (1 + length k) s
mapToKeyVal :: M.Map String String -> [String]
-mapToKeyVal m = map toword $ M.toList m
+mapToKeyVal m = map toword $ sort $ M.toList m
where
toword (k, v) = k ++ "=" ++ v
diff --git a/Remote/Git.hs b/Remote/Git.hs
index b686e47af..2d7a0c8ff 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -31,7 +31,11 @@ import Ssh
import Config
remote :: RemoteType Annex
-remote = RemoteType { typename = "git", generator = gen }
+remote = RemoteType {
+ typename = "git",
+ generator = gen,
+ setup = error "not supported"
+}
gen :: Annex (RemoteGenerator Annex)
gen = do
@@ -68,8 +72,7 @@ genRemote r = do
removeKey = dropKey r,
hasKey = inAnnex r,
hasKeyCheap = not (Git.repoIsUrl r),
- config = Nothing,
- setup = \_ -> return ()
+ config = Nothing
}
{- Tries to read the config for a specified remote, updates state, and
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 7971faa8f..489114b12 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -28,7 +28,11 @@ import UUID
import Config
remote :: RemoteType Annex
-remote = RemoteType { typename = "S3", generator = gen }
+remote = RemoteType {
+ typename = "S3",
+ generator = gen,
+ setup = s3Setup
+}
gen :: Annex (RemoteGenerator Annex)
gen = do
@@ -68,8 +72,7 @@ genRemote r u = do
removeKey = error "TODO",
hasKey = error "TODO",
hasKeyCheap = False,
- config = Nothing,
- setup = \_ -> return ()
+ config = Nothing
}
s3Connection :: Git.Repo -> Annex (Maybe AWSConnection)
@@ -102,6 +105,10 @@ getS3Config r s def = do
where
envvar = "ANNEX_" ++ map (\c -> if c == '-' then '_' else toUpper c) s
+s3Setup :: UUID -> M.Map String String -> Annex (M.Map String String)
+s3Setup u c = do
+ return c
+
{- The UUID of a S3 bucket is stored in a file "git-annex-uuid" in the
- bucket. Gets the UUID, or if there is none, sets a new UUID, possibly
- also creating the bucket. -}
diff --git a/RemoteClass.hs b/RemoteClass.hs
index 0482faac7..825197a4b 100644
--- a/RemoteClass.hs
+++ b/RemoteClass.hs
@@ -24,7 +24,9 @@ data RemoteType a = RemoteType {
-- human visible type name
typename :: String,
-- generates remotes of this type
- generator :: a (RemoteGenerator a)
+ generator :: a (RemoteGenerator a),
+ -- initializes or changes a remote
+ setup :: String -> M.Map String String -> a (M.Map String String)
}
{- An individual remote. -}
@@ -48,9 +50,7 @@ data Remote a = Remote {
-- operation.
hasKeyCheap :: Bool,
-- a Remote can have a persistent configuration store
- config :: Maybe (M.Map String String),
- -- initializes or changes the config of a remote
- setup :: M.Map String String -> a ()
+ config :: Maybe (M.Map String String)
}
instance Show (Remote a) where
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 0f548fa8a..d890b518b 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -134,11 +134,11 @@ Many git-annex commands will stage changes for later `git commit` by you.
* initremote name [param=value ...]
- Sets up a [[special_remote|special_remotes]] of some type. The remote's
- type and configuration is specified by the parameters. If a remote
+ Sets up a [[special_remote|special_remotes]]. The remote's
+ configuration is specified by the parameters. If a remote
with the specified name has already been configured, its configuration
is modified by any values specified. In either case, the remote will be
- added added to `.git/config`.
+ added to `.git/config`.
Example Amazon S3 remote:
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 18:23:15 +0000