diff --git a/Crypto.hs b/Crypto.hs index 7f134a3cbc..7f667a3b0c 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-2022 Joey Hess + - Copyright 2011-2023 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -39,7 +39,6 @@ module Crypto ( import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Data.ByteString.UTF8 (fromString) import Control.Monad.IO.Class import Annex.Common @@ -71,12 +70,12 @@ cipherBeginning = 256 cipherSize :: Int cipherSize = 512 -cipherPassphrase :: Cipher -> String -cipherPassphrase (Cipher c) = drop cipherBeginning c +cipherPassphrase :: Cipher -> S.ByteString +cipherPassphrase (Cipher c) = S.drop cipherBeginning c cipherPassphrase (MacOnlyCipher _) = giveup "MAC-only cipher" -cipherMac :: Cipher -> String -cipherMac (Cipher c) = take cipherBeginning c +cipherMac :: Cipher -> S.ByteString +cipherMac (Cipher c) = S.take cipherBeginning c cipherMac (MacOnlyCipher c) = c {- Creates a new Cipher, encrypted to the specified key id. -} @@ -168,7 +167,7 @@ type EncKey = Key -> Key - on content. It does need to be repeatable. -} encryptKey :: Mac -> Cipher -> EncKey encryptKey mac c k = mkKey $ \d -> d - { keyName = S.toShort $ encodeBS $ macWithCipher mac c (serializeKey k) + { keyName = S.toShort $ encodeBS $ macWithCipher mac c (serializeKey' k) , keyVariety = OtherKey $ encryptedBackendNamePrefix <> encodeBS (showMac mac) } @@ -225,10 +224,10 @@ decrypt cmd c cipher = case cipher of where params = Param "--decrypt" : getGpgDecParams c -macWithCipher :: Mac -> Cipher -> String -> String +macWithCipher :: Mac -> Cipher -> S.ByteString -> String macWithCipher mac c = macWithCipher' mac (cipherMac c) -macWithCipher' :: Mac -> String -> String -> String -macWithCipher' mac c s = calcMac mac (fromString c) (fromString s) +macWithCipher' :: Mac -> S.ByteString -> S.ByteString -> String +macWithCipher' mac c s = calcMac mac c s {- Ensure that macWithCipher' returns the same thing forevermore. -} prop_HmacSha1WithCipher_sane :: Bool diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 8e3e0a3f00..528aa2bca1 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -28,8 +28,6 @@ module Remote.Helper.Encryptable ( import qualified Data.Map as M import qualified Data.Set as S -import qualified Data.ByteString as B -import Data.Word import Control.Concurrent.STM import Annex.Common @@ -273,7 +271,7 @@ storeCipher cip = case cip of (EncryptedCipher t _ ks) -> addcipher t . storekeys ks cipherkeysField (SharedPubKeyCipher t ks) -> addcipher t . storekeys ks pubkeysField where - addcipher t = M.insert cipherField (Accepted (toB64bs t)) + addcipher t = M.insert cipherField (Accepted (decodeBS (toB64 t))) storekeys (KeyIds l) n = M.insert n (Accepted (intercalate "," l)) {- Extracts an StorableCipher from a remote's configuration. -} @@ -282,13 +280,13 @@ extractCipher c = case (getRemoteConfigValue cipherField c, (getRemoteConfigValue cipherkeysField c <|> getRemoteConfigValue pubkeysField c), getRemoteConfigValue encryptionField c) of (Just t, Just ks, Just HybridEncryption) -> - Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks) + Just $ EncryptedCipher (fromB64 (encodeBS t)) Hybrid (readkeys ks) (Just t, Just ks, Just PubKeyEncryption) -> - Just $ EncryptedCipher (fromB64bs t) PubKey (readkeys ks) + Just $ EncryptedCipher (fromB64 (encodeBS t)) PubKey (readkeys ks) (Just t, Just ks, Just SharedPubKeyEncryption) -> - Just $ SharedPubKeyCipher (fromB64bs t) (readkeys ks) + Just $ SharedPubKeyCipher (fromB64 (encodeBS t)) (readkeys ks) (Just t, Nothing, Just SharedEncryption) -> - Just $ SharedCipher (fromB64bs t) + Just $ SharedCipher (fromB64 (encodeBS t)) _ -> Nothing where readkeys = KeyIds . splitc ',' @@ -322,25 +320,3 @@ describeCipher c = case c of (SharedPubKeyCipher _ ks) -> showkeys ks where showkeys (KeyIds { keyIds = ks }) = "to gpg keys: " ++ unwords ks - -{- Not using encodeBS because these "Strings" are really - - bags of bytes and are not encoding with the filesystem encoding. - - So this hack is needed to work on all locales and roundtrip cleanly. - -} -toB64bs :: String -> String -toB64bs = w82s . B.unpack . toB64 . B.pack . s2w8 - -fromB64bs :: String -> String -fromB64bs = w82s . B.unpack . fromB64 . B.pack . s2w8 - -c2w8 :: Char -> Word8 -c2w8 = fromIntegral . fromEnum - -w82c :: Word8 -> Char -w82c = toEnum . fromIntegral - -s2w8 :: String -> [Word8] -s2w8 = map c2w8 - -w82s :: [Word8] -> String -w82s = map w82c diff --git a/Types/Crypto.hs b/Types/Crypto.hs index 48a6ad0cc8..38f4daeb10 100644 --- a/Types/Crypto.hs +++ b/Types/Crypto.hs @@ -25,6 +25,7 @@ import Utility.Gpg (KeyIds(..)) import Data.Typeable import qualified Data.Map as M +import Data.ByteString (ByteString) data EncryptionMethod = NoneEncryption @@ -35,12 +36,12 @@ data EncryptionMethod deriving (Typeable, Eq) -- XXX ideally, this would be a locked memory region -data Cipher = Cipher String | MacOnlyCipher String +data Cipher = Cipher ByteString | MacOnlyCipher ByteString data StorableCipher - = EncryptedCipher String EncryptedCipherVariant KeyIds - | SharedCipher String - | SharedPubKeyCipher String KeyIds + = EncryptedCipher ByteString EncryptedCipherVariant KeyIds + | SharedCipher ByteString + | SharedPubKeyCipher ByteString KeyIds deriving (Ord, Eq) data EncryptedCipherVariant = Hybrid | PubKey deriving (Ord, Eq) diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 445f65768c..288499ff8e 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -1,10 +1,11 @@ {- gpg interface - - - Copyright 2011-2022 Joey Hess + - Copyright 2011-2023 Joey Hess - - License: BSD-2-clause -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Utility.Gpg ( @@ -48,6 +49,7 @@ import Utility.Format (decode_c) import Control.Concurrent.Async import Control.Monad.IO.Class +import qualified Data.ByteString as B import qualified Data.Map as M import Data.Char @@ -108,10 +110,10 @@ stdEncryptionParams symmetric = enc symmetric ++ ] {- Runs gpg with some params and returns its stdout, strictly. -} -readStrict :: GpgCmd -> [CommandParam] -> IO String +readStrict :: GpgCmd -> [CommandParam] -> IO B.ByteString readStrict c p = readStrict' c p Nothing -readStrict' :: GpgCmd -> [CommandParam] -> Maybe [(String, String)] -> IO String +readStrict' :: GpgCmd -> [CommandParam] -> Maybe [(String, String)] -> IO B.ByteString readStrict' (GpgCmd cmd) params environ = do params' <- stdParams params let p = (proc cmd params') @@ -120,17 +122,16 @@ readStrict' (GpgCmd cmd) params environ = do } withCreateProcess p (go p) where - go p _ (Just hout) _ pid = do - hSetBinaryMode hout True - forceSuccessProcess p pid `after` hGetContentsStrict hout + go p _ (Just hout) _ pid = + forceSuccessProcess p pid `after` B.hGetContents hout go _ _ _ _ _ = error "internal" {- Runs gpg, piping an input value to it, and returning its stdout, - strictly. -} -pipeStrict :: GpgCmd -> [CommandParam] -> String -> IO String +pipeStrict :: GpgCmd -> [CommandParam] -> B.ByteString -> IO B.ByteString pipeStrict c p i = pipeStrict' c p Nothing i -pipeStrict' :: GpgCmd -> [CommandParam] -> Maybe [(String, String)] -> String -> IO String +pipeStrict' :: GpgCmd -> [CommandParam] -> Maybe [(String, String)] -> B.ByteString -> IO B.ByteString pipeStrict' (GpgCmd cmd) params environ input = do params' <- stdParams params let p = (proc cmd params') @@ -141,11 +142,9 @@ pipeStrict' (GpgCmd cmd) params environ input = do withCreateProcess p (go p) where go p (Just to) (Just from) _ pid = do - hSetBinaryMode to True - hSetBinaryMode from True - hPutStr to input + B.hPutStr to input hClose to - forceSuccessProcess p pid `after` hGetContentsStrict from + forceSuccessProcess p pid `after` B.hGetContents from go _ _ _ _ _ = error "internal" {- Runs gpg with some parameters. First sends it a passphrase (unless it @@ -158,7 +157,7 @@ pipeStrict' (GpgCmd cmd) params environ input = do - the passphrase. - - Note that the reader must fully consume gpg's input before returning. -} -feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a +feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> B.ByteString -> (Handle -> IO ()) -> (Handle -> m a) -> m a feedRead cmd params passphrase feeder reader = do #ifndef mingw32_HOST_OS let setup = liftIO $ do @@ -166,7 +165,7 @@ feedRead cmd params passphrase feeder reader = do (frompipe, topipe) <- System.Posix.IO.createPipe toh <- fdToHandle topipe t <- async $ do - hPutStrLn toh passphrase + B.hPutStr toh (passphrase <> "\n") hClose toh let Fd pfd = frompipe let passphrasefd = [Param "--passphrase-fd", Param $ show pfd] @@ -180,7 +179,7 @@ feedRead cmd params passphrase feeder reader = do #else -- store the passphrase in a temp file for gpg withTmpFile "gpg" $ \tmpfile h -> do - liftIO $ hPutStr h passphrase + liftIO $ B.hPutStr h passphrase liftIO $ hClose h let passphrasefile = [Param "--passphrase-file", File tmpfile] go $ passphrasefile ++ params @@ -223,7 +222,8 @@ findPubKeys' cmd environ for -- pass forced subkey through as-is rather than -- looking up the master key. | isForcedSubKey for = return $ KeyIds [for] - | otherwise = KeyIds . parse . lines <$> readStrict' cmd params environ + | otherwise = KeyIds . parse . lines . decodeBS + <$> readStrict' cmd params environ where params = [Param "--with-colons", Param "--list-public-keys", Param for] parse = mapMaybe (keyIdField . splitc ':') @@ -241,7 +241,8 @@ type UserId = String secretKeys :: GpgCmd -> IO (M.Map KeyId UserId) secretKeys cmd = catchDefaultIO M.empty makemap where - makemap = M.fromList . parse . lines <$> readStrict cmd params + makemap = M.fromList . parse . lines . decodeBS + <$> readStrict cmd params params = [Param "--with-colons", Param "--list-secret-keys", Param "--fixed-list-mode"] parse = extract [] Nothing . map (splitc ':') extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = @@ -301,7 +302,7 @@ genSecretKey (GpgCmd cmd) keytype passphrase userid keysize = {- Creates a block of high-quality random data suitable to use as a cipher. - It is armored, to avoid newlines, since gpg only reads ciphers up to the - first newline. -} -genRandom :: GpgCmd -> Bool -> Size -> IO String +genRandom :: GpgCmd -> Bool -> Size -> IO B.ByteString genRandom cmd highQuality size = do s <- readStrict cmd params checksize s @@ -327,7 +328,7 @@ genRandom cmd highQuality size = do - entropy. -} expectedlength = size * 8 `div` 6 - checksize s = let len = length s in + checksize s = let len = B.length s in unless (len >= expectedlength) $ shortread len @@ -439,8 +440,8 @@ testHarness tmpdir cmd a = ifM (inSearchPath (unGpgCmd cmd)) liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath subdir) $ removeModes $ otherGroupModes -- For some reason, recent gpg needs a trustdb to be set up. - _ <- pipeStrict' cmd [Param "--trust-model", Param "auto", Param "--update-trustdb"] (Just environ) [] - _ <- pipeStrict' cmd [Param "--import", Param "-q"] (Just environ) $ unlines + _ <- pipeStrict' cmd [Param "--trust-model", Param "auto", Param "--update-trustdb"] (Just environ) mempty + _ <- pipeStrict' cmd [Param "--import", Param "-q"] (Just environ) $ encodeBS $ unlines [testSecretKey, testKey] return environ @@ -470,7 +471,7 @@ checkEncryptionFile cmd environ filename keys = where params = [Param "--list-packets", Param "--list-only", File filename] -checkEncryptionStream :: GpgCmd -> Maybe [(String, String)] -> String -> Maybe KeyIds -> IO Bool +checkEncryptionStream :: GpgCmd -> Maybe [(String, String)] -> B.ByteString -> Maybe KeyIds -> IO Bool checkEncryptionStream cmd environ stream keys = checkGpgPackets cmd environ keys =<< pipeStrict' cmd params environ stream where @@ -480,13 +481,13 @@ checkEncryptionStream cmd environ stream keys = - symmetrically encrypted (keys is Nothing), or encrypted to some - public key(s). - /!\ The key needs to be in the keyring! -} -checkGpgPackets :: GpgCmd -> Maybe [(String, String)] -> Maybe KeyIds -> String -> IO Bool +checkGpgPackets :: GpgCmd -> Maybe [(String, String)] -> Maybe KeyIds -> B.ByteString -> IO Bool checkGpgPackets cmd environ keys str = do let (asym,sym) = partition (pubkeyEncPacket `isPrefixOf`) $ filter (\l' -> pubkeyEncPacket `isPrefixOf` l' || symkeyEncPacket `isPrefixOf` l') $ takeWhile (/= ":encrypted data packet:") $ - lines str + lines (decodeBS str) case (keys,asym,sym) of (Nothing, [], [_]) -> return True (Just (KeyIds ks), ls, []) -> do diff --git a/doc/bugs/fresh_test_fails__58___hPut__58___invalid_argument_.mdwn b/doc/bugs/fresh_test_fails__58___hPut__58___invalid_argument_.mdwn index 48cc8056fc..cbcbedbd1e 100644 --- a/doc/bugs/fresh_test_fails__58___hPut__58___invalid_argument_.mdwn +++ b/doc/bugs/fresh_test_fails__58___hPut__58___invalid_argument_.mdwn @@ -30,4 +30,4 @@ cron-20231027/build-ubuntu.yaml-1289-1c03c8fd-failed/0_test-annex (normal, ubunt [[!meta author=yoh]] [[!tag projects/repronim]] - +> [[fixed|done]] --[[Joey]]