started on initremote

Command.hs

@@ -238,6 +238,10 @@ paramGlob :: String
 paramGlob = "GLOB"
 paramName :: String
 paramName = "NAME"
+paramType :: String
+paramType = "TYPE"
+paramKeyValue :: String
+paramKeyValue = "K=V"
 paramNothing :: String
 paramNothing = ""
 

Command/InitRemote.hs

@@ -0,0 +1,48 @@
+{- git-annex command
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.InitRemote where
+
+import qualified Data.Map as M
+import Control.Monad (when)
+import Control.Monad.State (liftIO)
+
+import Command
+import qualified Remote
+import UUID
+import Messages
+
+command :: [Command]
+command = [repoCommand "initremote"
+	(paramPair paramName $
+		paramOptional $ paramRepeating $ paramKeyValue) seek
+	"sets up a special (non-git) remote"]
+
+seek :: [CommandSeek]
+seek = [withString start]
+
+start :: CommandStartString
+start params = notBareRepo $ do
+	when (null ws) $ error "Specify a name for the remote"
+	showStart "initremote" name
+	r <- Remote.configGet name
+	(u, c) <- case r of
+		Just t -> return t
+		Nothing -> do
+			uuid <- liftIO $ genUUID
+			return $ (uuid, M.empty)
+	return $ Just $ perform name 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

GitAnnex.hs

@@ -27,6 +27,7 @@ import qualified Command.SetKey
 import qualified Command.Fix
 import qualified Command.Init
 import qualified Command.Describe
+import qualified Command.InitRemote
 import qualified Command.Fsck
 import qualified Command.Unused
 import qualified Command.DropUnused
@@ -55,6 +56,7 @@ cmds = concat
 	, Command.Lock.command
 	, Command.Init.command
 	, Command.Describe.command
+	, Command.InitRemote.command
 	, Command.Unannex.command
 	, Command.Uninit.command
 	, Command.PreCommit.command

Remote.hs

@@ -19,13 +19,19 @@ module Remote (
 	nameToUUID,
 	keyPossibilities,
 	remotesWithUUID,
-	remotesWithoutUUID
+	remotesWithoutUUID,
+
+	configGet,
+	configSet,
+	keyValToMap
 ) where
 
 import Control.Monad.State (liftIO)
 import Control.Monad (when, liftM)
 import Data.List
 import Data.String.Utils
+import qualified Data.Map as M
+import Data.Maybe
 
 import RemoteClass
 import qualified Remote.Git
@@ -35,6 +41,7 @@ import UUID
 import qualified Annex
 import Trust
 import LocationLog
+import Locations
 import Messages
 
 {- Add generators for new Remotes here. -}
@@ -120,3 +127,68 @@ remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
 remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
 remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
 
+{- Filename of remote.log. -}
+remoteLog :: Annex FilePath
+remoteLog = do
+	g <- Annex.gitRepo
+	return $ gitStateDir g ++ "remote.log"
+
+{- Reads the uuid and config of the specified remote from the remoteLog. -}
+configGet :: String -> Annex (Maybe (UUID, M.Map String String))
+configGet n = do
+	rs <- readRemoteLog
+	let matches = filter (matchName n) rs
+	case matches of
+		[] -> return Nothing
+		((u, _, c):_) -> return $ Just (u, c)
+
+{- Changes or adds a remote's config in the remoteLog. -}
+configSet :: String -> UUID -> M.Map String String -> Annex ()
+configSet n u c = do
+	rs <- readRemoteLog
+	let others = filter (not . matchName n) rs
+	writeRemoteLog $ (u, n, c):others
+
+matchName :: String -> (UUID, String, M.Map String String) -> Bool
+matchName n (_, n', _) = n == n'
+
+readRemoteLog :: Annex [(UUID, String, M.Map String String)]
+readRemoteLog = do
+	l <- remoteLog
+	s <- liftIO $ catch (readFile l) ignoreerror
+	return $ remoteLogParse s
+	where
+		ignoreerror _ = return []
+
+writeRemoteLog :: [(UUID, String, M.Map String String)] -> Annex ()
+writeRemoteLog rs = do
+	l <- remoteLog
+	liftIO $ writeFile l $ unlines $ map toline rs
+	where
+		toline (u, n, c) = u ++ " " ++ n ++ (unwords $ mapToKeyVal c)
+
+remoteLogParse :: String -> [(UUID, String, M.Map String String)]
+remoteLogParse s = catMaybes $ map parseline $ filter (not . null) $ lines s
+	where
+		parseline l
+			| length w > 2 = Just (u, n, c)
+			| otherwise = Nothing
+			where
+				w = words l
+				u = w !! 0
+				n = w !! 1
+				c = keyValToMap $ drop 2 w
+
+{- Given Strings like "key=value", generates a Map. -}
+keyValToMap :: [String] -> M.Map String String
+keyValToMap ws = M.fromList $ map (/=/) ws
+	where
+		(/=/) s = (k, v)
+			where
+				k = takeWhile (/= '=') s
+				v = drop (1 + length k) s
+
+mapToKeyVal :: M.Map String String -> [String]
+mapToKeyVal m = map toword $ M.toList m
+	where
+		toword (k, v) = k ++ "=" ++ v

doc/git-annex.mdwn

@@ -132,17 +132,17 @@ Many git-annex commands will stage changes for later `git commit` by you.
   by uuid. To change the description of the current repository, use
   "."
 
-* initremote type name [param=value ...]
+* initremote name [param=value ...]
 
   Sets up a [[special_remote|special_remotes]] of some type. The remote's
-  configuration is configured by the parameters. If a remote
+  type and 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`.
 
   Example Amazon S3 remote:
 
-	initremote s3 mys3 type=S3 encryption=none datacenter=EU
+	initremote mys3 type=S3 encryption=none datacenter=EU
 
 * fsck [path ...]
 

doc/walkthrough/using_Amazon_S3.mdwn

@@ -9,7 +9,7 @@ First, export your S3 credentials:
 
 Next, create the remote.
 
-	git annex initremote s3 mys3 encryption=none
+	git annex initremote mys3 type=S3 encryption=none
 	initremote (creating bucket mys3-291d2fdc-5990-11e0-909a-002170d25c55...) ok
 
 **Note that encrypted buckets are not (yet) supported. Data sent to S3