diff options
| -rw-r--r-- | Remote/S3.hs | 60 | ||||
| -rw-r--r-- | debian/changelog | 3 |
2 files changed, 46 insertions, 17 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs index c883e2a5b..c30d07b8a 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -255,20 +255,28 @@ iaMunge = (>>= munge) | isSpace c = [] | otherwise = "&" ++ show (ord c) ++ ";" +{- Generate the bucket if it does not already exist, including creating the + - UUID file within the bucket. + - + - To check if the bucket exists, ask for its location. However, some ACLs + - can allow read/write to buckets, but not querying location, so first + - check if the UUID file already exists and we can skip doing anything. + -} genBucket :: RemoteConfig -> UUID -> Annex () genBucket c u = do conn <- s3ConnectionRequired c u showAction "checking bucket" - loc <- liftIO $ getBucketLocation conn bucket - case loc of - Right _ -> writeUUIDFile c u - Left err@(NetworkError _) -> s3Error err - Left (AWSError _ _) -> do - showAction $ "creating bucket in " ++ datacenter - res <- liftIO $ createBucketIn conn bucket datacenter - case res of - Right _ -> writeUUIDFile c u - Left err -> s3Error err + unlessM ((== Right True) <$> checkUUIDFile c u conn) $ do + loc <- liftIO $ getBucketLocation conn bucket + case loc of + Right _ -> writeUUIDFile c u + Left err@(NetworkError _) -> s3Error err + Left (AWSError _ _) -> do + showAction $ "creating bucket in " ++ datacenter + res <- liftIO $ createBucketIn conn bucket datacenter + case res of + Right _ -> writeUUIDFile c u + Left err -> s3Error err where bucket = fromJust $ getBucket c datacenter = fromJust $ M.lookup "datacenter" c @@ -284,20 +292,38 @@ genBucket c u = do writeUUIDFile :: RemoteConfig -> UUID -> Annex () writeUUIDFile c u = do conn <- s3ConnectionRequired c u - go conn =<< liftIO (tryNonAsync $ getObject conn $ mkobject L.empty) + v <- checkUUIDFile c u conn + case v of + Left e -> error e + Right True -> return () + Right False -> do + let object = setStorageClass (getStorageClass c) (mkobject uuidb) + either s3Error return =<< liftIO (sendObject conn object) where - go _conn (Right (Right o)) = unless (obj_data o == uuidb) $ - error $ "This bucket is already in use by a different S3 special remote, with UUID: " ++ show (obj_data o) - go conn _ = do - let object = setStorageClass (getStorageClass c) (mkobject uuidb) - either s3Error return =<< liftIO (sendObject conn object) + file = uuidFile c + uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u] + bucket = fromJust $ getBucket c + + mkobject = S3Object bucket file "" (getXheaders c) + +{- Checks if the UUID file exists in the bucket and has the specified UUID already. -} +checkUUIDFile :: RemoteConfig -> UUID -> AWSConnection -> Annex (Either String Bool) +checkUUIDFile c u conn = check <$> liftIO (tryNonAsync $ getObject conn $ mkobject L.empty) + where + check (Right (Right o)) + | obj_data o == uuidb = Right True + | otherwise = Left $ "This bucket is already in use by a different S3 special remote, with UUID: " ++ show (obj_data o) + check _ = Right False - file = filePrefix c ++ "annex-uuid" uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u] bucket = fromJust $ getBucket c + file = uuidFile c mkobject = S3Object bucket file "" (getXheaders c) +uuidFile :: RemoteConfig -> FilePath +uuidFile c = filePrefix c ++ "annex-uuid" + s3ConnectionRequired :: RemoteConfig -> UUID -> Annex AWSConnection s3ConnectionRequired c u = maybe (error "Cannot connect to S3") return =<< s3Connection c u diff --git a/debian/changelog b/debian/changelog index 58f2430b7..6aa0fa5f3 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,9 @@ git-annex (5.20140710) UNRELEASED; urgency=medium * migrate: Avoid re-checksumming when migrating from hashE to hash backend. * uninit: Avoid failing final removal in some direct mode repositories due to file modes. + * S3: Deal with AWS ACL configurations that do not allow creating or + checking the location of a bucket, but only reading and writing content to + it. -- Joey Hess <joeyh@debian.org> Wed, 09 Jul 2014 23:29:21 -0400 |