started on initremote
This commit is contained in:
parent
235720d27e
commit
b1db436816
6 changed files with 131 additions and 5 deletions
|
@ -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
48
Command/InitRemote.hs
Normal 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
|
|
@ -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
|
||||
|
|
74
Remote.hs
74
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
|
||||
|
|
|
@ -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 ...]
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue