- 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.
-}
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
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. -}
- 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)
}
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
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
(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. -}
(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 ','
(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
{- 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 (
import Control.Concurrent.Async
import Control.Monad.IO.Class
+import qualified Data.ByteString as B
import qualified Data.Map as M
import Data.Char
]
{- 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')
}
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')
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
- 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
(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]
#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
-- 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 ':')
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) =
{- 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
- 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
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
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
- 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
projects / git-annex.git / commitdiff