From d2bc0e9f3ee923fbd860e873fb91468fdccf9bbe Mon Sep 17 00:00:00 2001 From: guilhem Date: Mon, 11 Mar 2013 02:33:13 +0100 Subject: [PATCH] GnuPG options for symmetric encryption. --- Creds.hs | 2 +- Crypto.hs | 13 +++++++++---- Remote/Bup.hs | 2 +- Remote/Directory.hs | 8 ++++---- Remote/Glacier.hs | 2 +- Remote/Hook.hs | 8 ++++---- Remote/Rsync.hs | 8 ++++---- Remote/S3.hs | 2 +- Remote/WebDAV.hs | 3 ++- Types/GitConfig.hs | 2 ++ Utility/Gpg/Types.hs | 30 ++++++++++++++++++++++++++++++ doc/git-annex.mdwn | 15 ++++++++++++--- 12 files changed, 71 insertions(+), 24 deletions(-) create mode 100644 Utility/Gpg/Types.hs diff --git a/Creds.hs b/Creds.hs index 06d3a52f90..ee0a67398d 100644 --- a/Creds.hs +++ b/Creds.hs @@ -48,7 +48,7 @@ setRemoteCredPair c storage = go =<< getRemoteCredPair c storage return c storeconfig creds key (Just cipher) = do - s <- liftIO $ encrypt cipher + s <- liftIO $ encrypt (GpgOpts []) cipher (feedBytes $ L.pack $ encodeCredPair creds) (readBytes $ return . L.unpack) return $ M.insert key (toB64 s) c diff --git a/Crypto.hs b/Crypto.hs index ed489cdbc3..21a35ad0b1 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -23,6 +23,8 @@ module Crypto ( readBytes, encrypt, decrypt, + GpgOpts(..), + getGpgOpts, prop_hmacWithCipher_sane ) where @@ -34,6 +36,7 @@ import Control.Applicative import Common.Annex import qualified Utility.Gpg as Gpg +import Utility.Gpg.Types import Types.Key import Types.Crypto @@ -131,10 +134,12 @@ 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 encrypted with the - - Cipher, and read by the Reader action. -} -encrypt :: Cipher -> Feeder -> Reader a -> IO a -encrypt = Gpg.feedRead [Params "--symmetric --force-mdc"] . cipherPassphrase +{- 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 decrypted with the - Cipher, and read by the Reader action. -} diff --git a/Remote/Bup.hs b/Remote/Bup.hs index f81751f825..a598e5599c 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -130,7 +130,7 @@ storeEncrypted r buprepo (cipher, enck) k _p = sendAnnex k (rollback enck buprepo) $ \src -> do params <- bupSplitParams r buprepo enck [] liftIO $ catchBoolIO $ - encrypt cipher (feedFile src) $ \h -> + encrypt (getGpgOpts r) cipher (feedFile src) $ \h -> pipeBup params (Just h) Nothing retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 3070a530b8..1415869387 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -38,7 +38,7 @@ gen r u c gc = do cst <- remoteCost gc cheapRemoteCost let chunksize = chunkSize c return $ encryptableRemote c - (storeEncrypted dir chunksize) + (storeEncrypted dir (getGpgOpts gc) chunksize) (retrieveEncrypted dir chunksize) Remote { uuid = u, @@ -124,11 +124,11 @@ store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src -> storeSplit meterupdate chunksize dests =<< L.readFile src -storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted d chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src -> +storeEncrypted :: FilePath -> GpgOpts -> 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 $ \dests -> - encrypt cipher (feedFile src) $ readBytes $ \b -> + encrypt gpgOpts cipher (feedFile src) $ readBytes $ \b -> case chunksize of Nothing -> do let dest = Prelude.head dests diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 173e366d28..bd2f0a1792 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -93,7 +93,7 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted r (cipher, enck) k m = sendAnnex k (void $ remove r enck) $ \src -> do metered (Just m) k $ \meterupdate -> storeHelper r enck $ \h -> - encrypt cipher (feedFile src) + encrypt (getGpgOpts r) cipher (feedFile src) (readBytes $ meteredWrite meterupdate h) retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 8b02312035..9fbd632d65 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -33,7 +33,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote gen r u c gc = do cst <- remoteCost gc expensiveRemoteCost return $ encryptableRemote c - (storeEncrypted hooktype) + (storeEncrypted hooktype $ getGpgOpts gc) (retrieveEncrypted hooktype) Remote { uuid = u, @@ -106,10 +106,10 @@ store :: String -> 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 :: String -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted h (cipher, enck) k _p = withTmp enck $ \tmp -> +storeEncrypted :: String -> GpgOpts -> (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 cipher (feedFile src) $ + liftIO $ encrypt gpgOpts cipher (feedFile src) $ readBytes $ L.writeFile tmp runHook h "store" enck (Just tmp) $ return True diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 21a4d4324a..a7a830ef9f 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -43,7 +43,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote gen r u c gc = do cst <- remoteCost gc expensiveRemoteCost return $ encryptableRemote c - (storeEncrypted o) + (storeEncrypted o $ getGpgOpts gc) (retrieveEncrypted o) Remote { uuid = u @@ -104,10 +104,10 @@ 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 -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted o (cipher, enck) k p = withTmp enck $ \tmp -> +storeEncrypted :: RsyncOpts -> GpgOpts -> (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 cipher (feedFile src) $ + liftIO $ encrypt gpgOpts cipher (feedFile src) $ readBytes $ L.writeFile tmp rsyncSend o p enck True tmp diff --git a/Remote/S3.hs b/Remote/S3.hs index 1d24c49384..164e384f51 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -122,7 +122,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 cipher (feedFile src) $ + liftIO $ encrypt (getGpgOpts r) cipher (feedFile src) $ readBytes $ L.writeFile tmp res <- storeHelper (conn, bucket) r enck p tmp s3Bool res diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 84c30774af..b1c2ee4a89 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -92,7 +92,8 @@ 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 cipher (streamMeteredFile src meterupdate) $ + liftIO $ encrypt (getGpgOpts r) cipher + (streamMeteredFile src meterupdate) $ readBytes $ storeHelper r enck baseurl user pass storeHelper :: Remote -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 2430a73a70..9c6de59d78 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -88,6 +88,7 @@ data RemoteGitConfig = RemoteGitConfig -- these settings are specific to particular types of remotes , remoteAnnexSshOptions :: [String] , remoteAnnexRsyncOptions :: [String] + , remoteAnnexGnupgOptions :: [String] , remoteAnnexRsyncUrl :: Maybe String , remoteAnnexBupRepo :: Maybe String , remoteAnnexBupSplitOptions :: [String] @@ -107,6 +108,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig , remoteAnnexSshOptions = getoptions "ssh-options" , remoteAnnexRsyncOptions = getoptions "rsync-options" + , remoteAnnexGnupgOptions = getoptions "gnupg-options" , remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl" , remoteAnnexBupRepo = getmaybe "buprepo" , remoteAnnexBupSplitOptions = getoptions "bup-split-options" diff --git a/Utility/Gpg/Types.hs b/Utility/Gpg/Types.hs new file mode 100644 index 0000000000..d457072074 --- /dev/null +++ b/Utility/Gpg/Types.hs @@ -0,0 +1,30 @@ +{- gpg data types + - + - Copyright 2013 guilhem + - + - 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/doc/git-annex.mdwn b/doc/git-annex.mdwn index 7d9928d712..c34fd4bfb9 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -904,10 +904,19 @@ Here are all the supported configuration settings. For example, to limit the bandwidth to 100Kbyte/s, set it to "--bwlimit 100k" (There is no corresponding option for bup join.) -* `annex.ssh-options`, `annex.rsync-options`, `annex.bup-split-options` +* `remote..annex-gnupg-options` - Default ssh, rsync, wget/curl, and bup options to use if a remote does not - have specific options. + Options to pass to GnuPG for symmetric encryption. For instance, to + use the AES cipher with a 256 bits key and disable compression, set it + to "--cipher-algo AES256 --compress-algo none". (These options take + precedence over the default GnuPG configuration, which is otherwise + used.) + +* `annex.ssh-options`, `annex.rsync-options`, `annex.bup-split-options`, + `annex.gnupg-options` + + Default ssh, rsync, wget/curl, bup, and GnuPG options to use if a + remote does not have specific options. * `annex.web-options`