mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

webapp: Differentiate between creating a new S3/Glacier/WebDav remote, and initializing an existing remote. When creating a new remote, avoid conflicts with other existing (or deleted) remotes with the same name.

Browse source
This commit is contained in:
Joey Hess 2013-07-20 17:52:14 -04:00
parent e344da5ea2
commit 9fc1448947
6 changed files with 65 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Assistant/WebApp/Configurators/AWS.hs
View file

@ -124,7 +124,7 @@ postAddS3R = awsConfigurator $ do
case result of
FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input
makeAWSRemote S3.remote (extractCreds input) name setgroup $ M.fromList
makeAWSRemote initSpecialRemote S3.remote (extractCreds input) name setgroup $ M.fromList
[ configureEncryption $ enableEncryption input
, ("type", "S3")
, ("datacenter", T.unpack $ datacenter input)
@ -150,7 +150,7 @@ postAddGlacierR = glacierConfigurator $ do
case result of
FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input
makeAWSRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList
makeAWSRemote initSpecialRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList
[ configureEncryption $ enableEncryption input
, ("type", "glacier")
, ("datacenter", T.unpack $ datacenter input)
@ -198,7 +198,7 @@ enableAWSRemote remotetype uuid = do
m <- liftAnnex readRemoteLog
let name = fromJust $ M.lookup "name" $
fromJust $ M.lookup uuid m
makeAWSRemote remotetype creds name (const noop) M.empty
makeAWSRemote enableSpecialRemote remotetype creds name (const noop) M.empty
_ -> do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid
@ -207,13 +207,11 @@ enableAWSRemote remotetype uuid = do
enableAWSRemote _ _ = error "S3 not supported by this build"
#endif
makeAWSRemote :: RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
makeAWSRemote remotetype (AWSCreds ak sk) name setup config = do
remotename <- liftAnnex $ fromRepo $ uniqueRemoteName name 0
makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
makeAWSRemote maker remotetype (AWSCreds ak sk) name setup config = do
liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
r <- liftAnnex $ addRemote $ do
makeSpecialRemote hostname remotetype config
return remotename
maker hostname remotetype config
setup r
liftAssistant $ syncRemote r
redirect $ EditNewCloudRepositoryR $ Remote.uuid r