diff --git a/hop.hs b/hop.hs --- a/hop.hs +++ b/hop.hs @@ -20,6 +20,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA import Codec.Encryption.OpenPGP.ASCIIArmor.Types @@ -130,8 +131,9 @@ , Block (..) , CompressionAlgorithm (BZip2, Uncompressed, ZIP, ZLIB) , CompressionError + , ECDSA_PrivateKey (..) , EdSigningCurve (EdSigningCurve25519, EdSigningCurve448) - , EightOctetKeyId + , EightOctetKeyId (EightOctetKeyId) , FeatureFlag (FeatureSEIPDv2) , FileName (..) , Fingerprint (Fingerprint, unFingerprint) @@ -161,7 +163,7 @@ , KeyPktSecretSubkey ) , KeyPktKind (SecretPkt) - , KeyVersion (V4, V6) + , KeyVersion (DeprecatedV3, V4, V6) , LiteralDataType (BinaryData, TextData, UTF8Data) , MPI (..) , PKESKEncryptError (..) @@ -192,6 +194,7 @@ ( DeprecatedRSAEncryptOnly , DeprecatedRSASignOnly , ECDH + , ECDSA , Ed25519 , Ed448 , EdDSALegacy @@ -262,6 +265,7 @@ ( AES128 , AES192 , AES256 + , Blowfish , CAST5 , IDEA , OtherSA @@ -327,7 +331,8 @@ import Crypto.Error (eitherCryptoError) import qualified Crypto.Hash as CH import qualified Crypto.Hash.Algorithms as CHA -import Crypto.Number.Serialize (i2ospOf_, os2ip) +import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448 import qualified Crypto.PubKey.RSA as RSA @@ -338,7 +343,13 @@ import qualified Data.Binary as Bin import Data.Binary.Get (runGet) import Data.Binary.Put - ( runPut + ( Put + , putByteString + , putLazyByteString + , putWord16be + , putWord32be + , putWord8 + , runPut ) import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import qualified Data.ByteArray as BA @@ -381,6 +392,7 @@ , stripPrefix ) import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import Data.Maybe ( catMaybes , fromMaybe @@ -405,7 +417,7 @@ import Data.Time.Format.ISO8601 (iso8601ParseM) import qualified Data.Vector as V import Data.Version (showVersion) -import Data.Word (Word8) +import Data.Word (Word16, Word8) import GHC.Generics import Options.Applicative.Builder ( argument @@ -3059,6 +3071,7 @@ canSignDataUsage (fkufs k) && case fmska k of Just (SUSUnprotected (RSAPrivateKey (RSA_PrivateKey _)) _) -> True + Just (SUSUnprotected (ECDSAPrivateKey (ECDSA_PrivateKey _)) _) -> True Just (SUSUnprotected (EdDSAPrivateKey _ _) _) -> True Just (SUSUnprotected (Ed25519PrivateKey _) _) -> True Just (SUSUnprotected (Ed448PrivateKey _) _) -> True @@ -3144,6 +3157,12 @@ usd payload rawBytes + Just + (SUSUnprotected (ECDSAPrivateKey (ECDSA_PrivateKey ecPriv)) _) -> + if _keyVersion signerPKP == V6 + then + doECDSAV6Signing signerPKP ecPriv signHash st hsd usd payload + else signWithECDSAV4 ecPriv signHash st hsd usd payload Just (SUSUnprotected (UnknownSKey rawBytes) _) -> case () of _ @@ -3231,6 +3250,116 @@ (ctx ++ " failed: unable to resolve v6 signature salt size") else go (expectedLen : rest) (expectedLen : tried) Left err -> failWith BadData (ctx ++ " failed: " ++ renderSignError err) + doECDSAV6Signing _signerPKP ecPriv signHash st hsd usd payload = do + salt <- pickECDSASalt signHash [32, 64, 16, 20, 28, 48] + let prehashBytes = buildV6Prehash ecPriv signHash st salt hsd payload + sigMaybe <- ecdsaDispatchSign signHash ecPriv prehashBytes + case sigMaybe of + Nothing -> + failWith + UnsupportedAsymmetricAlgo + ( ctx + ++ " failed: ECDSA signing requires hash algorithm matching the curve (got " + ++ show signHash + ++ ")" + ) + Just sig -> do + case left16FromHashDigest prehashBytes of + Nothing -> + failWith + BadData + (ctx ++ " failed: signed payload too short to derive left16") + Just left16 -> + pure $ + SigV6 + st + ECDSA + signHash + salt + hsd + usd + left16 + (NE.fromList [MPI (ECDSA.sign_r sig), MPI (ECDSA.sign_s sig)]) + signWithECDSAV4 ecPriv signHash st hsd usd payload = do + let sig0 = + SigV4 + st + ECDSA + signHash + hsd + [] + 0 + (NE.fromList [MPI 0, MPI 0]) + payloadToSign = + BL.toStrict $ + BL.concat + [ ecdsaSignPayloadPlain st signHash hsd payload + , runPut (putPartialSigForSigV4 sig0) + , runPut (putSigTrailerForSigV4 sig0) + ] + digest = + ecdsaHashDigest signHash payloadToSign + sigMaybe <- ecdsaDispatchSign signHash ecPriv digest + case sigMaybe of + Nothing -> + failWith + UnsupportedAsymmetricAlgo + ( ctx + ++ " failed: ECDSA signing requires hash algorithm matching the curve (got " + ++ show signHash + ++ ")" + ) + Just sig -> do + let mpis = NE.fromList [MPI (ECDSA.sign_r sig), MPI (ECDSA.sign_s sig)] + case left16FromHashDigest payloadToSign of + Nothing -> + failWith + BadData + (ctx ++ " failed: signed payload too short to derive left16") + Just left16 -> + pure $ + SigV4 st ECDSA signHash hsd usd left16 mpis + signWithECDSAV6 ecPriv signHash st salt hsd usd payload = do + let sig0 = + SigV6 + st + ECDSA + signHash + salt + hsd + [] + 0 + (NE.fromList [MPI 0, MPI 0]) + payloadToSign = + BL.toStrict $ + BL.concat + [ BL.fromStrict (unSignatureSalt salt) + , ecdsaSignPayloadPlain st signHash hsd payload + , runPut (putPartialSigForSigV6 sig0) + , runPut (putSigTrailerForSigV6 sig0) + ] + digest = + ecdsaHashDigest signHash payloadToSign + sigMaybe <- ecdsaDispatchSign signHash ecPriv digest + case sigMaybe of + Nothing -> + failWith + UnsupportedAsymmetricAlgo + ( ctx + ++ " failed: ECDSA signing requires hash algorithm matching the curve (got " + ++ show signHash + ++ ")" + ) + Just sig -> do + let mpis = NE.fromList [MPI (ECDSA.sign_r sig), MPI (ECDSA.sign_s sig)] + case left16FromHashDigest payloadToSign of + Nothing -> + failWith + BadData + (ctx ++ " failed: signed payload too short to derive left16") + Just left16 -> + pure $ + SigV6 st ECDSA signHash salt hsd usd left16 mpis signWithRSABuilder hashToUse privateKey = let builder = SP.addUnhashedSubs @@ -3243,35 +3372,190 @@ Left err -> failWith BadData (ctx ++ " failed: " ++ renderSignError err) Right sig -> pure sig - signWithEd25519SecretKey ctx signerPKP st signHash hsd usd payload rawBytes = - case eitherCryptoError (Ed25519.secretKey rawBytes) of - Left err -> - failWith - BadData - (ctx ++ " failed: bad Ed25519 secret key: " ++ show err) - Right sk - | _keyVersion signerPKP == V6 -> signEd25519 sk - | isEdDSAPKA (_pkalgo signerPKP) -> - case signDataWithEd25519Legacy signHash st sk hsd usd payload of - Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err') - Right sig -> pure sig - | otherwise -> - case signDataWithEd25519 signHash st sk hsd usd payload of - Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err') - Right sig -> pure sig - signWithEd448SecretKey ctx signerPKP st signHash hsd usd payload rawBytes = - case eitherCryptoError (Ed448.secretKey rawBytes) of - Left err -> - failWith - BadData - (ctx ++ " failed: bad Ed448 secret key: " ++ show err) - Right sk - | _keyVersion signerPKP == V6 -> signEd448 sk - | otherwise -> - case signDataWithEd448 signHash st sk hsd usd payload of - Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err') - Right sig -> pure sig +signWithEd25519SecretKey ctx signerPKP st signHash hsd usd payload rawBytes = + case eitherCryptoError (Ed25519.secretKey rawBytes) of + Left err -> + failWith + BadData + (ctx ++ " failed: bad Ed25519 secret key: " ++ show err) + Right sk + | _keyVersion signerPKP == V6 -> + signWithV6Salt + ( \salt -> signDataWithEd25519V6 signHash st salt sk hsd usd payload + ) + | isEdDSAPKA (_pkalgo signerPKP) -> + case signDataWithEd25519Legacy signHash st sk hsd usd payload of + Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err') + Right sig -> pure sig + | otherwise -> + case signDataWithEd25519 signHash st sk hsd usd payload of + Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err') + Right sig -> pure sig +signWithEd448SecretKey ctx signerPKP st signHash hsd usd payload rawBytes = + case eitherCryptoError (Ed448.secretKey rawBytes) of + Left err -> + failWith + BadData + (ctx ++ " failed: bad Ed448 secret key: " ++ show err) + Right sk + | _keyVersion signerPKP == V6 -> + signWithV6Salt + (\salt -> signDataWithEd448V6 signHash st salt sk hsd usd payload) + | otherwise -> + case signDataWithEd448 signHash st sk hsd usd payload of + Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err') + Right sig -> pure sig +-- Module-level salt-driven v6 signer loop used by Ed25519/Ed448/RSA helpers +-- defined above. Returns IO SignaturePayload. +signWithV6Salt + :: (SignatureSalt -> Either SignError SignaturePayload) + -> IO SignaturePayload +signWithV6Salt signer = go [32, 64, 16, 20, 28, 48] [] + where + go [] _ = + failWith + BadData + "sign: unable to construct a valid v6 signature salt" + go (n : rest) tried = do + bytes <- getRandomBytes n + case signer (SignatureSalt bytes) of + Right sig -> pure sig + Left (SignV6SaltSizeMismatch _ expected _) -> + let expectedLen = fromIntegral expected + in if expectedLen `elem` tried + then + failWith + BadData + "sign: unable to resolve v6 signature salt size" + else go (expectedLen : rest) (expectedLen : tried) + Left err -> failWith BadData ("sign: " ++ renderSignError err) + +left16FromHashDigest :: B.ByteString -> Maybe Word16 +left16FromHashDigest bs + | B.length bs >= 2 = Just (fromIntegral (os2ip (B.take 2 bs))) + | otherwise = Nothing + +ecdsaSignPayloadPlain + :: SigType + -> HashAlgorithm + -> [SigSubPacket] + -> BL.ByteString + -> BL.ByteString +ecdsaSignPayloadPlain st _signHash _hsd payload = + case st of + CanonicalTextSig -> canonicalizeLineEndingsForTextSig payload + _ -> payload + +canonicalizeLineEndingsForTextSig + :: BL.ByteString -> BL.ByteString +canonicalizeLineEndingsForTextSig bs = + BL.pack (go (BL.unpack bs)) + where + go [] = [] + go (0x0d : 0x0a : xs) = 0x0a : go xs + go (0x0d : xs) = 0x0a : go xs + go (x : xs) = x : go xs + +buildV6Prehash + :: ECDSA.PrivateKey + -> HashAlgorithm + -> SigType + -> SignatureSalt + -> [SigSubPacket] + -> BL.ByteString + -> B.ByteString +buildV6Prehash _ecPriv signHash st salt hsd payload = + let sig0 = + SigV6 + st + ECDSA + signHash + salt + hsd + [] + 0 + (NE.fromList [MPI 0, MPI 0]) + in BL.toStrict $ + BL.concat + [ BL.fromStrict (unSignatureSalt salt) + , ecdsaSignPayloadPlain st signHash hsd payload + , runPut (putPartialSigForSigV6 sig0) + , runPut (putSigTrailerForSigV6 sig0) + ] + +pickECDSASalt :: HashAlgorithm -> [Int] -> IO SignatureSalt +pickECDSASalt _ sizes = do + bytes <- getRandomBytes (head sizes) + pure (SignatureSalt bytes) + +ecdsaHashDigest :: HashAlgorithm -> B.ByteString -> B.ByteString +ecdsaHashDigest SHA1 bs = hashToBS CH.SHA1 bs +ecdsaHashDigest SHA224 bs = hashToBS CH.SHA224 bs +ecdsaHashDigest SHA256 bs = hashToBS CH.SHA256 bs +ecdsaHashDigest SHA384 bs = hashToBS CH.SHA384 bs +ecdsaHashDigest SHA512 bs = hashToBS CH.SHA512 bs +ecdsaHashDigest SHA3_256 bs = hashToBS CH.SHA3_256 bs +ecdsaHashDigest SHA3_512 bs = hashToBS CH.SHA3_512 bs +ecdsaHashDigest RIPEMD160 bs = hashToBS CH.RIPEMD160 bs +ecdsaHashDigest DeprecatedMD5 bs = hashToBS CH.MD5 bs +ecdsaHashDigest _ bs = bs + +hashToBS + :: forall a. CH.HashAlgorithm a => a -> B.ByteString -> B.ByteString +hashToBS alg bs = BA.convert (CH.hashWith alg bs :: CH.Digest a) + +ecdsaDispatchSign + :: HashAlgorithm + -> ECDSA.PrivateKey + -> B.ByteString + -> IO (Maybe ECDSA.Signature) +ecdsaDispatchSign SHA256 pk bs = Just <$> ECDSA.sign pk (CH.SHA256 :: CH.SHA256) bs +ecdsaDispatchSign SHA384 pk bs = Just <$> ECDSA.sign pk (CH.SHA384 :: CH.SHA384) bs +ecdsaDispatchSign SHA512 pk bs = Just <$> ECDSA.sign pk (CH.SHA512 :: CH.SHA512) bs +ecdsaDispatchSign SHA3_256 pk bs = Just <$> ECDSA.sign pk (CH.SHA3_256 :: CH.SHA3_256) bs +ecdsaDispatchSign SHA3_512 pk bs = Just <$> ECDSA.sign pk (CH.SHA3_512 :: CH.SHA3_512) bs +ecdsaDispatchSign _ _ _ = pure Nothing + +putPartialSigForSigV4 :: SignaturePayload -> Put +putPartialSigForSigV4 (SigV4 st pka ha hashed _ _ _) = do + putWord8 4 + Bin.put st + Bin.put pka + Bin.put ha + let hb = runPut (mapM_ Bin.put hashed) + putWord16be . fromIntegral . BL.length $ hb + putLazyByteString hb +putPartialSigForSigV4 _ = error "putPartialSigForSigV4: not a v4 sig" + +putPartialSigForSigV6 :: SignaturePayload -> Put +putPartialSigForSigV6 (SigV6 st pka ha _salt hashed _ _ _) = do + putWord8 6 + Bin.put st + Bin.put pka + Bin.put ha + let hb = runPut (mapM_ Bin.put hashed) + putWord32be . fromIntegral . BL.length $ hb + putLazyByteString hb +putPartialSigForSigV6 _ = error "putPartialSigForSigV6: not a v6 sig" + +putSigTrailerForSigV4 :: SignaturePayload -> Put +putSigTrailerForSigV4 (SigV4 _ _ _ hs _ _ _) = do + putWord8 0x04 + putWord8 0xff + putWord32be . fromIntegral . (+ 6) . BL.length $ + runPut $ + mapM_ Bin.put hs +putSigTrailerForSigV4 _ = error "putSigTrailerForSigV4: not a v4 sig" + +putSigTrailerForSigV6 :: SignaturePayload -> Put +putSigTrailerForSigV6 sig@(SigV6 {}) = do + putWord8 0x06 + putWord8 0xff + putWord32be . fromIntegral . BL.length $ + runPut (putPartialSigForSigV6 sig) +putSigTrailerForSigV6 _ = error "putSigTrailerForSigV6: not a v6 sig" + normalizeUnknownSecretForEdDSA :: String -> Int -> BL.ByteString -> IO B.ByteString normalizeUnknownSecretForEdDSA ctx expectedLen rawLbs @@ -5123,7 +5407,7 @@ symmetricOverride | useStrictEncryptProfile = preferredStrictSymmetric <|> Just AES256 - | otherwise = preferredLegacySymmetric + | otherwise = preferredLegacySymmetric <|> Just AES256 isV6Recipient pkp = _keyVersion pkp == V6 useStrictEncryptProfile = case encryptProfile of @@ -5153,7 +5437,8 @@ -- Legacy profile fallback should not hard-fail on deprecated/unsupported -- recipient preferences (e.g. IDEA in AEADED interop fixtures). isSupportedLegacyEncryptSymmetric algo = - algo `elem` [AES128, AES192, AES256] + algo + `elem` [AES128, AES192, AES256, TripleDES, CAST5, IDEA, Blowfish] recipientTargetFor funkey = let recipient = fpkp funkey recipientNeedsV6PKESK = @@ -5395,6 +5680,9 @@ null passwordBytes && not (null keyCandidates) && any isLegacyRSAPKESK ciphertextPkts + | "Decrypt policy rejects" `isInfixOf` reason = + null passwordBytes + && not (null keyCandidates) | otherwise = False isLegacyRSAPKESK (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ pka _))) = pka == RSA || pka == DeprecatedRSAEncryptOnly @@ -5883,7 +6171,7 @@ else unlines successLines case outFile of Just path -> writeFileWithOutputExistsCheck "decrypt" path renderedOut - Nothing -> pure () + Nothing -> when (not (null successLines)) (putStr renderedOut) normalizeDecryptVerificationPackets :: [Pkt] -> IO [Pkt] normalizeDecryptVerificationPackets pkts = @@ -6968,7 +7256,22 @@ Just pkp -> case eightOctetKeyID pkp of Right keyId -> keyId == eoki - Left _ -> False + Left _ -> + case keyIdFromV3NonRSA pkp of + Just keyId -> keyId == eoki + Nothing -> False + +-- FIXME: this isn't great +keyIdFromV3NonRSA :: SomePKPayload -> Maybe EightOctetKeyId +keyIdFromV3NonRSA pkp = + case _keyVersion pkp of + DeprecatedV3 -> + let fp = fingerprint pkp + bs = unFingerprint fp + in if B.length bs >= 8 + then Just (EightOctetKeyId (B.drop (B.length bs - 8) bs)) + else Nothing + _ -> Nothing decodeCiphertextInput :: BL.ByteString -> IO BL.ByteString decodeCiphertextInput input = do diff --git a/hopenpgp-tools.cabal b/hopenpgp-tools.cabal --- a/hopenpgp-tools.cabal +++ b/hopenpgp-tools.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hopenpgp-tools -version: 0.25.10 +version: 0.25.11 synopsis: hOpenPGP-based command-line tools description: command-line tools for performing some OpenPGP-related operations homepage: https://salsa.debian.org/clint/hOpenPGP-tools @@ -25,7 +25,7 @@ , bytestring , conduit >= 1.3 , errors - , hOpenPGP >= 3.6 && < 3.7 + , hOpenPGP >= 3.6.3 && < 3.7 , lens , optparse-applicative >= 0.18.1 , prettyprinter >= 1.7 @@ -132,4 +132,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hopenpgp-tools.git - tag: hopenpgp-tools/0.25.10 + tag: hopenpgp-tools/0.25.11