diff options
| -rw-r--r-- | Crypto.hs | 5 | ||||
| -rw-r--r-- | Remote/S3real.hs | 76 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/bugs/encrypted_S3_stalls.mdwn | 2 |
4 files changed, 50 insertions, 34 deletions
@@ -199,7 +199,10 @@ gpgPipeStrict params input = do return output {- Runs gpg with a cipher and some parameters, feeding it an input, - - and passing a handle to its output to an action. -} + - and passing a handle to its output to an action. + - + - Note that to avoid deadlock with the cleanup stage, + - the action must fully consume gpg's input before returning. -} gpgCipherHandle :: [CommandParam] -> Cipher -> L.ByteString -> (Handle -> IO a) -> IO a gpgCipherHandle params c input a = do -- pipe the passphrase into gpg on a fd diff --git a/Remote/S3real.hs b/Remote/S3real.hs index b88b22037..fe68a7f5b 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -100,13 +100,13 @@ s3Setup u c = do loc <- liftIO $ getBucketLocation conn bucket case loc of Right _ -> return () - Left err@(NetworkError _) -> error $ prettyReqError err + Left err@(NetworkError _) -> s3Error err Left (AWSError _ _) -> do showNote $ "creating bucket in " ++ datacenter res <- liftIO $ createBucketIn conn bucket datacenter case res of Right _ -> return () - Left err -> error $ prettyReqError err + Left err -> s3Error err gitConfigSpecialRemote u fullconfig "s3" "true" return fullconfig @@ -141,33 +141,32 @@ checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do case res of Right _ -> return $ Right True Left (AWSError _ _) -> return $ Right False - Left e -> return $ Left (error $ prettyReqError e) + Left e -> return $ Left (s3Error e) where noconn = Left $ error "S3 not configured" store :: Remote Annex -> Key -> Annex Bool -store r k = storeHelper r k =<< lazyKeyContent k +store r k = s3Action r False $ \(conn, bucket) -> do + content <- lazyKeyContent k + res <- liftIO $ storeHelper (conn, bucket) r k content + s3Bool res storeEncrypted :: Remote Annex -> (Cipher, Key) -> Key -> Annex Bool -storeEncrypted r (cipher, enck) k = do +storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) -> do content <- lazyKeyContent k - content' <- liftIO $ withEncryptedContent cipher content return - storeHelper r enck content' + res <- liftIO $ withEncryptedContent cipher content $ \s -> do + storeHelper (conn, bucket) r enck s + s3Bool res lazyKeyContent :: Key -> Annex L.ByteString lazyKeyContent k = do g <- Annex.gitRepo liftIO $ L.readFile $ gitAnnexLocation g k -storeHelper :: Remote Annex -> Key -> L.ByteString -> Annex Bool -storeHelper r k content = s3Action r False $ \(conn, bucket) -> do +storeHelper :: (AWSConnection, String) -> Remote Annex -> Key -> L.ByteString -> IO (AWSResult ()) +storeHelper (conn, bucket) r k content = do let object = setStorageClass storageclass $ bucketKey bucket k content - res <- liftIO $ sendObject conn object - case res of - Right _ -> return True - Left e -> do - warning $ prettyReqError e - return False + sendObject conn object where storageclass = case fromJust $ M.lookup "storageclass" $ fromJust $ config r of @@ -175,30 +174,41 @@ storeHelper r k content = s3Action r False $ \(conn, bucket) -> do _ -> STANDARD retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool -retrieve = retrieveHelper (return . obj_data) - -retrieveEncrypted :: Remote Annex -> (Cipher, Key) -> FilePath -> Annex Bool -retrieveEncrypted r (cipher, enck) f = retrieveHelper decrypt r enck f - where - decrypt o = withDecryptedContent cipher (obj_data o) return - -retrieveHelper :: (S3Object -> IO L.ByteString) -> Remote Annex -> Key -> FilePath -> Annex Bool -retrieveHelper a r k f = s3Action r False $ \(conn, bucket) -> do +retrieve r k f = s3Action r False $ \(conn, bucket) -> do res <- liftIO $ getObject conn $ bucketKey bucket k L.empty case res of Right o -> do - content <- liftIO $ a o - liftIO $ L.writeFile f content + liftIO $ L.writeFile f $ obj_data o return True - Left e -> do - warning $ prettyReqError e - return False - + Left e -> s3Warning e + +retrieveEncrypted :: Remote Annex -> (Cipher, Key) -> FilePath -> Annex Bool +retrieveEncrypted r (cipher, enck) f = s3Action r False $ \(conn, bucket) -> do + res <- liftIO $ getObject conn $ bucketKey bucket enck L.empty + case res of + Right o -> liftIO $ + withDecryptedContent cipher (obj_data o) $ \content -> do + L.writeFile f content + return True + Left e -> s3Warning e + remove :: Remote Annex -> Key -> Annex Bool remove r k = s3Action r False $ \(conn, bucket) -> do res <- liftIO $ deleteObject conn $ bucketKey bucket k L.empty case res of Right _ -> return True - Left e -> do - warning $ prettyReqError e - return False + Left e -> s3Warning e + +s3Warning :: ReqError -> Annex Bool +s3Warning e = do + warning $ prettyReqError e + return False + +s3Error :: ReqError -> a +s3Error e = error $ prettyReqError e + +s3Bool :: AWSResult () -> Annex Bool +s3Bool res = do + case res of + Right _ -> return True + Left e -> s3Warning e diff --git a/debian/changelog b/debian/changelog index aa00d3fca..60ccace7a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,7 @@ git-annex (0.20110418) UNRELEASED; urgency=low * Don't run gpg in batch mode, so it can prompt for passphrase when there is no agent. * Add missing build dep on dataenc. + * Fix stalls in S3 when transferring encrypted data. -- Joey Hess <joeyh@debian.org> Sun, 17 Apr 2011 14:29:49 -0400 diff --git a/doc/bugs/encrypted_S3_stalls.mdwn b/doc/bugs/encrypted_S3_stalls.mdwn index c4484b9c4..109e6e793 100644 --- a/doc/bugs/encrypted_S3_stalls.mdwn +++ b/doc/bugs/encrypted_S3_stalls.mdwn @@ -5,3 +5,5 @@ dialup. There was a similar issue with bup, which I fixed by forking a process rather than using a thread to do some IO. Probably need the same here. --[[Joey]] + +[[done]] --[[Joey]] |