started on initremote

This commit is contained in:
Joey Hess 2011-03-28 23:22:31 -04:00
parent 235720d27e
commit b1db436816
6 changed files with 131 additions and 5 deletions

View file

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

48
Command/InitRemote.hs Normal file
View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ...]

View file

@ -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