hopenpgp-tools 0.25.10 → 0.25.11
raw patch · 2 files changed
+343/−40 lines, 2 filesdep ~hOpenPGP
Dependency ranges changed: hOpenPGP
Files
- hop.hs +340/−37
- hopenpgp-tools.cabal +3/−3
hop.hs view
@@ -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
hopenpgp-tools.cabal view
@@ -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