diff --git a/Crypto.hs b/Crypto.hs index 7f667a3b0c..288042b1be 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -3,7 +3,7 @@ - Currently using gpg; could later be modified to support different - crypto backends if necessary. - - - Copyright 2011-2023 Joey Hess + - Copyright 2011-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -43,6 +43,7 @@ import Control.Monad.IO.Class import Annex.Common import qualified Utility.Gpg as Gpg +import qualified Utility.StatelessOpenPGP as SOP import Types.Crypto import Types.Remote import Types.Key @@ -195,7 +196,6 @@ readBytes a h = liftIO (L.hGetContents h) >>= a readBytesStrictly :: (MonadIO m) => (S.ByteString -> m a) -> Reader m a readBytesStrictly a h = liftIO (S.hGetContents h) >>= a - {- 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 diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 528aa2bca1..884d53d7bf 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -158,18 +158,18 @@ parseMac (Just (Proposed s)) = case readMac s of encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup) encryptionSetup c gc = do pc <- either giveup return $ parseEncryptionConfig c - cmd <- gpgCmd <$> Annex.getGitConfig - maybe (genCipher pc cmd) (updateCipher pc cmd) (extractCipher pc) + gpgcmd <- gpgCmd <$> Annex.getGitConfig + maybe (genCipher pc gpgcmd) (updateCipher pc gpgcmd) (extractCipher pc) where -- The type of encryption encryption = parseEncryptionMethod (fromProposedAccepted <$> M.lookup encryptionField c) c -- Generate a new cipher, depending on the chosen encryption scheme - genCipher pc cmd = case encryption of + genCipher pc gpgcmd = case encryption of Right NoneEncryption -> return (c, NoEncryption) - Right SharedEncryption -> encsetup $ genSharedCipher cmd - Right HybridEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key Hybrid - Right PubKeyEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key PubKey - Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher cmd key + Right SharedEncryption -> encsetup $ genSharedCipher gpgcmd + Right HybridEncryption -> encsetup $ genEncryptedCipher gpgcmd (pc, gc) key Hybrid + Right PubKeyEncryption -> encsetup $ genEncryptedCipher gpgcmd (pc, gc) key PubKey + Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher gpgcmd key Left err -> giveup err key = maybe (giveup "Specify keyid=...") fromProposedAccepted $ M.lookup (Accepted "keyid") c @@ -177,13 +177,13 @@ encryptionSetup c gc = do maybe [] (\k -> [(False,fromProposedAccepted k)]) (M.lookup (Accepted "keyid-") c) cannotchange = giveup "Cannot set encryption type of existing remotes." -- Update an existing cipher if possible. - updateCipher pc cmd v = case v of + updateCipher pc gpgcmd v = case v of SharedCipher _ | encryption == Right SharedEncryption -> return (c', EncryptionIsSetup) EncryptedCipher _ variant _ | sameasencryption variant -> - use "encryption update" $ updateCipherKeyIds cmd (pc, gc) newkeys v + use "encryption update" $ updateCipherKeyIds gpgcmd (pc, gc) newkeys v SharedPubKeyCipher _ _ -> - use "encryption update" $ updateCipherKeyIds cmd (pc, gc) newkeys v + use "encryption update" $ updateCipherKeyIds gpgcmd (pc, gc) newkeys v _ -> cannotchange sameasencryption variant = case encryption of Right HybridEncryption -> variant == Hybrid @@ -236,8 +236,8 @@ remoteCipher' c gc = case extractCipher c of (go cachev encipher) where go cachev encipher cache = do - cmd <- gpgCmd <$> Annex.getGitConfig - cipher <- liftIO $ decryptCipher cmd (c, gc) encipher + gpgcmd <- gpgCmd <$> Annex.getGitConfig + cipher <- liftIO $ decryptCipher gpgcmd (c, gc) encipher liftIO $ atomically $ putTMVar cachev $ M.insert encipher cipher cache return $ Just (cipher, encipher) diff --git a/Test.hs b/Test.hs index 75a963ca87..c8db8147a4 100644 --- a/Test.hs +++ b/Test.hs @@ -1835,7 +1835,7 @@ test_sop_crypto = do case filter (\(k, _) -> k == ck) gc of [] -> noop ((_, sopcmd):_) -> go $ - Utility.StatelessOpenPGP.SopCmd $ + Utility.StatelessOpenPGP.SOPCmd $ Git.Types.fromConfigValue sopcmd where ck = fromString "annex.shared-sop-command" diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index cb8ecdf003..b8158ea8e6 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -47,6 +47,7 @@ import Types.View import Config.DynamicConfig import Utility.HumanTime import Utility.Gpg (GpgCmd, mkGpgCmd) +import Utility.StatelessOpenPGP (SOPCmd(..)) import Utility.ThreadScheduler (Seconds(..)) import Utility.Url (Scheme, mkScheme) @@ -372,7 +373,7 @@ data RemoteGitConfig = RemoteGitConfig , remoteAnnexRsyncTransport :: [String] , remoteAnnexGnupgOptions :: [String] , remoteAnnexGnupgDecryptOptions :: [String] - , remoteAnnexSharedSOPCommand :: Maybe String + , remoteAnnexSharedSOPCommand :: Maybe SOPCmd , remoteAnnexSharedSOPProfile :: Maybe String , remoteAnnexRsyncUrl :: Maybe String , remoteAnnexBupRepo :: Maybe String @@ -441,7 +442,8 @@ extractRemoteGitConfig r remotename = do , remoteAnnexRsyncTransport = getoptions "rsync-transport" , remoteAnnexGnupgOptions = getoptions "gnupg-options" , remoteAnnexGnupgDecryptOptions = getoptions "gnupg-decrypt-options" - , remoteAnnexSharedSOPCommand = notempty $ getmaybe "shared-sop-command" + , remoteAnnexSharedSOPCommand = SOPCmd <$> + notempty (getmaybe "shared-sop-command") , remoteAnnexSharedSOPProfile = notempty $ getmaybe "shared-sop-profile" , remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl" , remoteAnnexBupRepo = getmaybe "buprepo" diff --git a/Utility/StatelessOpenPGP.hs b/Utility/StatelessOpenPGP.hs index 73e3746a3a..35b4b17ccc 100644 --- a/Utility/StatelessOpenPGP.hs +++ b/Utility/StatelessOpenPGP.hs @@ -8,7 +8,7 @@ {-# LANGUAGE CPP, OverloadedStrings #-} module Utility.StatelessOpenPGP ( - SopCmd(..), + SOPCmd(..), SopSubCmd, Password, Profile, @@ -34,7 +34,7 @@ import Control.Monad.IO.Class import qualified Data.ByteString as B {- The command to run, eq sqop. -} -newtype SopCmd = SopCmd { unSopCmd :: String } +newtype SOPCmd = SOPCmd { unSOPCmd :: String } {- The subcommand to run eg encrypt. -} type SopSubCmd = String @@ -67,7 +67,7 @@ newtype EmptyDirectory = EmptyDirectory FilePath {- Encrypt using symmetric encryption with the specified password. -} encryptSymmetric :: (MonadIO m, MonadMask m) - => SopCmd + => SOPCmd -> Password -> EmptyDirectory -> Maybe Profile @@ -91,7 +91,7 @@ encryptSymmetric sopcmd password emptydirectory mprofile armoring feeder reader {- Deccrypt using symmetric encryption with the specified password. -} decryptSymmetric :: (MonadIO m, MonadMask m) - => SopCmd + => SOPCmd -> Password -> EmptyDirectory -> (Handle -> IO ()) @@ -101,7 +101,7 @@ decryptSymmetric sopcmd password emptydirectory feeder reader = feedRead sopcmd "decrypt" [] password emptydirectory feeder reader {- Test a value round-trips through symmetric encryption and decryption. -} -test_encrypt_decrypt_Symmetric :: SopCmd -> SopCmd -> Password -> Armoring -> B.ByteString -> IO Bool +test_encrypt_decrypt_Symmetric :: SOPCmd -> SOPCmd -> Password -> Armoring -> B.ByteString -> IO Bool test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $ withTmpDir "test" $ \d -> do let ed = EmptyDirectory d @@ -120,7 +120,7 @@ test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $ - Note that the reader must fully consume its input before returning. -} feedRead :: (MonadIO m, MonadMask m) - => SopCmd + => SOPCmd -> SopSubCmd -> [CommandParam] -> Password @@ -165,14 +165,14 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do {- Like feedRead, but without password. -} feedRead' :: (MonadIO m, MonadMask m) - => SopCmd + => SOPCmd -> SopSubCmd -> [CommandParam] -> Maybe EmptyDirectory -> (Handle -> IO ()) -> (Handle -> m a) -> m a -feedRead' (SopCmd cmd) subcmd params med feeder reader = do +feedRead' (SOPCmd cmd) subcmd params med feeder reader = do let p = (proc cmd (subcmd:toCommand params)) { std_in = CreatePipe , std_out = CreatePipe