full encryption support for directory special remotes

This commit is contained in:
Joey Hess 2011-04-16 18:22:52 -04:00
parent 9fe7e6be70
commit 4f9fafa023
3 changed files with 83 additions and 15 deletions

View file

@ -9,6 +9,8 @@
-}
module Crypto (
Cipher,
EncryptedCipher,
genCipher,
updateCipher,
storeCipher,
@ -133,7 +135,10 @@ gpgRead params = pOpen ReadFromPipe "gpg" (gpgParams params) hGetContentsStrict
gpgPipeStrict :: [CommandParam] -> String -> IO String
gpgPipeStrict params input = do
(_, output) <- pipeBoth "gpg" (gpgParams params) input
(pid, fromh, toh) <- hPipeBoth "gpg" (gpgParams params)
_ <- forkIO $ finally (hPutStr toh input) (hClose toh)
output <- hGetContentsStrict fromh
forceSuccess pid
return output
gpgPipeBytes :: [CommandParam] -> L.ByteString -> IO (PipeHandle, L.ByteString)

View file

@ -7,6 +7,7 @@
module Remote.Directory (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import IO
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
@ -27,6 +28,7 @@ import Content
import Utility
import Remote.Special
import Remote.Encrypted
import Crypto
remote :: RemoteType Annex
remote = RemoteType {
@ -37,17 +39,17 @@ remote = RemoteType {
}
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r u _ = do
gen r u c = do
dir <- getConfig r "directory" (error "missing directory")
cst <- remoteCost r cheapRemoteCost
return $ Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
storeKey = store dir,
retrieveKeyFile = retrieve dir,
removeKey = remove dir,
hasKey = checkPresent dir,
storeKey = storeKeyEncrypted c $ store dir,
retrieveKeyFile = retrieveKeyFileEncrypted c $ retrieve dir,
removeKey = removeKeyEncrypted c $ remove dir,
hasKey = hasKeyEncrypted c $ checkPresent dir,
hasKeyCheap = True,
config = Nothing
}
@ -72,25 +74,43 @@ dirKey d k = d </> hashDirMixed k </> f </> f
where
f = keyFile k
store :: FilePath -> Key -> Annex Bool
store d k = do
store :: FilePath -> Key -> Maybe (Cipher, Key) -> Annex Bool
store d k c = do
g <- Annex.gitRepo
let src = gitAnnexLocation g k
let src = gitAnnexLocation g k
liftIO $ catch (copy src) (const $ return False)
where
dest = dirKey d k
dir = parentDir dest
copy src = do
copy src = case c of
Just (cipher, enckey) -> do
content <- L.readFile src
let dest = dirKey d enckey
prep dest
withEncryptedContent cipher content $ \s -> do
L.writeFile dest s
cleanup True dest
_ -> do
let dest = dirKey d k
prep dest
ok <- copyFile src dest
cleanup ok dest
prep dest = liftIO $ do
let dir = parentDir dest
createDirectoryIfMissing True dir
allowWrite dir
ok <- copyFile src dest
cleanup ok dest = do
when ok $ do
let dir = parentDir dest
preventWrite dest
preventWrite dir
return ok
retrieve :: FilePath -> Key -> FilePath -> Annex Bool
retrieve d k f = liftIO $ copyFile (dirKey d k) f
retrieve :: FilePath -> Key -> FilePath -> Maybe (Cipher, Key) -> Annex Bool
retrieve d k f Nothing = liftIO $ copyFile (dirKey d k) f
retrieve d k f (Just (cipher, enckey)) =
liftIO $ flip catch (const $ return False) $ do
content <- L.readFile (dirKey d enckey)
withDecryptedContent cipher content $ L.writeFile f
return True
remove :: FilePath -> Key -> Annex Bool
remove d k = liftIO $ catch del (const $ return False)

View file

@ -13,6 +13,8 @@ import Control.Monad.State (liftIO)
import Types
import RemoteClass
import Crypto
import qualified Annex
import Messages
{- Encryption setup for a remote. The user must specify whether to use
- an encryption key, or not encrypt. An encrypted cipher is created, or is
@ -29,3 +31,44 @@ encryptionSetup c =
use a = do
cipher <- liftIO a
return $ M.delete "encryption" $ storeCipher c cipher
{- Helpers that can be applied to a Remote's normal actions to
- add crypto support. -}
storeKeyEncrypted :: Maybe RemoteConfig -> (Key -> Maybe (Cipher, Key) -> Annex a) -> Key -> Annex a
storeKeyEncrypted c a k = a k =<< cipherKey c k
retrieveKeyFileEncrypted :: Maybe RemoteConfig -> (Key -> FilePath -> Maybe (Cipher, Key) -> Annex a) -> Key -> FilePath -> Annex a
retrieveKeyFileEncrypted c a k f = a k f =<< cipherKey c k
removeKeyEncrypted :: Maybe RemoteConfig -> (Key -> Annex a) -> Key -> Annex a
removeKeyEncrypted = withEncryptedKey
hasKeyEncrypted :: Maybe RemoteConfig -> (Key -> Annex a) -> Key -> Annex a
hasKeyEncrypted = withEncryptedKey
{- Gets encryption Cipher, and encrypted version of Key.
-
- The decrypted Cipher is cached in the Annex state. -}
cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
cipherKey Nothing _ = return Nothing
cipherKey (Just c) k = do
cache <- Annex.getState Annex.cipher
case cache of
Just cipher -> ret cipher
Nothing -> case extractCipher c of
Nothing -> return Nothing
Just encipher -> do
showNote "getting encryption key"
cipher <- liftIO $ decryptCipher c encipher
Annex.changeState (\s -> s { Annex.cipher = Just cipher })
ret cipher
where
ret cipher = do
k' <- liftIO $ encryptKey cipher k
return $ Just (cipher, k')
{- Passes the encrypted version of the key to the action when encryption
- is enabled, and the non-encrypted version otherwise. -}
withEncryptedKey :: Maybe RemoteConfig -> (Key -> Annex a) -> Key -> Annex a
withEncryptedKey c a k = do
v <- cipherKey c k
case v of
Nothing -> a k
Just (_, k') -> a k'