Leverage an ambiguities between Ciphers
Cipher is now a datatype data Cipher = Cipher String | MacOnlyCipher String which makes more precise its interpretation MAC-only vs. MAC + used to derive a key for symmetric crypto.
This commit is contained in:
parent
6883c17d62
commit
ac9807c887
4 changed files with 53 additions and 46 deletions
42
Crypto.hs
42
Crypto.hs
|
@ -64,20 +64,22 @@ cipherSize = 512
|
|||
|
||||
cipherPassphrase :: Cipher -> String
|
||||
cipherPassphrase (Cipher c) = drop cipherBeginning c
|
||||
cipherPassphrase (MacOnlyCipher _) = error "MAC-only cipher"
|
||||
|
||||
cipherMac :: Cipher -> String
|
||||
cipherMac (Cipher c) = take cipherBeginning c
|
||||
cipherMac (MacOnlyCipher c) = c
|
||||
|
||||
{- Creates a new Cipher, encrypted to the specified key id. -}
|
||||
genEncryptedCipher :: String -> EncryptedCipherVariant -> Bool -> IO StorableCipher
|
||||
genEncryptedCipher keyid variant highQuality = do
|
||||
ks <- Gpg.findPubKeys keyid
|
||||
random <- Gpg.genRandom highQuality size
|
||||
encryptCipher (Cipher random) variant ks
|
||||
encryptCipher (mkCipher random) variant ks
|
||||
where
|
||||
size = case variant of
|
||||
HybridCipher -> cipherSize -- used for MAC + symmetric
|
||||
PubKeyCipher -> cipherBeginning -- only used for MAC
|
||||
(mkCipher, size) = case variant of
|
||||
HybridCipher -> (Cipher, cipherSize) -- used for MAC + symmetric
|
||||
PubKeyCipher -> (MacOnlyCipher, cipherBeginning) -- only used for MAC
|
||||
|
||||
{- Creates a new, shared Cipher. -}
|
||||
genSharedCipher :: Bool -> IO StorableCipher
|
||||
|
@ -89,7 +91,7 @@ genSharedCipher highQuality =
|
|||
updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher
|
||||
updateEncryptedCipher _ SharedCipher{} = undefined
|
||||
updateEncryptedCipher [] encipher = return encipher
|
||||
updateEncryptedCipher newkeys encipher@(EncryptedCipher _ symmetric (KeyIds ks)) = do
|
||||
updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do
|
||||
dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
|
||||
forM_ dropKeys $ \k -> unless (k `elem` ks) $
|
||||
error $ "Key " ++ k ++ " was not present; cannot remove."
|
||||
|
@ -98,7 +100,7 @@ updateEncryptedCipher newkeys encipher@(EncryptedCipher _ symmetric (KeyIds ks))
|
|||
when (null ks') $
|
||||
error "Cannot remove the last key."
|
||||
cipher <- decryptCipher encipher
|
||||
encryptCipher cipher symmetric $ KeyIds ks'
|
||||
encryptCipher cipher variant $ KeyIds ks'
|
||||
where
|
||||
listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat
|
||||
|
||||
|
@ -115,18 +117,26 @@ describeCipher (EncryptedCipher _ variant (KeyIds ks)) =
|
|||
|
||||
{- Encrypts a Cipher to the specified KeyIds. -}
|
||||
encryptCipher :: Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
|
||||
encryptCipher (Cipher c) variant (KeyIds ks) = do
|
||||
encryptCipher c variant (KeyIds ks) = do
|
||||
-- gpg complains about duplicate recipient keyids
|
||||
let ks' = nub $ sort ks
|
||||
let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
|
||||
encipher <- Gpg.pipeStrict params c
|
||||
encipher <- Gpg.pipeStrict params cipher
|
||||
return $ EncryptedCipher encipher variant (KeyIds ks')
|
||||
where
|
||||
cipher = case c of
|
||||
Cipher x -> x
|
||||
MacOnlyCipher x -> x
|
||||
|
||||
{- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
|
||||
decryptCipher :: StorableCipher -> IO Cipher
|
||||
decryptCipher (SharedCipher t) = return $ Cipher t
|
||||
decryptCipher (EncryptedCipher t _ _) =
|
||||
Cipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t
|
||||
decryptCipher (EncryptedCipher t variant _) =
|
||||
mkCipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t
|
||||
where
|
||||
mkCipher = case variant of
|
||||
HybridCipher -> Cipher
|
||||
PubKeyCipher -> MacOnlyCipher
|
||||
|
||||
{- Generates an encrypted form of a Key. The encryption does not need to be
|
||||
- reversable, nor does it need to be the same type of encryption used
|
||||
|
@ -158,16 +168,18 @@ readBytes a h = L.hGetContents h >>= a
|
|||
- recipients MUST be included in 'params' (for instance using
|
||||
- 'getGpgEncParams'). -}
|
||||
encrypt :: [CommandParam] -> Cipher -> Feeder -> Reader a -> IO a
|
||||
encrypt params cipher = Gpg.feedRead params' pass
|
||||
where
|
||||
pass = cipherPassphrase cipher
|
||||
params' = params ++ Gpg.stdEncryptionParams (not $ null pass)
|
||||
encrypt params cipher = case cipher of
|
||||
Cipher{} -> Gpg.feedRead (params ++ Gpg.stdEncryptionParams True) $
|
||||
cipherPassphrase cipher
|
||||
MacOnlyCipher{} -> Gpg.pipeLazy $ params ++ Gpg.stdEncryptionParams False
|
||||
|
||||
{- Runs a Feeder action, that generates content that is decrypted with the
|
||||
- Cipher (or using a private key if the Cipher is empty), and read by the
|
||||
- Reader action. -}
|
||||
decrypt :: Cipher -> Feeder -> Reader a -> IO a
|
||||
decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase
|
||||
decrypt cipher = case cipher of
|
||||
Cipher{} -> Gpg.feedRead [Param "--decrypt"] $ cipherPassphrase cipher
|
||||
MacOnlyCipher{} -> Gpg.pipeLazy [Param "--decrypt"]
|
||||
|
||||
macWithCipher :: Mac -> Cipher -> String -> String
|
||||
macWithCipher mac c = macWithCipher' mac (cipherMac c)
|
||||
|
|
|
@ -133,18 +133,11 @@ embedCreds c
|
|||
| isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True
|
||||
| otherwise = False
|
||||
|
||||
{- Gets encryption Cipher, and encrypted version of Key. In case we want
|
||||
- asymmetric encryption, leave the first empty, but encrypt the Key
|
||||
- regardless. (Empty ciphers imply asymmetric encryption.) We could
|
||||
- also check how long is the cipher (MAC'ing-only ciphers are shorter),
|
||||
- but we don't want to rely on that only. -}
|
||||
{- Gets encryption Cipher, and encrypted version of Key. -}
|
||||
cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
|
||||
cipherKey c k = fmap make <$> remoteCipher c
|
||||
where
|
||||
make ciphertext = (cipContent ciphertext, encryptKey mac ciphertext k)
|
||||
cipContent
|
||||
| M.lookup "encryption" c /= Just "pubkey" = id
|
||||
| otherwise = const $ Cipher ""
|
||||
make ciphertext = (ciphertext, encryptKey mac ciphertext k)
|
||||
mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac
|
||||
|
||||
{- Stores an StorableCipher in a remote's configuration. -}
|
||||
|
|
|
@ -23,7 +23,7 @@ import Data.Digest.Pure.SHA
|
|||
import Utility.Gpg (KeyIds(..))
|
||||
|
||||
-- XXX ideally, this would be a locked memory region
|
||||
newtype Cipher = Cipher String
|
||||
data Cipher = Cipher String | MacOnlyCipher String
|
||||
|
||||
data StorableCipher = EncryptedCipher String EncryptedCipherVariant KeyIds
|
||||
| SharedCipher String
|
||||
|
|
|
@ -99,31 +99,33 @@ pipeStrict params input = do
|
|||
- Note that to avoid deadlock with the cleanup stage,
|
||||
- the reader must fully consume gpg's input before returning. -}
|
||||
feedRead :: [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
|
||||
feedRead params passphrase feeder reader = if null passphrase
|
||||
then go =<< stdParams (Param "--batch" : params)
|
||||
else do
|
||||
feedRead params passphrase feeder reader = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
-- pipe the passphrase into gpg on a fd
|
||||
(frompipe, topipe) <- createPipe
|
||||
void $ forkIO $ do
|
||||
toh <- fdToHandle topipe
|
||||
hPutStrLn toh passphrase
|
||||
hClose toh
|
||||
let Fd pfd = frompipe
|
||||
let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
|
||||
|
||||
params' <- stdParams $ Param "--batch" : passphrasefd ++ params
|
||||
closeFd frompipe `after` go params'
|
||||
-- pipe the passphrase into gpg on a fd
|
||||
(frompipe, topipe) <- createPipe
|
||||
void $ forkIO $ do
|
||||
toh <- fdToHandle topipe
|
||||
hPutStrLn toh passphrase
|
||||
hClose toh
|
||||
let Fd pfd = frompipe
|
||||
let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
|
||||
closeFd frompipe `after` go (passphrasefd ++ params)
|
||||
#else
|
||||
-- store the passphrase in a temp file for gpg
|
||||
withTmpFile "gpg" $ \tmpfile h -> do
|
||||
hPutStr h passphrase
|
||||
hClose h
|
||||
let passphrasefile = [Param "--passphrase-file", File tmpfile]
|
||||
go =<< stdParams $ Param "--batch" : passphrasefile ++ params
|
||||
-- store the passphrase in a temp file for gpg
|
||||
withTmpFile "gpg" $ \tmpfile h -> do
|
||||
hPutStr h passphrase
|
||||
hClose h
|
||||
let passphrasefile = [Param "--passphrase-file", File tmpfile]
|
||||
go $ passphrasefile ++ params
|
||||
#endif
|
||||
where
|
||||
go params' = withBothHandles createProcessSuccess (proc gpgcmd params')
|
||||
go params' = pipeLazy params' feeder reader
|
||||
|
||||
{- Like feedRead, but without passphrase. -}
|
||||
pipeLazy :: [CommandParam] -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
|
||||
pipeLazy params feeder reader = do
|
||||
params' <- stdParams $ Param "--batch" : params
|
||||
withBothHandles createProcessSuccess (proc gpgcmd params')
|
||||
$ \(to, from) -> do
|
||||
void $ forkIO $ do
|
||||
feeder to
|
||||
|
|
Loading…
Reference in a new issue