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

4
Assistant/WebApp/Configurators/IA.hs
View file

@ -130,7 +130,7 @@ postAddIAR = iaConfigurator $ do
case result of
FormSuccess input -> liftH $ do
let name = escapeBucket $ T.unpack $ itemName input
AWS.makeAWSRemote S3.remote (extractCreds input) name setgroup $
AWS.makeAWSRemote initSpecialRemote S3.remote (extractCreds input) name setgroup $
M.fromList $ catMaybes
[ Just $ configureEncryption NoEncryption
, Just ("type", "S3")
@ -174,7 +174,7 @@ enableIARemote uuid = do
m <- liftAnnex readRemoteLog
let name = fromJust $ M.lookup "name" $
fromJust $ M.lookup uuid m
AWS.makeAWSRemote S3.remote creds name (const noop) M.empty
AWS.makeAWSRemote enableSpecialRemote S3.remote creds name (const noop) M.empty
_ -> do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid

15
Assistant/WebApp/Configurators/WebDAV.hs
View file

@ -69,7 +69,7 @@ postAddBoxComR = boxConfigurator $ do
runFormPost $ renderBootstrap $ boxComAForm defcreds
case result of
FormSuccess input -> liftH $
makeWebDavRemote "box.com" (toCredPair input) setgroup $ M.fromList
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) setgroup $ M.fromList
[ configureEncryption $ enableEncryption input
, ("embedcreds", if embedCreds input then "yes" else "no")
, ("type", "webdav")
@ -100,7 +100,7 @@ postEnableWebDAVR uuid = do
getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid)
case mcreds of
Just creds -> webDAVConfigurator $ liftH $
makeWebDavRemote name creds (const noop) M.empty
makeWebDavRemote enableSpecialRemote name creds (const noop) M.empty
Nothing
| "box.com/" `isInfixOf` url ->
boxConfigurator $ showform name url
@ -115,7 +115,7 @@ postEnableWebDAVR uuid = do
runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds
case result of
FormSuccess input -> liftH $
makeWebDavRemote name (toCredPair input) (const noop) M.empty
makeWebDavRemote enableSpecialRemote name (toCredPair input) (const noop) M.empty
_ -> do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid
@ -125,13 +125,10 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build"
#endif
#ifdef WITH_WEBDAV
makeWebDavRemote :: String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
makeWebDavRemote name creds setup config = do
remotename <- liftAnnex $ fromRepo $ uniqueRemoteName name 0
makeWebDavRemote :: SpecialRemoteMaker -> String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
makeWebDavRemote maker name creds setup config = do
liftIO $ WebDAV.setCredsEnv creds
r <- liftAnnex $ addRemote $ do
makeSpecialRemote name WebDAV.remote config
return remotename
r <- liftAnnex $ addRemote $ maker name WebDAV.remote config
setup r
liftAssistant $ syncRemote r
redirect $ EditNewCloudRepositoryR $ Remote.uuid r