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

S3 crypto support

Browse source 
Untested, I will need to dust off my S3 keys, and plug the modem back in
that was unplugged last night due to very low battery bank power. But it
compiles, so it's probably perfect. :)
This commit is contained in:
Joey Hess 2011-04-17 11:01:34 -04:00
parent 4d136e1ef5
commit 67cced26dc
1 changed files with 39 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

50
Remote/S3real.hs
View file

@ -29,6 +29,7 @@ import Locations
import Config
import Remote.Special
import Remote.Encryptable
import Crypto
remote :: RemoteType Annex
remote = RemoteType {
@ -41,16 +42,22 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r u c = do
cst <- remoteCost r expensiveRemoteCost
return $ this cst
return $ gen' r u c cst
gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote Annex
gen' r u c cst =
encryptableRemote c
(storeEncrypted this)
(retrieveEncrypted this)
this
where
this cst = Remote {
this = Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
storeKey = store (this cst),
retrieveKeyFile = retrieve (this cst),
removeKey = remove (this cst),
hasKey = checkPresent (this cst),
storeKey = store this,
retrieveKeyFile = retrieve this,
removeKey = remove this,
hasKey = checkPresent this,
hasKeyCheap = False,
config = c
}
@ -139,9 +146,21 @@ checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
noconn = Left $ error "S3 not configured"
store :: Remote Annex -> Key -> Annex Bool
store r k = s3Action r False $ \(conn, bucket) -> do
store r k = storeHelper r k =<< lazyKeyContent k
storeEncrypted :: Remote Annex -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted r (cipher, enck) k = do
content <- lazyKeyContent k
content' <- liftIO $ withEncryptedContent cipher content return
storeHelper r enck content'
lazyKeyContent :: Key -> Annex L.ByteString
lazyKeyContent k = do
g <- Annex.gitRepo
content <- liftIO $ L.readFile $ gitAnnexLocation g k
liftIO $ L.readFile $ gitAnnexLocation g k
storeHelper :: Remote Annex -> Key -> L.ByteString -> Annex Bool
storeHelper r k content = s3Action r False $ \(conn, bucket) -> do
let object = setStorageClass storageclass $ bucketKey bucket k content
res <- liftIO $ sendObject conn object
case res of
@ -156,16 +175,25 @@ store r k = s3Action r False $ \(conn, bucket) -> do
_ -> STANDARD
retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool
retrieve r k f = s3Action r False $ \(conn, bucket) -> do
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
res <- liftIO $ getObject conn $ bucketKey bucket k L.empty
case res of
Right o -> do
liftIO $ L.writeFile f (obj_data o)
content <- liftIO $ a o
liftIO $ L.writeFile f content
return True
Left e -> do
warning $ prettyReqError e
return False
remove :: Remote Annex -> Key -> Annex Bool
remove r k = s3Action r False $ \(conn, bucket) -> do
res <- liftIO $ deleteObject conn $ bucketKey bucket k L.empty