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.
This commit is contained in:
Joey Hess 2011-04-16 13:25:27 -04:00
parent 480d780297
commit 7fdf20f577
4 changed files with 120 additions and 51 deletions

116
Crypto.hs
View file

@ -1,4 +1,7 @@
{- git-annex crypto
-
- Currently using gpg; could later be modified to support different
- crypto backends if neccessary.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
@ -18,71 +21,91 @@ module Crypto (
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M
import System.IO
import qualified Codec.Binary.Base64 as B64
import System.Cmd.Utils
import Data.String.Utils
import Data.List
import Data.Bits.Utils
import Types
import RemoteClass
import Utility
data Cipher = Cipher String -- XXX ideally, this would be a locked memory region
data EncryptedCipher = EncryptedCipher String
deriving Show
data EncryptedCipher = EncryptedCipher String KeyIds
data KeyIds = KeyIds [String]
instance Show KeyIds where
show (KeyIds ks) = join "," ks
instance Read KeyIds where
readsPrec _ s = [(KeyIds (split "," s), "")]
{- Creates a new Cipher, encrypted as specified in the remote's configuration -}
genCipher :: RemoteConfig -> IO EncryptedCipher
genCipher config = do
genCipher c = do
ks <- configKeyIds c
random <- genrandom
encryptCipher config $ Cipher random
encryptCipher (Cipher random) ks
where
genrandom = gpgPipeRead
[ Params "--armor --gen-random"
[ Params "--gen-random"
, Param $ show randomquality
, Param $ show ciphersize
]
randomquality = 1 -- 1 is /dev/urandom; 2 is /dev/random
ciphersize = 1024
randomquality = 1 :: Int -- 1 is /dev/urandom; 2 is /dev/random
ciphersize = 1024 :: Int
{- Updates an existing Cipher, re-encrypting it as specified in the
- remote's configuration -}
{- Updates an existing Cipher, re-encrypting it to add KeyIds specified in
- the remote's configuration. -}
updateCipher :: RemoteConfig -> EncryptedCipher -> IO EncryptedCipher
updateCipher config encipher = do
cipher <- decryptCipher config encipher
encryptCipher config cipher
updateCipher c encipher@(EncryptedCipher _ ks) = do
ks' <- configKeyIds c
cipher <- decryptCipher c encipher
encryptCipher cipher (combine ks ks')
where
combine (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
{- Stores an EncryptedCipher in a remote's configuration. -}
storeCipher :: RemoteConfig -> EncryptedCipher -> RemoteConfig
storeCipher config (EncryptedCipher c) = M.insert "cipher" c config
storeCipher c (EncryptedCipher t ks) =
M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (show ks) c
where
toB64 = B64.encode . s2w8
{- Extracts an EncryptedCipher from a remote's configuration. -}
extractCipher :: RemoteConfig -> EncryptedCipher
extractCipher config = case M.lookup "cipher" config of
Just c -> EncryptedCipher c
Nothing -> error "missing cipher in remote config"
{- Encryptes a Cipher as specified by a remote's configuration. -}
encryptCipher :: RemoteConfig -> Cipher -> IO EncryptedCipher
encryptCipher config (Cipher c) = do
encipher <- gpgPipeBoth (encrypt++recipient) c
return $ EncryptedCipher encipher
extractCipher :: RemoteConfig -> Maybe EncryptedCipher
extractCipher c =
case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of
(Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (read ks)
_ -> Nothing
where
encrypt =
[ Params "--encrypt --armor"
, Params "--trust-model always"
]
recipient = case M.lookup "encryption" config of
Nothing -> [ Param "--default-recipient-self" ]
Just r ->
fromB64 s = case B64.decode s of
Nothing -> error "bad base64 encoded cipher in remote config"
Just ws -> w82s ws
{- Encrypts a Cipher to the specified KeyIds. -}
encryptCipher :: Cipher -> KeyIds -> IO EncryptedCipher
encryptCipher (Cipher c) (KeyIds ks) = do
let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
encipher <- gpgPipeBoth (encrypt++recipients ks') c
return $ EncryptedCipher encipher (KeyIds ks')
where
encrypt = [ Params "--encrypt" ]
recipients l =
-- Force gpg to only encrypt to the specified
-- recipients, not configured defaults.
[ Params "--no-encrypt-to --no-default-recipient"
, Param "--recipient"
, Param r
]
[ Params "--no-encrypt-to --no-default-recipient"] ++
(concat $ map (\k -> [Param "--recipient", Param k]) l)
{- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
decryptCipher :: RemoteConfig -> EncryptedCipher -> IO Cipher
decryptCipher = error "TODO"
decryptCipher _ (EncryptedCipher encipher _) =
return . Cipher =<< gpgPipeBoth decrypt encipher
where
decrypt = [ Params "--decrypt" ]
{- Genetates an encrypted form of a Key. The enctyption does not need to be
- reversable, nor does it need to be the same type of encryption used
@ -100,7 +123,10 @@ decryptContent = error "TODO"
gpgParams :: [CommandParam] -> [String]
gpgParams params = ["--batch", "--quiet"] ++ toCommand params
gpgParams params =
-- avoid console IO, and be quiet, even about checking the trustdb
["--batch", "--quiet", "--trust-model", "always"] ++
toCommand params
gpgPipeRead :: [CommandParam] -> IO String
gpgPipeRead params = pOpen ReadFromPipe "gpg" (gpgParams params) hGetContentsStrict
@ -109,3 +135,19 @@ gpgPipeBoth :: [CommandParam] -> String -> IO String
gpgPipeBoth params input = do
(_, s) <- pipeBoth "gpg" (gpgParams params) input
return s
configKeyIds :: RemoteConfig -> IO KeyIds
configKeyIds c = do
let k = configGet c "encryption"
s <- gpgPipeRead [Params "--with-colons --list-public-keys", Param k]
return $ KeyIds $ parseWithColons s
where
parseWithColons s = map keyIdField $ filter pubKey $ lines s
pubKey = isPrefixOf "pub:"
keyIdField s = (split ":" s) !! 4
configGet :: RemoteConfig -> String -> String
configGet c key =
case M.lookup key c of
Just v -> v
Nothing -> error $ "missing " ++ key ++ " in remote config"

View file

@ -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 =

31
Remote/Encrypted.hs Normal file
View file

@ -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

View file

@ -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