summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2023-11-01 14:27:22 -0400
committerJoey Hess <joeyh@joeyh.name>2023-11-01 14:39:49 -0400
commitc41ca6c8329ee4c23e6b6ddde5a1587f81a47aeb (patch)
treea2734c5730b236f8cead632c7e276443af876843
parentbe6b56df4c7235652fd5539df1ab0cd776c085d0 (diff)
convert StorableCipher to ByteString
This allows getting rid of the ugly and error prone handling of "bag of bytes" String in Remote.Helper.Encryptable. Avoiding breakage like that dealt with by commit 9862d64bf90de645ef1acfbf862c5b340475aacf And allows converting Utility.Gpg to use ByteString for IO, which is a welcome change. Tested the new git-annex interoperability with old, using all 3 encryption= types. Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
-rw-r--r--Crypto.hs19
-rw-r--r--Remote/Helper/Encryptable.hs34
-rw-r--r--Types/Crypto.hs9
-rw-r--r--Utility/Gpg.hs49
-rw-r--r--doc/bugs/fresh_test_fails__58___hPut__58___invalid_argument_.mdwn2
5 files changed, 45 insertions, 68 deletions
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 <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
-
- 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 <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
-
- 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]]