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

48
Remote/S3real.hs
View file

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