diff options
author | Joey Hess <joey@kitenet.net> | 2011-04-16 13:25:27 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-04-16 13:25:27 -0400 |
commit | 7fdf20f577f63f8437c63d7d83e70d34de89269f (patch) | |
tree | 48ead5b187d7167d41c52cb83c917f9aaa85ed86 /Remote | |
parent | 480d780297dac12576a90c25cca5cb989e1a1e4f (diff) |
encryption key management working
Encrypted remotes don't yet encrypt data, but git annex initremote can
be used to generate a cipher and add additional gpg keys that can use it.
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 12 | ||||
-rw-r--r-- | Remote/Encrypted.hs | 31 | ||||
-rw-r--r-- | Remote/S3real.hs | 8 |
3 files changed, 39 insertions, 12 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 66c78970c..b4403bb03 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -26,8 +26,9 @@ import Locations import Config import Utility import Messages -import Remote.Special import Ssh +import Remote.Special +import Remote.Encrypted type BupRepo = String @@ -66,10 +67,7 @@ bupSetup u c = do let buprepo = case M.lookup "buprepo" c of Nothing -> error "Specify buprepo=" Just r -> r - case M.lookup "encryption" c of - Nothing -> error "Specify encryption=key or encryption=none" - Just "none" -> return () - Just _ -> error "encryption keys not yet supported" + c' <- encryptionSetup c -- bup init will create the repository. -- (If the repository already exists, bup init again appears safe.) @@ -81,9 +79,9 @@ bupSetup u c = do -- The buprepo is stored in git config, as well as this repo's -- persistant state, so it can vary between hosts. - gitConfigSpecialRemote u c "buprepo" buprepo + gitConfigSpecialRemote u c' "buprepo" buprepo - return $ M.delete "directory" c + return c' bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam] bupParams command buprepo params = diff --git a/Remote/Encrypted.hs b/Remote/Encrypted.hs new file mode 100644 index 000000000..ae4044620 --- /dev/null +++ b/Remote/Encrypted.hs @@ -0,0 +1,31 @@ +{- common functions for encrypted remotes + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.Encrypted where + +import qualified Data.Map as M +import Control.Monad.State (liftIO) + +import Types +import RemoteClass +import Crypto + +{- 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 + - updated to be accessible to an additional encryption key. -} +encryptionSetup :: RemoteConfig -> Annex RemoteConfig +encryptionSetup c = + case (M.lookup "encryption" c, extractCipher c) of + (Nothing, Nothing) -> error "Specify encryption=key or encryption=none" + (Just "none", _) -> return c + (Nothing, Just _) -> return c + (Just _, Nothing) -> use $ genCipher c + (Just _, Just v) -> use $ updateCipher c v + where + use a = do + cipher <- liftIO a + return $ M.delete "encryption" $ storeCipher c cipher diff --git a/Remote/S3real.hs b/Remote/S3real.hs index af4e48048..0f6327f57 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -28,6 +28,7 @@ import Messages import Locations import Config import Remote.Special +import Remote.Encrypted remote :: RemoteType Annex remote = RemoteType { @@ -81,11 +82,8 @@ s3Connection c = do s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig s3Setup u c = do -- verify configuration is sane - case M.lookup "encryption" c of - Nothing -> error "Specify encryption=key or encryption=none" - Just "none" -> return () - Just _ -> error "encryption keys not yet supported" - let fullconfig = M.union c defaults + c' <- encryptionSetup c + let fullconfig = M.union c' defaults -- check bucket location to see if the bucket exists, and create it let datacenter = fromJust $ M.lookup "datacenter" fullconfig |