diff options
| -rw-r--r-- | Creds.hs | 2 | ||||
| -rw-r--r-- | Crypto.hs | 76 | ||||
| -rw-r--r-- | Remote/Bup.hs | 2 | ||||
| -rw-r--r-- | Remote/Directory.hs | 4 | ||||
| -rw-r--r-- | Remote/Glacier.hs | 2 | ||||
| -rw-r--r-- | Remote/Helper/Encryptable.hs | 64 | ||||
| -rw-r--r-- | Remote/Hook.hs | 4 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 4 | ||||
| -rw-r--r-- | Remote/S3.hs | 2 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 2 | ||||
| -rw-r--r-- | Test.hs | 52 | ||||
| -rw-r--r-- | Types/Crypto.hs | 10 | ||||
| -rw-r--r-- | Utility/Gpg.hs | 124 | ||||
| -rw-r--r-- | Utility/Gpg/Types.hs | 30 | ||||
| -rw-r--r-- | debian/copyright | 4 | ||||
| -rw-r--r-- | doc/encryption.mdwn | 44 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 21 |
17 files changed, 307 insertions, 140 deletions
@@ -52,7 +52,7 @@ setRemoteCredPair c storage = go =<< getRemoteCredPair c storage return c storeconfig creds key (Just cipher) = do - s <- liftIO $ encrypt (GpgOpts []) cipher + s <- liftIO $ encrypt [] cipher (feedBytes $ L.pack $ encodeCredPair creds) (readBytes $ return . L.unpack) return $ M.insert key (toB64 s) c @@ -23,8 +23,7 @@ module Crypto ( readBytes, encrypt, decrypt, - GpgOpts(..), - getGpgOpts, + Gpg.getGpgEncParams, prop_HmacSha1WithCipher_sane ) where @@ -35,7 +34,6 @@ import Control.Applicative import Common.Annex import qualified Utility.Gpg as Gpg -import Utility.Gpg.Types import Types.Key import Types.Crypto @@ -66,12 +64,17 @@ cipherPassphrase (Cipher c) = drop cipherBeginning c cipherMac :: Cipher -> String cipherMac (Cipher c) = take cipherBeginning c -{- Creates a new Cipher, encrypted to the specified key id. -} -genEncryptedCipher :: String -> Bool -> IO StorableCipher -genEncryptedCipher keyid highQuality = do +{- Creates a new Cipher, encrypted to the specified key id. If the + - boolean 'symmetric' is true, use that cipher not only for MAC'ing, + - but also to symmetrically encrypt annexed file contents. Otherwise, + - we don't bother to generate so much random data. -} +genEncryptedCipher :: String -> Bool -> Bool -> IO StorableCipher +genEncryptedCipher keyid symmetric highQuality = do ks <- Gpg.findPubKeys keyid - random <- Gpg.genRandom highQuality cipherSize - encryptCipher (Cipher random) ks + random <- Gpg.genRandom highQuality size + encryptCipher (Cipher random) symmetric ks + where + size = if symmetric then cipherSize else cipherBeginning {- Creates a new, shared Cipher. -} genSharedCipher :: Bool -> IO StorableCipher @@ -83,44 +86,45 @@ genSharedCipher highQuality = updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher updateEncryptedCipher _ SharedCipher{} = undefined updateEncryptedCipher [] encipher = return encipher -updateEncryptedCipher newkeys encipher@(EncryptedCipher _ (KeyIds ks)) = do +updateEncryptedCipher newkeys encipher@(EncryptedCipher _ symmetric (KeyIds ks)) = do dropKeys <- listKeyIds [ k | (False, k) <- newkeys ] forM_ dropKeys $ \k -> unless (k `elem` ks) $ error $ "Key " ++ k ++ " is not granted access." addKeys <- listKeyIds [ k | (True, k) <- newkeys ] let ks' = (addKeys ++ ks) \\ dropKeys - when (null ks') $ error "The new access list would become empty." + when (null ks') $ error "That would empty the access list." cipher <- decryptCipher encipher - encryptCipher cipher $ KeyIds ks' + encryptCipher cipher symmetric $ KeyIds ks' where listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat describeCipher :: StorableCipher -> String -describeCipher (SharedCipher _) = "shared cipher" -describeCipher (EncryptedCipher _ (KeyIds ks)) = - "with gpg " ++ keys ks ++ " " ++ unwords ks +describeCipher SharedCipher{} = "shared cipher" +describeCipher (EncryptedCipher _ symmetric (KeyIds ks)) = + scheme ++ " with gpg " ++ keys ks ++ " " ++ unwords ks where + scheme = if symmetric then "hybrid cipher" else "pubkey crypto" keys [_] = "key" keys _ = "keys" -{- Encrypts a Cipher to the specified KeyIds. -} -encryptCipher :: Cipher -> KeyIds -> IO StorableCipher -encryptCipher (Cipher c) (KeyIds ks) = do +{- Encrypts a Cipher to the specified KeyIds. The boolean indicates + - whether to encrypt an hybrid cipher (True), which is going to be used + - both for MAC'ing and symmetric encryption of file contents, or for + - MAC'ing only (False), while pubkey crypto is used for file contents. + - -} +encryptCipher :: Cipher -> Bool -> KeyIds -> IO StorableCipher +encryptCipher (Cipher c) symmetric (KeyIds ks) = do -- gpg complains about duplicate recipient keyids let ks' = nub $ sort ks - encipher <- Gpg.pipeStrict (Params "--encrypt" : recipients ks') c - return $ EncryptedCipher encipher (KeyIds ks') - where - recipients l = force_recipients : - concatMap (\k -> [Param "--recipient", Param k]) l - -- Force gpg to only encrypt to the specified - -- recipients, not configured defaults. - force_recipients = Params "--no-encrypt-to --no-default-recipient" + -- The cipher itself is always encrypted to the given public keys + let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False + encipher <- Gpg.pipeStrict params c + return $ EncryptedCipher encipher symmetric (KeyIds ks') {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -} decryptCipher :: StorableCipher -> IO Cipher decryptCipher (SharedCipher t) = return $ Cipher t -decryptCipher (EncryptedCipher t _) = +decryptCipher (EncryptedCipher t _ _) = Cipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t {- Generates an encrypted form of a Key. The encryption does not need to be @@ -146,15 +150,21 @@ feedBytes = flip L.hPut readBytes :: (L.ByteString -> IO a) -> Reader a readBytes a h = L.hGetContents h >>= a -{- Runs a Feeder action, that generates content that is symmetrically encrypted - - with the Cipher using the given GnuPG options, and then read by the Reader - - action. -} -encrypt :: GpgOpts -> Cipher -> Feeder -> Reader a -> IO a -encrypt opts = Gpg.feedRead ( Params "--symmetric --force-mdc" : toParams opts ) - . cipherPassphrase +{- Runs a Feeder action, that generates content that is symmetrically + - encrypted with the Cipher (unless it is empty, in which case + - public-key encryption is used) using the given gpg options, and then + - read by the Reader action. Note: For public-key encryption, + - recipients MUST be included in 'params' (for instance using + - 'getGpgEncOpts'). -} +encrypt :: [CommandParam] -> Cipher -> Feeder -> Reader a -> IO a +encrypt params cipher = Gpg.feedRead params' pass + where + pass = cipherPassphrase cipher + params' = params ++ Gpg.stdEncryptionParams (not $ null pass) {- Runs a Feeder action, that generates content that is decrypted with the - - Cipher, and read by the Reader action. -} + - Cipher (or using a private key if the Cipher is empty), and read by the + - Reader action. -} decrypt :: Cipher -> Feeder -> Reader a -> IO a decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 9b3675cfa..9ef335218 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -133,7 +133,7 @@ storeEncrypted r buprepo (cipher, enck) k _p = sendAnnex k (rollback enck buprepo) $ \src -> do params <- bupSplitParams r buprepo enck [] liftIO $ catchBoolIO $ - encrypt (getGpgOpts r) cipher (feedFile src) $ \h -> + encrypt (getGpgEncParams r) cipher (feedFile src) $ \h -> pipeBup params (Just h) Nothing retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 6cc75d2f1..0b3ce443b 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -41,7 +41,7 @@ gen r u c gc = do cst <- remoteCost gc cheapRemoteCost let chunksize = chunkSize c return $ encryptableRemote c - (storeEncrypted dir (getGpgOpts gc) chunksize) + (storeEncrypted dir (getGpgEncParams (c,gc)) chunksize) (retrieveEncrypted dir chunksize) Remote { uuid = u, @@ -129,7 +129,7 @@ store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src -> storeSplit meterupdate chunksize dests =<< L.readFile src -storeEncrypted :: FilePath -> GpgOpts -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: FilePath -> [CommandParam] -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted d gpgOpts chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src -> metered (Just p) k $ \meterupdate -> storeHelper d chunksize enck k $ \dests -> diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index c1a53347d..d81066415 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -95,7 +95,7 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do metered (Just p) k $ \meterupdate -> storeHelper r enck $ \h -> - encrypt (getGpgOpts r) cipher (feedFile src) + encrypt (getGpgEncParams r) cipher (feedFile src) (readBytes $ meteredWrite meterupdate h) retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 63efcb378..2f72fb417 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -29,34 +29,46 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c encryption = M.lookup "encryption" c -- Generate a new cipher, depending on the chosen encryption scheme genCipher = case encryption of + _ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange Just "none" -> return c Just "shared" -> use "encryption setup" . genSharedCipher =<< highRandomQuality -- hybrid encryption by default _ | maybe True (== "hybrid") encryption -> - use "encryption setup" . genEncryptedCipher key + use "encryption setup" . genEncryptedCipher key True =<< highRandomQuality - _ -> error "Specify encryption=none or encryption=shared or encryption=hybrid (default)." + Just "pubkey" -> use "encryption setup" . genEncryptedCipher key False + =<< highRandomQuality + _ -> error $ "Specify " ++ intercalate " or " + (map ("encryption=" ++) + ["none","shared","hybrid (default)","pubkey"]) + ++ "." key = fromMaybe (error "Specifiy keyid=...") $ M.lookup "keyid" c newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++ maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c) + cannotchange = error "Cannot set encryption type of existing remotes." -- Update an existing cipher if possible. - updateCipher v - | isJust encryption = error "Cannot set encryption type of existing remote." - | otherwise = case v of - SharedCipher{} -> return c - EncryptedCipher{} -> - use "encryption update" $ updateEncryptedCipher newkeys v + updateCipher v = case v of + SharedCipher{} | maybe True (== "shared") encryption -> return c' + EncryptedCipher _ symmetric _ + | maybe True (== if symmetric then "hybrid" else "pubkey") + encryption -> + use "encryption update" $ updateEncryptedCipher newkeys v + _ -> cannotchange use m a = do showNote m cipher <- liftIO a showNote $ describeCipher cipher - return $ flip storeCipher cipher $ foldr M.delete c - [ "keyid", "keyid+", "keyid-" - , "encryption", "highRandomQuality" ] + return $ storeCipher c' cipher highRandomQuality = (&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c) <$> fmap not (Annex.getState Annex.fast) + c' = foldr M.delete c + -- git-annex used to remove 'encryption' as well, since + -- it was redundant; we now need to keep it for + -- public-key incryption, hence we leave it on newer + -- remotes (while being backward-compatible). + [ "keyid", "keyid+", "keyid-", "highRandomQuality" ] {- Modifies a Remote to support encryption. - @@ -121,27 +133,39 @@ embedCreds c | isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True | otherwise = False -{- Gets encryption Cipher, and encrypted version of Key. -} +{- Gets encryption Cipher, and encrypted version of Key. In case we want + - asymmetric encryption, leave the first empty, but encrypt the Key + - regardless. (Empty ciphers imply asymmetric encryption.) We could + - also check how long is the cipher (MAC'ing-only ciphers are shorter), + - but we don't want to rely on that only. -} cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key)) -cipherKey c k = maybe Nothing make <$> remoteCipher c +cipherKey c k = fmap make <$> remoteCipher c where - make ciphertext = Just (ciphertext, encryptKey mac ciphertext k) + make ciphertext = (cipContent ciphertext, encryptKey mac ciphertext k) + cipContent + | M.lookup "encryption" c /= Just "pubkey" = id + | otherwise = const $ Cipher "" mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac {- Stores an StorableCipher in a remote's configuration. -} storeCipher :: RemoteConfig -> StorableCipher -> RemoteConfig storeCipher c (SharedCipher t) = M.insert "cipher" (toB64 t) c -storeCipher c (EncryptedCipher t ks) = +storeCipher c (EncryptedCipher t _ ks) = M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c where showkeys (KeyIds l) = intercalate "," l {- Extracts an StorableCipher from a remote's configuration. -} extractCipher :: RemoteConfig -> Maybe StorableCipher -extractCipher c = - case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of - (Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (readkeys ks) - (Just t, Nothing) -> Just $ SharedCipher (fromB64 t) - _ -> Nothing +extractCipher c = case (M.lookup "cipher" c, + M.lookup "cipherkeys" c, + M.lookup "encryption" c) of + (Just t, Just ks, encryption) | maybe True (== "hybrid") encryption -> + Just $ EncryptedCipher (fromB64 t) True (readkeys ks) + (Just t, Just ks, Just "pubkey") -> + Just $ EncryptedCipher (fromB64 t) False (readkeys ks) + (Just t, Nothing, encryption) | maybe True (== "shared") encryption -> + Just $ SharedCipher (fromB64 t) + _ -> Nothing where readkeys = KeyIds . split "," diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 03f182a16..338d95ce7 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -38,7 +38,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote gen r u c gc = do cst <- remoteCost gc expensiveRemoteCost return $ encryptableRemote c - (storeEncrypted hooktype $ getGpgOpts gc) + (storeEncrypted hooktype $ getGpgEncParams (c,gc)) (retrieveEncrypted hooktype) Remote { uuid = u, @@ -118,7 +118,7 @@ store :: HookName -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store h k _f _p = sendAnnex k (void $ remove h k) $ \src -> runHook h "store" k (Just src) $ return True -storeEncrypted :: HookName -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: HookName -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp -> sendAnnex k (void $ remove h enck) $ \src -> do liftIO $ encrypt gpgOpts cipher (feedFile src) $ diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index a8efd84e7..4ad0fdadd 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -55,7 +55,7 @@ gen r u c gc = do let o = RsyncOpts url (transport ++ opts) escape islocal = rsyncUrlIsPath $ rsyncUrl o return $ encryptableRemote c - (storeEncrypted o $ getGpgOpts gc) + (storeEncrypted o $ getGpgEncParams (c,gc)) (retrieveEncrypted o) Remote { uuid = u @@ -137,7 +137,7 @@ rsyncUrls o k = map use annexHashes store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False -storeEncrypted :: RsyncOpts -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: RsyncOpts -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp -> sendAnnex k (void $ remove o enck) $ \src -> do liftIO $ encrypt gpgOpts cipher (feedFile src) $ diff --git a/Remote/S3.hs b/Remote/S3.hs index 582bc2fda..ce5a1c2eb 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -129,7 +129,7 @@ storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> sendAnnex k (void $ remove' r enck) $ \src -> do - liftIO $ encrypt (getGpgOpts r) cipher (feedFile src) $ + liftIO $ encrypt (getGpgEncOpts r) cipher (feedFile src) $ readBytes $ L.writeFile tmp s3Bool =<< storeHelper (conn, bucket) r enck p tmp diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 52fc32b3a..4c3bb5c49 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -94,7 +94,7 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate -> davAction r False $ \(baseurl, user, pass) -> sendAnnex k (void $ remove r enck) $ \src -> - liftIO $ encrypt (getGpgOpts r) cipher + liftIO $ encrypt (getGpgEncOpts r) cipher (streamMeteredFile src meterupdate) $ readBytes $ storeHelper r enck baseurl user pass @@ -29,6 +29,7 @@ import qualified Backend import qualified Git.CurrentRepo import qualified Git.Filename import qualified Locations +import qualified Types.Crypto import qualified Types.KeySource import qualified Types.Backend import qualified Types.TrustLevel @@ -40,6 +41,7 @@ import qualified Logs.Unused import qualified Logs.Transfer import qualified Logs.Presence import qualified Remote +import qualified Remote.Helper.Encryptable import qualified Types.Key import qualified Types.Messages import qualified Config @@ -872,18 +874,21 @@ test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build. -- gpg is not a build dependency, so only test when it's available test_crypto :: TestEnv -> Test -test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do +test_crypto env = "git-annex crypto" ~: TestList $ flip map ["shared","hybrid","pubkey"] $ + \scheme -> TestCase $ intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do #ifndef mingw32_HOST_OS Utility.Gpg.testTestHarness @? "test harness self-test failed" Utility.Gpg.testHarness $ do createDirectory "dir" - let a cmd = git_annex env cmd + let a cmd = git_annex env cmd $ [ "foo" , "type=directory" - , "keyid=" ++ Utility.Gpg.testKeyId + , "encryption=" ++ scheme , "directory=dir" , "highRandomQuality=false" - ] + ] ++ if scheme `elem` ["hybrid","pubkey"] + then ["keyid=" ++ Utility.Gpg.testKeyId] + else [] a "initremote" @? "initremote failed" not <$> a "initremote" @? "initremote failed to fail when run twice in a row" a "enableremote" @? "enableremote failed" @@ -891,6 +896,16 @@ test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path git_annex env "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" + (c,k) <- annexeval $ do + uuid <- Remote.nameToUUID "foo" + rs <- Logs.Remote.readRemoteLog + Just (k,_) <- Backend.lookupFile annexedfile + return (fromJust $ M.lookup uuid rs, k) + let key = if scheme `elem` ["hybrid","pubkey"] + then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] + else Nothing + testEncryptedRemote scheme key c [k] @? "invalid crypto setup" + annexed_present annexedfile git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile @@ -898,8 +913,35 @@ test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path annexed_present annexedfile not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile + where + {- Ensure the configuration complies with the encryption scheme, and + - that all keys are encrypted properly on the given directory remote. -} + testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher c of + Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks -> + checkKeys cip True + Just cip@(Crypto.EncryptedCipher encipher sym ks') + | checkScheme sym && keysMatch ks' -> + checkKeys cip sym <&&> checkCipher encipher ks' + _ -> return False + where + keysMatch (Utility.Gpg.KeyIds ks') = + maybe False (\(Utility.Gpg.KeyIds ks2) -> + sort (nub ks2) == sort (nub ks')) ks + checkCipher encipher = Utility.Gpg.checkEncryptionStream encipher . Just + checkScheme True = scheme == "hybrid" + checkScheme False = scheme == "pubkey" + checkKeys cip sym = do + cipher <- Crypto.decryptCipher cip + files <- filterM doesFileExist $ + map ("dir" </>) $ concatMap (key2files cipher) keys + return (not $ null files) <&&> allM (checkFile sym) files + checkFile sym filename = + Utility.Gpg.checkEncryptionFile filename $ + if sym then Nothing else ks + key2files cipher = Locations.keyPaths . + Crypto.encryptKey Types.Crypto.HmacSha1 cipher #else - putStrLn "gpg testing not implemented on Windows" + putStrLn "gpg testing not implemented on Windows" #endif -- This is equivilant to running git-annex, but it's all run in-process diff --git a/Types/Crypto.hs b/Types/Crypto.hs index e97d02ba8..ee61d0863 100644 --- a/Types/Crypto.hs +++ b/Types/Crypto.hs @@ -24,7 +24,15 @@ import Utility.Gpg (KeyIds(..)) -- XXX ideally, this would be a locked memory region newtype Cipher = Cipher String -data StorableCipher = EncryptedCipher String KeyIds | SharedCipher String +data StorableCipher = EncryptedCipher String Bool KeyIds + -- ^ The Boolean indicates whether the cipher is used + -- both for symmetric encryption of file content and + -- MAC'ing of file names (True), or only for MAC'ing, + -- while file content is encrypted using public-key + -- crypto (False). In the latter case the cipher is + -- twice as short, but we don't want to rely on that + -- only. + | SharedCipher String deriving (Ord, Eq) {- File names are (client-side) MAC'ed on special remotes. diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 291b06e1c..5056e1ce2 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, FlexibleInstances #-} module Utility.Gpg where @@ -24,6 +24,10 @@ import Utility.Env import Utility.Tmp #endif +import qualified Data.Map as M +import Types.GitConfig +import Types.Remote hiding (setup) + newtype KeyIds = KeyIds { keyIds :: [String] } deriving (Ord, Eq) @@ -32,6 +36,28 @@ newtype KeyIds = KeyIds { keyIds :: [String] } gpgcmd :: FilePath gpgcmd = fromMaybe "gpg" SysConfig.gpg +{- Return some options suitable for GnuPG encryption, symmetric or not. -} +class LensGpgEncParams a where getGpgEncParams :: a -> [CommandParam] + +{- Extract the GnuPG options from a pair of a Remote Config and a Remote + - Git Config. If the remote is configured to use public-key encryption, + - look up the recipient keys and add them to the option list. -} +instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where + getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++ recipients + where + recipients = case M.lookup "encryption" c of + Just "pubkey" -> pkEncTo $ maybe [] (split ",") $ + M.lookup "cipherkeys" c + _ -> [] + +-- Generate an argument list to asymetrically encrypt to the given recipients. +pkEncTo :: [String] -> [CommandParam] +pkEncTo = concatMap (\r -> [Param "--recipient", Param r]) + +{- Extract the GnuPG options from a Remote. -} +instance LensGpgEncParams (RemoteA a) where + getGpgEncParams r = getGpgEncParams (config r, gitconfig r) + stdParams :: [CommandParam] -> IO [String] stdParams params = do #ifndef mingw32_HOST_OS @@ -48,9 +74,21 @@ stdParams params = do return $ defaults ++ toCommand params #endif where - -- be quiet, even about checking the trustdb + -- Be quiet, even about checking the trustdb. If the one of the + -- default param is already present in 'params', don't include it + -- twice in the output list. defaults = ["--quiet", "--trust-model", "always"] +{- Usual options for symmetric / public-key encryption. -} +stdEncryptionParams :: Bool -> [CommandParam] +stdEncryptionParams symmetric = [enc symmetric, Param "--force-mdc"] + where + enc True = Param "--symmetric" + -- Force gpg to only encrypt to the specified recipients, not + -- configured defaults. Recipients are assumed to be specified in + -- elsewhere. + enc False = Params "--encrypt --no-encrypt-to --no-default-recipient" + {- Runs gpg with some params and returns its stdout, strictly. -} readStrict :: [CommandParam] -> IO String readStrict params = do @@ -71,10 +109,11 @@ pipeStrict params input = do hClose to hGetContentsStrict from -{- Runs gpg with some parameters. First sends it a passphrase via - - --passphrase-fd. Then runs a feeder action that is passed a handle and - - should write to it all the data to input to gpg. Finally, runs - - a reader action that is passed a handle to gpg's output. +{- Runs gpg with some parameters. First sends it a passphrase (unless it + - is empty) via '--passphrase-fd'. Then runs a feeder action that is + - passed a handle and should write to it all the data to input to gpg. + - Finally, runs a reader action that is passed a handle to gpg's + - output. - - Runs gpg in batch mode; this is necessary to avoid gpg 2.x prompting for - the passphrase. @@ -82,27 +121,28 @@ pipeStrict params input = do - Note that to avoid deadlock with the cleanup stage, - the reader must fully consume gpg's input before returning. -} feedRead :: [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a -feedRead params passphrase feeder reader = do +feedRead params passphrase feeder reader = if null passphrase + then go =<< stdParams (Param "--batch" : params) + else do #ifndef mingw32_HOST_OS - -- pipe the passphrase into gpg on a fd - (frompipe, topipe) <- createPipe - void $ forkIO $ do - toh <- fdToHandle topipe - hPutStrLn toh passphrase - hClose toh - let Fd pfd = frompipe - let passphrasefd = [Param "--passphrase-fd", Param $ show pfd] + -- pipe the passphrase into gpg on a fd + (frompipe, topipe) <- createPipe + void $ forkIO $ do + toh <- fdToHandle topipe + hPutStrLn toh passphrase + hClose toh + let Fd pfd = frompipe + let passphrasefd = [Param "--passphrase-fd", Param $ show pfd] - params' <- stdParams $ [Param "--batch"] ++ passphrasefd ++ params - closeFd frompipe `after` go params' + params' <- stdParams $ Param "--batch" : passphrasefd ++ params + closeFd frompipe `after` go params' #else - -- store the passphrase in a temp file for gpg - withTmpFile "gpg" $ \tmpfile h -> do - hPutStr h passphrase - hClose h + -- store the passphrase in a temp file for gpg + withTmpFile "gpg" $ \tmpfile h -> do + hPutStr h passphrase + hClose h let passphrasefile = [Param "--passphrase-file", File tmpfile] - params' <- stdParams $ [Param "--batch"] ++ passphrasefile ++ params - go params' + go =<< stdParams $ Param "--batch" : passphrasefile ++ params #endif where go params' = withBothHandles createProcessSuccess (proc gpgcmd params') @@ -260,3 +300,41 @@ testTestHarness = do keys <- testHarness $ findPubKeys testKeyId return $ KeyIds [testKeyId] == keys #endif + +#ifndef mingw32_HOST_OS +checkEncryptionFile :: FilePath -> Maybe KeyIds -> IO Bool +checkEncryptionFile filename keys = + checkGpgPackets keys =<< readStrict params + where + params = [Params "--list-packets --list-only", File filename] + +checkEncryptionStream :: String -> Maybe KeyIds -> IO Bool +checkEncryptionStream stream keys = + checkGpgPackets keys =<< pipeStrict params stream + where + params = [Params "--list-packets --list-only"] + +{- Parses an OpenPGP packet list, and checks whether data is + - symmetrically encrypted (keys is Nothing), or encrypted to some + - public key(s). + - /!\ The key needs to be in the keyring! -} +checkGpgPackets :: Maybe KeyIds -> String -> IO Bool +checkGpgPackets keys str = do + let (asym,sym) = partition (pubkeyEncPacket `isPrefixOf`) $ + filter (\l' -> pubkeyEncPacket `isPrefixOf` l' || + symkeyEncPacket `isPrefixOf` l') $ + takeWhile (/= ":encrypted data packet:") $ + lines str + case (keys,asym,sym) of + (Nothing, [], [_]) -> return True + (Just (KeyIds ks), ls, []) -> do + -- Find the master key associated with the + -- encryption subkey. + ks' <- concat <$> mapM (findPubKeys >=*> keyIds) + [ k | k:"keyid":_ <- map (reverse . words) ls ] + return $ sort (nub ks) == sort (nub ks') + _ -> return False + where + pubkeyEncPacket = ":pubkey enc packet: " + symkeyEncPacket = ":symkey enc packet: " +#endif diff --git a/Utility/Gpg/Types.hs b/Utility/Gpg/Types.hs deleted file mode 100644 index d45707207..000000000 --- a/Utility/Gpg/Types.hs +++ /dev/null @@ -1,30 +0,0 @@ -{- gpg data types - - - - Copyright 2013 guilhem <guilhem@fripost.org> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Utility.Gpg.Types where - -import Utility.SafeCommand -import Types.GitConfig -import Types.Remote - -{- GnuPG options. -} -type GpgOpt = String -newtype GpgOpts = GpgOpts [GpgOpt] - -toParams :: GpgOpts -> [CommandParam] -toParams (GpgOpts opts) = map Param opts - -class LensGpgOpts a where - getGpgOpts :: a -> GpgOpts - -{- Extract the GnuPG options from a Remote Git Config. -} -instance LensGpgOpts RemoteGitConfig where - getGpgOpts = GpgOpts . remoteAnnexGnupgOptions - -{- Extract the GnuPG options from a Remote. -} -instance LensGpgOpts (RemoteA a) where - getGpgOpts = getGpgOpts . gitconfig diff --git a/debian/copyright b/debian/copyright index 5a667adf7..e91cddbb5 100644 --- a/debian/copyright +++ b/debian/copyright @@ -14,10 +14,6 @@ Copyright: 2011 Bas van Dijk & Roel van Dijk 2012 Joey Hess <joey@kitenet.net> License: GPL-3+ -Files: Utility/Gpg/Types.hs -Copyright: 2013 guilhem <guilhem@fripost.org> -License: GPL-3+ - Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/* Copyright: 2007 Henrik Nyh <http://henrik.nyh.se/> 2010 Joey Hess <joey@kitenet.net> diff --git a/doc/encryption.mdwn b/doc/encryption.mdwn index 6463827af..2069ee3bb 100644 --- a/doc/encryption.mdwn +++ b/doc/encryption.mdwn @@ -6,21 +6,23 @@ Encryption is needed when using [[special_remotes]] like Amazon S3, where file content is sent to an untrusted party who does not have access to the git repository. -Such an encrypted remote uses strong -[[symmetric_encryptiondesign/encryption]] on the contents of files, as -well as HMAC hashing of the filenames. The size of the encrypted files, -and access patterns of the data, should be the only clues to what is -stored in such a remote. +Such an encrypted remote uses strong ([[symmetric|design/encryption]] or +asymmetric) encryption on the contents of files, as well as HMAC hashing +of the filenames. The size of the encrypted files, and access patterns +of the data, should be the only clues to what is stored in such a +remote. You should decide whether to use encryption with a special remote before any data is stored in it. So, `git annex initremote` requires you to specify "encryption=none" when first setting up a remote in order to disable encryption. -If you want to use encryption, run `git annex initremote` with -"encryption=USERID". The value will be passed to `gpg` to find encryption keys. -Typically, you will say "encryption=2512E3C7" to use a specific gpg key. -Or, you might say "encryption=joey@kitenet.net" to search for matching keys. +If you want to generate a cipher that will be used to symmetrically +encrypt file contents, run `git annex initremote` with +"encryption=hybrid keyid=USERID". The value will be passed to `gpg` to +find encryption keys. Typically, you will say "keyid=2512E3C7" to use a +specific gpg key. Or, you might say "keyid=joey@kitenet.net" to search +for matching keys. The default MAC algorithm to be applied on the filenames is HMACSHA1. A stronger one, for instance HMACSHA512, one can be chosen upon creation @@ -61,3 +63,27 @@ stored in the special remote. To use shared encryption, specify "encryption=shared" when first setting up a special remote. + +## strict public-key encryption + +Special remotes can also be configured to encrypt file contents using +public-key cryptography. It is significatly slower than symmetric +encryption, but is also generally considered more secure. Note that +because filenames are MAC'ed, a cipher needs to be generated (and +encrypted to the given key ID). + +A disavantage is that is not possible to give/revoke anyone's access to +a non-empty remote. Indeed, although the parameters `keyid+=` and +`keyid-=` still apply, they have **no effect** on files that are already +present on the remote. In fact the only sound use of `keyid+=` and +`keyid-=` is probably, as `keyid-=` for "encryption=hybrid", to replace +a (sub-)key by another. + +Also, since already uploaded files are not re-encrypted, one needs to +keep the private part of removed keys (with `keyid-=`) to be able to +decrypt these files. On the other hand, if the reason for revocation is +that the key has been compromised, it is **insecure** to leave files +encrypted using that old key, and the user should re-encrypt everything. + +To use strict public-key encryption, specify "encryption=pubkey +keyid=USERID" when first setting up a special remote. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 832a3cd68..fa74f77d7 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -308,9 +308,15 @@ subdirectories). command will prompt for parameters as needed. All special remotes support encryption. You must either specify - encryption=none to disable encryption, or use encryption=keyid - (or encryption=emailaddress) to specify a gpg key that can access - the encrypted special remote. + encryption=none to disable encryption, or encryption=shared to use a + shared cipher (stored clear in the git repository), or + encryption=hybrid to encrypt the cipher to an OpenPGP key, or + encryption=pubkey to encrypt file contents using public-key + cryptography. In the two last cases, you also need to specify which + key can access the encrypted special remote, which is done by + specifiying keyid= (gpg needs to be to be able to find a public key + matching that specification, which can be an OpenPGP key ID or an + e-mail address for instance). Note that with encryption enabled, a cryptographic key is created. This requires sufficient entropy. If initremote seems to hang or take @@ -320,7 +326,7 @@ subdirectories). Example Amazon S3 remote: - git annex initremote mys3 type=S3 encryption=me@example.com datacenter=EU + git annex initremote mys3 type=S3 encryption=hybrid keyid=me@example.com datacenter=EU * enableremote name [param=value ...] @@ -352,6 +358,13 @@ subdirectories). git annex enableremote mys3 keyid-=revokedkey keyid+=newkey + Also, note that for encrypted special remotes using strict public-key + encryption (encryption=pubkey), adding or removing a key has NO effect + on files that have already been copied to the remote. Hence using + keyid+= and keyid-= with such remotes should be used with care, and + make little sense unless the private material of the old and new + access list is all owned by the same (group of) person. + * trust [repository ...] Records that a repository is trusted to not unexpectedly lose |