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

S3: Fix check of uuid file stored in bucket, which was not working.

Browse source 
The check was broken in two ways.. First, nowhere did it error out when
checkUUIDFile found a different UUID already in the file. Instead,
it overwrote the uuid file.

And, checkUUIDFile's implementation was for some reason always failing with
a ConnectionClosed exception. Apparently something to do with using two
different runResourceT's and a response getting GCed inbetween. I'm pretty
sure that used to work, but changed to a more obviously correct
implementation.

This commit was sponsored by Peter Hogg on Patreon.
This commit is contained in:
Joey Hess 2017-02-13 15:35:24 -04:00
parent b6cfb9a73a
commit 976676a7b0
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
2 changed files with 19 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
CHANGELOG
View file

@ -51,6 +51,7 @@ git-annex (6.20170102) UNRELEASED; urgency=medium
app bundle.
* Improve pid locking code to work on filesystems that don't support hard
links.
* S3: Fix check of uuid file stored in bucket, which was not working.
-- Joey Hess <id@joeyh.name> Fri, 06 Jan 2017 15:22:06 -0400

29
Remote/S3.hs
View file

@ -7,6 +7,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where
@ -355,7 +356,8 @@ genBucket c gc u = do
{- Writes the UUID to an annex-uuid file within the bucket.
-
- If the file already exists in the bucket, it must match.
- If the file already exists in the bucket, it must match,
- or this fails.
-
- Note that IA buckets can only created by having a file
- stored in them. So this also takes care of that.
@ -365,6 +367,9 @@ writeUUIDFile c u info h = do
v <- checkUUIDFile c u info h
case v of
Right True -> noop
Right False -> do
warning "The bucket already exists, and its annex-uuid file indicates it is used by a different special remote."
giveup "Cannot reuse this bucket."
_ -> void $ sendS3Handle h mkobject
where
file = T.pack $ uuidFile c
@ -375,15 +380,17 @@ writeUUIDFile c u info h = do
{- Checks if the UUID file exists in the bucket
- and has the specified UUID already. -}
checkUUIDFile :: RemoteConfig -> UUID -> S3Info -> S3Handle -> Annex (Either SomeException Bool)
checkUUIDFile c u info h = tryNonAsync $ check <$> get
checkUUIDFile c u info h = tryNonAsync $ liftIO $ runResourceT $ do
resp <- tryS3 $ sendS3Handle' h (S3.getObject (bucket info) file)
case resp of
Left _ -> return False
Right r -> do
v <- AWS.loadToMemory r
let !ok = check v
return ok
where
get = liftIO
. runResourceT
. either (pure . Left) (Right <$$> AWS.loadToMemory)
=<< tryS3 (sendS3Handle h (S3.getObject (bucket info) file))
check (Right (S3.GetObjectMemoryResponse _meta rsp)) =
check (S3.GetObjectMemoryResponse _meta rsp) =
responseStatus rsp == ok200 && responseBody rsp == uuidb
check (Left _S3Error) = False
file = T.pack $ uuidFile c
uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]
@ -391,6 +398,9 @@ checkUUIDFile c u info h = tryNonAsync $ check <$> get
uuidFile :: RemoteConfig -> FilePath
uuidFile c = getFilePrefix c ++ "annex-uuid"
tryS3 :: ResourceT IO a -> ResourceT IO (Either S3.S3Error a)
tryS3 a = (Right <$> a) `catch` (pure . Left)
data S3Handle = S3Handle
{ hmanager :: Manager
, hawscfg :: AWS.Configuration
@ -465,9 +475,6 @@ s3Configuration c = cfg
_ -> giveup $ "bad S3 port value: " ++ s
cfg = S3.s3 proto endpoint False
tryS3 :: Annex a -> Annex (Either S3.S3Error a)
tryS3 a = (Right <$> a) `catch` (pure . Left)
data S3Info = S3Info
{ bucket :: S3.Bucket
, storageClass :: S3.StorageClass