diff options
| -rw-r--r-- | Command.hs | 4 | ||||
| -rw-r--r-- | Command/InitRemote.hs | 48 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | Remote.hs | 74 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 6 | ||||
| -rw-r--r-- | doc/walkthrough/using_Amazon_S3.mdwn | 2 |
6 files changed, 131 insertions, 5 deletions
diff --git a/Command.hs b/Command.hs index 446b1b55f..9c908b800 100644 --- a/Command.hs +++ b/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 = "" diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs new file mode 100644 index 000000000..cf6a341c5 --- /dev/null +++ b/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 diff --git a/GitAnnex.hs b/GitAnnex.hs index adf07e5b3..736b430e6 100644 --- a/GitAnnex.hs +++ b/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 @@ -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 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4d1462394..0f548fa8a 100644 --- a/doc/git-annex.mdwn +++ b/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 ...] diff --git a/doc/walkthrough/using_Amazon_S3.mdwn b/doc/walkthrough/using_Amazon_S3.mdwn index 38a6a6de5..a99746c95 100644 --- a/doc/walkthrough/using_Amazon_S3.mdwn +++ b/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 |