diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 8e9867b2cd..73efcdaed5 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -55,13 +55,10 @@ addRemote a = do void remoteListRefresh maybe (error "failed to add remote") return =<< Remote.byName (Just name) -{- Inits a rsync special remote, and returns the name of the remote. -} +{- Inits a rsync special remote, and returns its name. -} makeRsyncRemote :: String -> String -> Annex String -makeRsyncRemote name location = makeRemote name location $ const $ do - (u, c) <- Command.InitRemote.findByName name - c' <- R.setup Rsync.remote u $ M.union config c - describeUUID u name - configSet u c' +makeRsyncRemote name location = makeRemote name location $ + const $ void $ makeSpecialRemote name Rsync.remote config where config = M.fromList [ ("encryption", "shared") @@ -69,6 +66,15 @@ makeRsyncRemote name location = makeRemote name location $ const $ do , ("type", "rsync") ] +{- Inits a special remote, and returns its name. -} +makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex String +makeSpecialRemote name remotetype config = do + (u, c) <- Command.InitRemote.findByName name + c' <- R.setup remotetype u $ M.union config c + describeUUID u name + configSet u c' + return name + {- Returns the name of the git remote it created. If there's already a - remote at the location, returns its name. -} makeGitRemote :: String -> String -> Annex String @@ -86,7 +92,7 @@ makeRemote basename location a = do r <- fromRepo id if not (any samelocation $ Git.remotes r) then do - let name = uniqueRemoteName r basename 0 + let name = uniqueRemoteName basename 0 r a name return name else return basename @@ -95,10 +101,10 @@ makeRemote basename location a = do {- Generate an unused name for a remote, adding a number if - necessary. -} -uniqueRemoteName :: Git.Repo -> String -> Int -> String -uniqueRemoteName r basename n +uniqueRemoteName :: String -> Int -> Git.Repo -> String +uniqueRemoteName basename n r | null namecollision = name - | otherwise = uniqueRemoteName r basename (succ n) + | otherwise = uniqueRemoteName basename (succ n) r where namecollision = filter samename (Git.remotes r) samename x = Git.remoteName x == Just name diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 8a5ab4ec6e..cb5f58b2d1 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -20,6 +20,7 @@ import Assistant.WebApp.Configurators import Assistant.WebApp.Configurators.Local import Assistant.WebApp.Configurators.Ssh import Assistant.WebApp.Configurators.Pairing +import Assistant.WebApp.Configurators.S3 import Assistant.WebApp.Documentation import Assistant.WebApp.OtherRepos import Assistant.ThreadedMonad diff --git a/Assistant/WebApp/Configurators/S3.hs b/Assistant/WebApp/Configurators/S3.hs new file mode 100644 index 0000000000..859ae3f6ff --- /dev/null +++ b/Assistant/WebApp/Configurators/S3.hs @@ -0,0 +1,95 @@ +{- git-annex assistant webapp configurator for Amazon S3 + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} + +module Assistant.WebApp.Configurators.S3 where + +import Assistant.Common +import Assistant.MakeRemote +import Assistant.Sync +import Assistant.WebApp +import Assistant.WebApp.Types +import Assistant.WebApp.SideBar +import Assistant.ThreadedMonad +import Utility.Yesod +import qualified Remote.S3 as S3 + +import Yesod +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Map as M + +data S3Input = S3Input + { accessKeyID :: Text + , secretAccessKey :: Text + -- Free form text for datacenter because Amazon adds new ones. + , datacenter :: Text + , storageClass :: StorageClass + , repoName :: Text + } + deriving (Show) + +data StorageClass = StandardRedundancy | ReducedRedundancy + deriving (Eq, Enum, Bounded) + +instance Show StorageClass where + show StandardRedundancy = "STANDARD" + show ReducedRedundancy = "REDUCED_REDUNDANCY" + +s3AForm :: AForm WebApp WebApp S3Input +s3AForm = S3Input + <$> areq textField "Access Key ID" Nothing + <*> areq passwordField "Secret Access Key" Nothing + <*> areq textField "Datacenter" (Just "US") + <*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy) + <*> areq textField "Repository name" (Just "S3") + where + storageclasses :: [(Text, StorageClass)] + storageclasses = + [ ("Standard redundancy", StandardRedundancy) + , ("Reduced redundancy (costs less)", ReducedRedundancy) + ] + +getAddS3R :: Handler RepHtml +getAddS3R = bootstrap (Just Config) $ do + sideBarDisplay + setTitle "Add an Amazon S3 repository" + ((result, form), enctype) <- lift $ + runFormGet $ renderBootstrap s3AForm + case result of + FormSuccess s3input -> lift $ do + let name = T.unpack $ repoName s3input + name' <- runAnnex name $ + fromRepo $ uniqueRemoteName name 0 + makeS3Remote s3input name' + _ -> showform form enctype + where + showform form enctype = do + let authtoken = webAppFormAuthToken + $(widgetFile "configurators/adds3") + +makeS3Remote :: S3Input -> String -> Handler () +makeS3Remote s3input name = do + webapp <- getYesod + let st = fromJust $ threadState webapp + liftIO $ do + S3.s3SetCredsEnv + ( T.unpack $ accessKeyID s3input + , T.unpack $ secretAccessKey s3input + ) + r <- runThreadState st $ addRemote $ + makeSpecialRemote name S3.remote config + syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r + redirect RepositoriesR + where + config = M.fromList + [ ("encryption", "shared") + , ("type", "S3") + , ("datacenter", T.unpack $ datacenter s3input) + , ("storageclass", show $ storageClass s3input) + ] diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index d26e0c5674..158b136813 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -15,7 +15,8 @@ /config/repository/add/ssh/confirm/#SshData ConfirmSshR GET /config/repository/add/ssh/make/git/#SshData MakeSshGitR GET /config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET -/config/repository/add/rsync.net AddRsyncNetR GET +/config/repository/add/cloud/rsync.net AddRsyncNetR GET +/config/repository/add/cloud/S3 AddS3R GET /config/repository/pair/start StartPairR GET /config/repository/pair/inprogress/#SecretReminder InprogressPairR GET diff --git a/debian/changelog b/debian/changelog index e378311e83..976b70903d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,7 +14,8 @@ git-annex (3.20120925) UNRELEASED; urgency=low Closes: #688833 * S3: When using a shared cipher, S3 credentials are not stored encrypted in the git repository, as that would allow anyone with access to - the repository access to the S3 account. + the repository access to the S3 account. Instead, they're stored + in a 600 mode file in the local git repo. -- Joey Hess Mon, 24 Sep 2012 19:58:07 -0400 diff --git a/templates/configurators/adds3.hamlet b/templates/configurators/adds3.hamlet new file mode 100644 index 0000000000..f70ce7838c --- /dev/null +++ b/templates/configurators/adds3.hamlet @@ -0,0 +1,38 @@ +
+

+ Adding an Amazon S3 repository +

+ Amazon S3 is a cloud storage # + provider. If you need a professional level of storage for your data, # + this is a good choice. # + + Pricing details, including one year Free Usage Tier promotion +

+ Do keep in mind that all your data # + will be synced to Amazon S3. You will be charged by Amazon for data # + uploaded to S3, as well as data downloaded from S3, and a monthly fee # + for data storage. # +

+ All data will be encrypted before being sent to Amazon S3. +

+ When you sign up to Amazon S3, they provide you with an Access # + Key ID, and a Secret Access Key. You will need to enter both below. # + These access keys will be stored in a file that only you can # + access. # + + Look up your access keys +

+

+
+ ^{form} + ^{authtoken} +