Merge branch 'master' into s3-aws
Conflicts: Remote/S3.hs
This commit is contained in:
commit
35551d0ed0
502 changed files with 7127 additions and 2453 deletions
29
Remote/S3.hs
29
Remote/S3.hs
|
@ -5,9 +5,7 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Remote.S3 (remote, iaHost, configIA, isIAHost, iaItemUrl) where
|
||||
module Remote.S3 (remote, iaHost, configIA, isIA, iaItemUrl) where
|
||||
|
||||
import qualified Aws as AWS
|
||||
import qualified Aws.Core as AWS
|
||||
|
@ -83,16 +81,21 @@ gen r u c gc = do
|
|||
readonly = False,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote,
|
||||
mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc
|
||||
mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,
|
||||
getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes
|
||||
[ Just ("bucket", fromMaybe "unknown" (getBucket c))
|
||||
, if isIA c
|
||||
then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucket c)
|
||||
else Nothing
|
||||
]
|
||||
}
|
||||
|
||||
s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
s3Setup mu mcreds c = do
|
||||
u <- maybe (liftIO genUUID) return mu
|
||||
c' <- setRemoteCredPair c (AWS.creds u) mcreds
|
||||
s3Setup' u c'
|
||||
s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
s3Setup' u c = if configIA c then archiveorg else defaulthost
|
||||
s3Setup' u mcreds c
|
||||
s3Setup' :: UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
s3Setup' u mcreds c = if isIA c then archiveorg else defaulthost
|
||||
where
|
||||
remotename = fromJust (M.lookup "name" c)
|
||||
defbucket = remotename ++ "-" ++ fromUUID u
|
||||
|
@ -109,25 +112,27 @@ s3Setup' u c = if configIA c then archiveorg else defaulthost
|
|||
return (fullconfig, u)
|
||||
|
||||
defaulthost = do
|
||||
c' <- encryptionSetup c
|
||||
let fullconfig = c' `M.union` defaults
|
||||
(c', encsetup) <- encryptionSetup c
|
||||
c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
|
||||
let fullconfig = c'' `M.union` defaults
|
||||
genBucket fullconfig u
|
||||
use fullconfig
|
||||
|
||||
archiveorg = do
|
||||
showNote "Internet Archive mode"
|
||||
c' <- setRemoteCredPair noEncryptionUsed c (AWS.creds u) mcreds
|
||||
-- Ensure user enters a valid bucket name, since
|
||||
-- this determines the name of the archive.org item.
|
||||
let validbucket = replace " " "-" $ map toLower $
|
||||
fromMaybe (error "specify bucket=") $
|
||||
getBucketName c
|
||||
getBucketName c'
|
||||
let archiveconfig =
|
||||
-- IA acdepts x-amz-* as an alias for x-archive-*
|
||||
M.mapKeys (replace "x-archive-" "x-amz-") $
|
||||
-- encryption does not make sense here
|
||||
M.insert "encryption" "none" $
|
||||
M.insert "bucket" validbucket $
|
||||
M.union c $
|
||||
M.union c' $
|
||||
-- special constraints on key names
|
||||
M.insert "mungekeys" "ia" defaults
|
||||
info <- extractS3Info archiveconfig
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue