hopenpgp-tools 0.25.9 → 0.25.10
raw patch · 10 files changed
+756/−187 lines, 10 filesdep ~hOpenPGP
Dependency ranges changed: hOpenPGP
Files
- HOpenPGP/Tools/Common/Armor.hs +90/−5
- HOpenPGP/Tools/Common/Common.hs +3/−3
- HOpenPGP/Tools/Common/HKP.hs +10/−6
- HOpenPGP/Tools/Common/TKUtils.hs +1/−2
- HOpenPGP/Tools/Common/WKD.hs +18/−10
- HOpenPGP/Tools/Hokey/Fetch.hs +1/−1
- HOpenPGP/Tools/Hokey/Lint/Policy.hs +8/−1
- hkt.hs +8/−0
- hop.hs +614/−156
- hopenpgp-tools.cabal +3/−3
HOpenPGP/Tools/Common/Armor.hs view
@@ -24,11 +24,23 @@ import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor (..))+import Codec.Encryption.OpenPGP.Serialize ()+import Codec.Encryption.OpenPGP.Types (Pkt (..))+import Control.Applicative (many)+import Control.Exception+ ( ErrorCall+ , catch+ , displayException+ , evaluate+ )+import qualified Data.Binary as Bin+import Data.Binary.Get (runGet) import qualified Data.ByteString.Lazy as BL import Data.Conduit (runConduitRes, (.|)) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL-import System.IO (stdin)+import System.Exit (ExitCode (ExitFailure), exitWith)+import System.IO (hPutStrLn, stderr, stdin) doDeArmor :: IO () doDeArmor = do@@ -36,9 +48,82 @@ let lbs = BL.fromChunks a case BL.uncons lbs of Just (firstByte, _)- | firstByte >= 0x80 -> BL.putStr lbs+ | firstByte >= 0x80 -> do+ packets <- parseBinaryPackets lbs+ validatePackets packets+ BL.putStr lbs | otherwise -> case (AA.decode (BL.toStrict lbs) :: Either String [Armor]) of- Right msgs -> BL.putStr $ BL.concat [bs | Armor _ _ bs <- msgs]- Left _ -> BL.putStr lbs- Nothing -> pure ()+ Right [] -> do+ hPutStrLn stderr "dearmor: no ASCII armor blocks found"+ exitWith (ExitFailure 41)+ Right msgs+ | length msgs /= 1 ->+ failBadData "dearmor: expected exactly one ASCII armor block"+ | otherwise -> do+ let payloads = [bs | Armor _ _ bs <- msgs]+ packets <- parseBinaryPackets (BL.concat payloads)+ validatePackets packets+ BL.putStr $ BL.concat payloads+ Left err -> do+ hPutStrLn stderr $ "dearmor: malformed ASCII armor: " ++ err+ exitWith (ExitFailure 41)+ Nothing -> failBadData "dearmor: no OpenPGP packets found"++parseBinaryPackets :: BL.ByteString -> IO [Pkt]+parseBinaryPackets bytes =+ evaluate (runGet (many Bin.get) bytes) `catch` parseFailure+ where+ parseFailure :: ErrorCall -> IO [Pkt]+ parseFailure err =+ failBadData+ ( "dearmor: malformed OpenPGP packet stream: "+ ++ displayException err+ )++validatePackets :: [Pkt] -> IO ()+validatePackets packets+ | null packets = failBadData "dearmor: no OpenPGP packets found"+ | any isBroken packets =+ failBadData "dearmor: malformed OpenPGP packet stream"+ | not (validShape packets) =+ failBadData "dearmor: unexpected OpenPGP packet sequence"+ | otherwise = pure ()+ where+ isBroken BrokenPacketPkt {} = True+ isBroken _ = False+ validShape ps =+ all isSignature ps+ || validKeyStream ps+ || validCiphertext ps+ || validInlineSigned ps+ isSignature SignaturePkt {} = True+ isSignature _ = False+ validKeyStream (SecretKeyPkt {} : _) = True+ validKeyStream (PublicKeyPkt {} : _) = True+ validKeyStream _ = False+ validCiphertext (firstPacket : rest) =+ isSessionKeyPacket firstPacket+ && not (null rest)+ && all isSessionKeyPacket (init rest)+ && isEncryptedPayloadPacket (last rest)+ validCiphertext _ = False+ isSessionKeyPacket PKESKPkt {} = True+ isSessionKeyPacket SKESKPkt {} = True+ isSessionKeyPacket _ = False+ validInlineSigned (firstPacket : rest) =+ any isLiteralDataPacket rest+ && (isOnePassSignaturePacket firstPacket || isSignature firstPacket)+ validInlineSigned _ = False+ isLiteralDataPacket LiteralDataPkt {} = True+ isLiteralDataPacket _ = False+ isOnePassSignaturePacket OnePassSignaturePkt {} = True+ isOnePassSignaturePacket _ = False+ isEncryptedPayloadPacket SymEncIntegrityProtectedDataPkt {} = True+ isEncryptedPayloadPacket SymEncDataPkt {} = True+ isEncryptedPayloadPacket _ = False++failBadData :: String -> IO a+failBadData message = do+ hPutStrLn stderr message+ exitWith (ExitFailure 41)
HOpenPGP/Tools/Common/Common.hs view
@@ -133,7 +133,7 @@ keyMatchesFingerprint = keyMatchesPKPred fingerprint keyMatchesEightOctetKeyId- :: Bool -> SomeTK -> Either String EightOctetKeyId -> Bool -- FIXME: refactor this somehow+ :: Bool -> SomeTK -> Either KeyIdError EightOctetKeyId -> Bool -- FIXME: refactor this somehow keyMatchesEightOctetKeyId = keyMatchesPKPred eightOctetKeyID keyMatchesExactUIDString :: Text -> SomeTK -> Bool@@ -143,8 +143,8 @@ keyMatchesUIDSubString uidstr stk = any (T.toLower uidstr `T.isInfixOf`) . map (T.toLower . fst)- . _tkUIDs $- someTKToPublicViewTK stk+ . _tkUIDs+ $ someTKToPublicViewTK stk keyMatchesPKPred :: Eq a => (SomePKPayload -> a) -> Bool -> SomeTK -> a -> Bool
HOpenPGP/Tools/Common/HKP.hs view
@@ -32,6 +32,7 @@ import Codec.Encryption.OpenPGP.Types ( Block (..) , Fingerprint+ , KeySelectionError (..) , SomePKPayload (..) , SomeTK (..) , TK (..)@@ -43,6 +44,7 @@ import Control.Lens ((^..)) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT (..), throwE)+import Data.Bifunctor (first) import Data.Binary (get, put) import Data.Binary.Put (runPut) import qualified Data.ByteString as B@@ -58,6 +60,7 @@ import Data.Conduit.Serialization.Binary (conduitGet) import Data.Data.Lens (biplate) import Data.Either (rights)+import qualified Data.Text as T import Data.Time.Clock.POSIX (getPOSIXTime) import Network.HTTP.Client ( Response (..)@@ -85,7 +88,7 @@ :: String -> FetchValidationMethod -> Fingerprint- -> ExceptT String IO [SomeTK]+ -> ExceptT KeySelectionError IO [SomeTK] fetchKeys ks fvm q = do manager <- liftIO $ newManager tlsManagerSettings request <- liftIO $ parseUrlThrow (ks <> basereq)@@ -94,7 +97,9 @@ processedKeys <- if responseStatus response == ok200 then validateKeys (responseBody response)- else throwE ("HTTP status: " ++ show (responseStatus response))+ else+ throwE . KeySelectionParseError . T.pack $+ "HTTP status: " ++ show (responseStatus response) return $ map fst $ filter (fvp fvm . primaryPKP . snd) processedKeys@@ -112,12 +117,11 @@ ] validateKeys- :: BL.ByteString -> ExceptT String IO [(SomeTK, SomeTK)] -- FIXME: conduit fail+ :: BL.ByteString -> ExceptT KeySelectionError IO [(SomeTK, SomeTK)] -- FIXME: conduit fail validateKeys larmors = do bytestrings <-- ExceptT $- return $- fmap (mconcat . map armorToBS) (AA.decodeLazy larmors)+ ExceptT . return . first (KeySelectionParseError . T.pack) $+ fmap (mconcat . map armorToBS) (AA.decodeLazy larmors) keys <- liftIO . runConduitRes $ CB.sourceLbs bytestrings
HOpenPGP/Tools/Common/TKUtils.hs view
@@ -29,8 +29,7 @@ , defaultVerificationPolicy ) import Codec.Encryption.OpenPGP.Signatures- ( renderVerificationError- , verifyAgainstKeys+ ( verifyAgainstKeys , verifySigWith , verifyTKWith )
HOpenPGP/Tools/Common/WKD.hs view
@@ -28,7 +28,8 @@ , ArmorType (ArmorPublicKeyBlock) ) import Codec.Encryption.OpenPGP.Types- ( SomeTK (..)+ ( KeySelectionError (..)+ , SomeTK (..) , someTKToPublicViewTK , _tkUIDs )@@ -37,6 +38,7 @@ import Control.Monad.Trans.Except (ExceptT (..), throwE) import qualified Crypto.Hash as CH import qualified Crypto.Hash.Algorithms as CHA+import Data.Bifunctor (first) import Data.Binary (get) import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import qualified Data.ByteArray as BA@@ -74,15 +76,19 @@ fetchKeys :: FetchValidationMethod -> Text- -> ExceptT String IO [SomeTK]+ -> ExceptT KeySelectionError IO [SomeTK] fetchKeys fvm mailbox = do- parsedMailbox <- ExceptT . return $ parseMailbox mailbox+ parsedMailbox <-+ ExceptT . return . first (KeySelectionParseError . T.pack) $+ parseMailbox mailbox manager <- liftIO $ newManager tlsManagerSettings response <- fetchWKD manager parsedMailbox body <- if responseStatus response == ok200 then return (responseBody response)- else throwE ("HTTP status: " ++ show (responseStatus response))+ else+ throwE . KeySelectionParseError . T.pack $+ "HTTP status: " ++ show (responseStatus response) validateAndFilterKeys fvm parsedMailbox body parseMailbox :: Text -> Either String (Text, Text)@@ -100,7 +106,7 @@ fetchWKD :: Manager -> (Text, Text)- -> ExceptT String IO (Response BL.ByteString)+ -> ExceptT KeySelectionError IO (Response BL.ByteString) fetchWKD manager (localPart, domain) = do let localPartLower = T.toLower localPart hu = BC8.unpack . zbase32 . sha1 . TE.encodeUtf8 $ localPartLower@@ -131,7 +137,7 @@ :: FetchValidationMethod -> (Text, Text) -> BL.ByteString- -> ExceptT String IO [SomeTK]+ -> ExceptT KeySelectionError IO [SomeTK] validateAndFilterKeys fvm mailbox body = do keys <- decodeWkdResponse body cpt <- liftIO getPOSIXTime@@ -147,13 +153,14 @@ MatchPrimaryOrAnySubkeyFingerprint -> mailboxFiltered decodeWkdResponse- :: BL.ByteString -> ExceptT String IO [SomeTK]+ :: BL.ByteString -> ExceptT KeySelectionError IO [SomeTK] decodeWkdResponse body = if isArmored body then decodeArmored body else decodeBinary body -decodeBinary :: BL.ByteString -> ExceptT String IO [SomeTK]+decodeBinary+ :: BL.ByteString -> ExceptT KeySelectionError IO [SomeTK] decodeBinary bytes = liftIO . runConduitRes $ CB.sourceLbs bytes@@ -162,10 +169,11 @@ .| conduitDropErrorsAndNothings .| CL.consume -decodeArmored :: BL.ByteString -> ExceptT String IO [SomeTK]+decodeArmored+ :: BL.ByteString -> ExceptT KeySelectionError IO [SomeTK] decodeArmored larmors = do bytestrings <-- ExceptT . return $+ ExceptT . return . first (KeySelectionParseError . T.pack) $ fmap (mconcat . map armorToBS) (AA.decodeLazy larmors) liftIO . runConduitRes $ CB.sourceLbs bytestrings
HOpenPGP/Tools/Hokey/Fetch.hs view
@@ -48,5 +48,5 @@ HKP.fetchKeys (keyServer o) (fetchValidation o) fp WKD -> WKD.fetchKeys (fetchValidation o) (T.pack (fetchQuery o)) case ekeys of- Left e -> hPutStrLn stderr $ "error fetching keys: " ++ e+ Left e -> hPutStrLn stderr $ "error fetching keys: " ++ show e Right ks -> B.putStr $ rearmorKeys ks
HOpenPGP/Tools/Hokey/Lint/Policy.hs view
@@ -464,7 +464,14 @@ kasIt :: SomePKPayload -> Result KAS kasIt pkp =- kasIt' (_pkalgo pkp) (_keyVersion pkp) (_pubkey pkp & pubkeySize)+ kasIt'+ (_pkalgo pkp)+ (_keyVersion pkp)+ (mapLeft show (_pubkey pkp & pubkeySize))+ where+ mapLeft :: (a -> b) -> Either a c -> Either b c+ mapLeft f (Left x) = Left (f x)+ mapLeft _ (Right x) = Right x kasIt' :: PubKeyAlgorithm -> KeyVersion -> Either String Int -> Result KAS
hkt.hs view
@@ -37,6 +37,7 @@ ( EightOctetKeyId , Fingerprint , HashAlgorithm (..)+ , KeySelectionError (..) , PublicKey (..) , PublicKeyring , SigSubPacket (_sspPayload)@@ -435,6 +436,13 @@ banner' stderr >> hFlush stderr >> doExportPubkeys o dispatch (CmdGraph o) = banner' stderr >> hFlush stderr >> doGraph o dispatch (CmdFindPaths o) = banner' stderr >> hFlush stderr >> doFindPaths o++instance Semigroup KeySelectionError where+ KeySelectionParseError a <> KeySelectionParseError b =+ KeySelectionParseError (a <> b)++instance Monoid KeySelectionError where+ mempty = KeySelectionParseError mempty main :: IO () main = do
hop.hs view
@@ -18,6 +18,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA@@ -27,13 +28,10 @@ ) import Codec.Encryption.OpenPGP.CFB (encryptNoNonce) import Codec.Encryption.OpenPGP.Compression- ( CompressionError- , decompressPkt- , renderCompressionError+ ( decompressPkt ) import Codec.Encryption.OpenPGP.Encrypt- ( PKESKEncryptError (..)- , PKESKSessionMaterial (..)+ ( PKESKSessionMaterial (..) , RecipientEncryptRequest (..) , RecipientEncryptRequestOverrides (..) , RecipientEncryptResult (..)@@ -41,9 +39,10 @@ , RecipientPayloadShape (..) , defaultRecipientPayloadShape , encryptForRecipients+ , encryptSEIPDv2Payload+ , generateSessionKeyMaterial , recipientEncryptionTarget , recipientEncryptionTargetWithStrategyTyped- , renderPKESKEncryptError ) import Codec.Encryption.OpenPGP.Expirations ( effectiveKeyPreferencesAt@@ -85,29 +84,34 @@ , defaultPolicy , defaultVerificationPolicy , lenientDecryptPolicy+ , messageDefaultAEADAlgorithm+ , messageDefaultChunkSize+ , messageSEIPDv2SaltOctets+ , policyMessageEncryption ) import Codec.Encryption.OpenPGP.S2K ( decodeOpenPGPEncodedSessionKey- , renderS2KError , skesk2Key , skesk2SessionKey , string2Key )+import Codec.Encryption.OpenPGP.SEIPDv2+ ( aeadModeAndNonceSizeForSEIPDv2+ , deriveSKESK6KEK+ , encryptSKESK6SessionKey+ ) import Codec.Encryption.OpenPGP.SecretKey ( SecretKeyEncryptOptions (..) , decryptSecretKeyAddendum , encryptSecretKeyWithPolicy , reencryptSecretKey- , renderSecretKeyError ) import Codec.Encryption.OpenPGP.Serialize ( parsePkts , putSKeyForPKPayload ) import Codec.Encryption.OpenPGP.Signatures- ( SignError (..)- , renderSignError- , signDataWithEd25519+ ( signDataWithEd25519 , signDataWithEd25519Legacy , signDataWithEd25519V6 , signDataWithEd448@@ -122,11 +126,193 @@ ) import qualified Codec.Encryption.OpenPGP.Subpackets as SP import Codec.Encryption.OpenPGP.Types+ ( AEADAlgorithm (EAX, GCM, OCB)+ , Block (..)+ , CompressionAlgorithm (BZip2, Uncompressed, ZIP, ZLIB)+ , CompressionError+ , EdSigningCurve (EdSigningCurve25519, EdSigningCurve448)+ , EightOctetKeyId+ , FeatureFlag (FeatureSEIPDv2)+ , FileName (..)+ , Fingerprint (Fingerprint, unFingerprint)+ , HashAlgorithm+ ( DeprecatedMD5+ , OtherHA+ , RIPEMD160+ , SHA1+ , SHA224+ , SHA256+ , SHA384+ , SHA3_256+ , SHA3_512+ , SHA512+ )+ , IV (..)+ , IssuerFingerprintVersion+ ( IssuerFingerprintV4+ , IssuerFingerprintV6+ )+ , KeyFlag (..)+ , KeyIdentifier (..)+ , KeyPkt+ ( KeyPktPublicPrimary+ , KeyPktPublicSubkey+ , KeyPktSecretPrimary+ , KeyPktSecretSubkey+ )+ , KeyPktKind (SecretPkt)+ , KeyVersion (V4, V6)+ , LiteralDataType (BinaryData, TextData, UTF8Data)+ , MPI (..)+ , PKESKEncryptError (..)+ , PKESKPayload (PKESKPayloadV3Packet, PKESKPayloadV6Packet)+ , PKESKPayloadV3 (..)+ , PKESKPayloadV6 (..)+ , PKPayload+ , PKey (..)+ , Passphrase (..)+ , Pkt+ ( BrokenPacketPkt+ , CompressedDataPkt+ , LiteralDataPkt+ , MarkerPkt+ , OnePassSignaturePkt+ , OtherPacketPkt+ , PKESKPkt+ , PublicKeyPkt+ , PublicSubkeyPkt+ , SKESKPkt+ , SecretKeyPkt+ , SecretSubkeyPkt+ , SignaturePkt+ , SymEncDataPkt+ , SymEncIntegrityProtectedDataPkt+ )+ , PubKeyAlgorithm+ ( DeprecatedRSAEncryptOnly+ , DeprecatedRSASignOnly+ , ECDH+ , Ed25519+ , Ed448+ , EdDSALegacy+ , ElgamalEncryptOnly+ , RSA+ , X25519+ , X448+ )+ , PublicKeyring+ , RSA_PrivateKey (..)+ , RevocationCode (KeyRetiredAndNoLongerUsed, KeySuperseded)+ , S2K (Argon2, IteratedSalted, OtherS2K, Simple)+ , SEIPDPayload (..)+ , SKAddendum+ ( SUSCFB+ , SUSLegacyCFB+ , SUSMalleableCFB+ , SUSUnprotected+ )+ , SKESK (SKESK4Packet)+ , SKESKPayload (SKESKPayloadV4Packet, SKESKPayloadV6Packet)+ , SKESKPayloadV4 (..)+ , SKESKPayloadV6 (..)+ , SKey+ ( ECDHPrivateKey+ , ECDSAPrivateKey+ , Ed25519PrivateKey+ , Ed448PrivateKey+ , EdDSAPrivateKey+ , ElGamalPrivateKey+ , RSAPrivateKey+ , UnknownSKey+ , X25519PrivateKey+ , X448PrivateKey+ )+ , Salt (..)+ , Salt16 (..)+ , Salt8 (..)+ , SecretKey (..)+ , SessionKey (..)+ , SigSubPacket (..)+ , SigSubPacketPayload+ ( EmbeddedSignature+ , Features+ , Issuer+ , IssuerFingerprint+ , KeyExpirationTime+ , KeyFlags+ , NotationData+ , OtherSigSub+ , PreferredAEADCiphersuites+ , PreferredCompressionAlgorithms+ , PreferredHashAlgorithms+ , PreferredSymmetricAlgorithms+ , PrimaryUserId+ , ReasonForRevocation+ , SigCreationTime+ , SigExpirationTime+ , UserDefinedSigSub+ )+ , SigType (..)+ , SignError (..)+ , SignaturePayload (SigV3, SigV4, SigV6, SigVOther)+ , SignatureSalt (..)+ , SomePKPayload (..)+ , SomeTK (SomePublicTK, SomeSecretTK)+ , SymmetricAlgorithm+ ( AES128+ , AES192+ , AES256+ , CAST5+ , IDEA+ , OtherSA+ , TripleDES+ )+ , TK (..)+ , TKKind (SecretTK)+ , ThirtyTwoBitDuration (..)+ , ThirtyTwoBitTimeStamp (..)+ , UserAttrSubPacket+ , UserAttribute (..)+ , UserId (..)+ , Verification (..)+ , fromFVal+ , fromUnknownToTK+ , fromUnknownToTKEither+ , keyPktPKPayload+ , keyPktToPkt+ , modifyTKSecretKeys+ , publicViewTK+ , renderCompressionError+ , renderPKESKEncryptError+ , renderS2KError+ , renderSEIPDv2Failure+ , renderSecretKeyError+ , renderSerializeError+ , renderSignError+ , someTKToPublicViewTK+ , someTKToSecretTK+ , someTKToUnknown+ , tkSecretKeyPairs+ , toFVal+ , _keyVersion+ , _pkalgo+ , _pubkey+ , _timestamp+ , _tkDirectKeySigs+ , _tkRevs+ , _tkSubs+ , _tkUAts+ , _tkUIDs+ , _v3exp+ , _verificationSignature+ , pattern PKPayload+ ) import qualified Codec.Encryption.OpenPGP.Version as HOV import Control.Applicative (many, optional, some, (<|>)) import Control.Error.Util (note) import Control.Exception- ( IOException+ ( ErrorCall+ , IOException , SomeException , catch , displayException@@ -258,7 +444,6 @@ , pretty , softline )-import Prettyprinter.Render.Text (hPutDoc) import System.Directory (doesFileExist) import System.Environment (getArgs, getProgName, lookupEnv) import System.Exit@@ -268,7 +453,6 @@ ) import System.IO ( BufferMode (..)- , Handle , hPutStrLn , hSetBuffering , stderr@@ -485,6 +669,7 @@ | IncompatibleOptions | UnsupportedProfile | UnsupportedSubcommand+ | AmbiguousInput | PrimaryKeyBad | CertUserIdNoMatch | KeyCannotCertify@@ -508,6 +693,7 @@ failureCode IncompatibleOptions = 83 failureCode UnsupportedProfile = 89 failureCode UnsupportedSubcommand = 69+failureCode AmbiguousInput = 73 failureCode PrimaryKeyBad = 103 failureCode CertUserIdNoMatch = 107 failureCode KeyCannotCertify = 109@@ -843,8 +1029,10 @@ ) ) -dispatch :: POSIXTime -> Command -> IO ()-dispatch cpt cmd' = dispatch' cpt cmd'+dispatch :: Bool -> POSIXTime -> Command -> IO ()+dispatch debug cpt cmd' = do+ when debug $ hPutStrLn stderr "hop: debug mode enabled"+ dispatch' cpt cmd' where dispatch' _ (VersionC o') = doVersion o' dispatch' _ (ListProfilesC o') = doListProfiles o'@@ -889,8 +1077,7 @@ args case result of Success cliOptions -> do- let _ = cliDebug cliOptions- dispatch cpt (cliCommand cliOptions)+ dispatch (cliDebug cliOptions) cpt (cliCommand cliOptions) Failure f -> do let (msg, ec) = renderFailure f "hop" case ec of@@ -1064,18 +1251,32 @@ let lbs = BL.fromChunks m armoredAlready = BLC8.pack "-----BEGIN PGP" == BL.take 14 lbs if armoredAlready- then BL.putStr lbs+ then do+ armors <-+ case AA.decodeLazy lbs of+ Left err -> failWith BadData ("armor: malformed ASCII armor: " ++ err)+ Right blocks -> pure blocks+ when (length armors /= 1) $+ failWith BadData "armor: expected exactly one ASCII armor block"+ case armors of+ [Armor _ _ payload] -> do+ packets <- decodeAllPackets payload `catch` armorFailure+ validateTransportPackets "armor" packets+ [_] -> pure ()+ _ -> pure ()+ BL.putStr lbs else do- let label' = guessLabel (decodeAllPackets lbs) lbs+ packets <- decodeAllPackets lbs `catch` armorFailure+ validateTransportPackets "armor" packets+ let label' = guessLabel packets packets a = Armor label' [] lbs BL.putStr $ AA.encodeLazy [a] where- decodeAllPackets lbs = runGet (many Bin.get) lbs guessLabel [] _ = ArmorMessage- guessLabel (pkt : _) lbs =+ guessLabel (pkt : _) packets = case pkt of SignaturePkt _ ->- if all isSignaturePacket (decodeAllPackets lbs)+ if all isSignaturePacket packets then ArmorSignature else ArmorMessage SecretKeyPkt _ _ -> ArmorPrivateKeyBlock@@ -1084,6 +1285,60 @@ isSignaturePacket SignaturePkt {} = True isSignaturePacket _ = False +decodeAllPackets :: BL.ByteString -> IO [Pkt]+decodeAllPackets lbs = evaluate (runGet (many Bin.get) lbs)++armorFailure :: ErrorCall -> IO [Pkt]+armorFailure err =+ failWith+ BadData+ ( "armor: failed to parse OpenPGP packets: "+ ++ displayException err+ )++validateTransportPackets :: String -> [Pkt] -> IO ()+validateTransportPackets context packets+ | null packets =+ failWith BadData (context ++ ": no OpenPGP packets found")+ | any isBrokenTransportPacket packets =+ failWith BadData (context ++ ": malformed OpenPGP packet stream")+ | not (validTransportShape packets) =+ failWith+ BadData+ (context ++ ": unexpected OpenPGP packet sequence")+ | otherwise =+ pure ()+ where+ isBrokenTransportPacket BrokenPacketPkt {} = True+ isBrokenTransportPacket _ = False+ validTransportShape ps =+ all isSignature ps+ || validKeyStream ps+ || validCiphertext ps+ || validInlineSigned ps+ isSignature SignaturePkt {} = True+ isSignature _ = False+ validKeyStream (SecretKeyPkt {} : _) = True+ validKeyStream (PublicKeyPkt {} : _) = True+ validKeyStream _ = False+ validCiphertext (firstPacket : rest) =+ isSessionKeyPacket firstPacket+ && not (null rest)+ && all isSessionKeyPacket (init rest)+ && isEncryptedPayloadPacket (last rest)+ validCiphertext _ = False+ isSessionKeyPacket PKESKPkt {} = True+ isSessionKeyPacket SKESKPkt {} = True+ isSessionKeyPacket _ = False+ validInlineSigned (firstPacket : rest) =+ any isLiteralDataPacket rest+ && (isOnePassSignaturePacket firstPacket || isSignature firstPacket)+ validInlineSigned _ = False+ isLiteralDataPacket LiteralDataPkt {} = True+ isLiteralDataPacket _ = False+ isOnePassSignaturePacket OnePassSignaturePkt {} = True+ isOnePassSignaturePacket _ = False+ doVersion :: VersionOptions -> IO () doVersion VersionOptions {..} = do let selected = length (filter id [vBackend, vExtended, vSopSpec, vSopv])@@ -1102,9 +1357,9 @@ , "built with hOpenPGP " ++ HOV.version ] when vSopSpec $- putStrLn "draft-dkg-openpgp-stateless-cli-16"+ putStrLn "~draft-dkg-openpgp-stateless-cli-16" when vSopv $- putStrLn "1.0"+ putStrLn "1.2" unless (vBackend || vExtended || vSopSpec || vSopv) $ putStrLn $ "hop " ++ showVersion version@@ -1147,6 +1402,7 @@ doGenerateKey pt KeyGenOptions {..} = do profile <- parseKeyGenProfile keyProfile password <- parseGenerateKeyPassword keyPassword+ mapM_ validateGenerateKeyUserId userIds let ts = ThirtyTwoBitTimeStamp (floor pt) keyVersion = keyVersionForProfile profile result <- runTKGen (keyVersion, ts) $ do@@ -1242,15 +1498,24 @@ <|> profileValue <$> find (\p -> name `elem` profileAliases p) profiles +validProfileName :: String -> Bool+validProfileName name =+ not (null name) && not (any isSpace name)+ parseKeyGenProfile :: Maybe String -> IO KeyGenProfile parseKeyGenProfile Nothing = pure KeyGenSecurity parseKeyGenProfile (Just name) =- case resolveProfile name keyGenProfiles of- Just p -> pure p- Nothing ->+ if not (validProfileName name)+ then failWith UnsupportedProfile- ("generate-key: unsupported profile " ++ name)+ ("generate-key: invalid profile name " ++ name)+ else case resolveProfile name keyGenProfiles of+ Just p -> pure p+ Nothing ->+ failWith+ UnsupportedProfile+ ("generate-key: unsupported profile " ++ name) keyVersionForProfile :: KeyGenProfile -> KeyVersion keyVersionForProfile KeyGenRFC4880 = V4@@ -1272,6 +1537,13 @@ . BL.toStrict ) +validateGenerateKeyUserId :: String -> IO ()+validateGenerateKeyUserId uid =+ when (T.any (== '\xFFFD') (T.pack uid)) $+ failWith+ ExpectedText+ "generate-key: USERID must be valid UTF-8 text"+ loadPasswordFiles :: String -> String -> [String] -> IO [BL.ByteString] loadPasswordFiles context optionName = mapM (loadPasswordFromFile context optionName)@@ -1288,27 +1560,51 @@ :: String -> String -> String -> FilePath -> IO BL.ByteString loadFromFile fileKind context optionName path = do case stripPrefix "@ENV:" path of- Just varName- | null varName ->- failWith- BadData- (context ++ ": empty environment variable name in " ++ optionName)- | otherwise -> do- envValue <- lookupEnv varName- case envValue of- Nothing ->- failWith- MissingInput- ( context- ++ ": environment variable not found for "- ++ optionName- ++ ": "- ++ varName- )- Just envVal -> pure (BLC8.pack envVal)+ Just varName -> do+ doesFileExist path >>= \exists ->+ when exists $+ failWith+ AmbiguousInput+ ( context+ ++ ": indirect input designator "+ ++ optionName+ ++ " ("+ ++ path+ ++ ") collides with a file of the same name"+ )+ if null varName+ then+ failWith+ BadData+ (context ++ ": empty environment variable name in " ++ optionName)+ else do+ envValue <- lookupEnv varName+ case envValue of+ Nothing ->+ failWith+ MissingInput+ ( context+ ++ ": environment variable not found for "+ ++ optionName+ ++ ": "+ ++ varName+ )+ Just envVal -> pure (BLC8.pack envVal) Nothing -> case stripPrefix "@FD:" path of- Just fdSpec -> loadFromFD context optionName fdSpec+ Just fdSpec -> do+ doesFileExist path >>= \exists ->+ when exists $+ failWith+ AmbiguousInput+ ( context+ ++ ": indirect input designator "+ ++ optionName+ ++ " ("+ ++ path+ ++ ") collides with a file of the same name"+ )+ loadFromFD context optionName fdSpec Nothing -> case path of '@' : _ ->@@ -1458,7 +1754,7 @@ Left err -> Left (renderS2KError err) Right keyMaterial -> case putSKeyForPKPayload pkp skey of- Left err -> Left err+ Left err -> Left (renderSerializeError err) Right putAction -> let cleartext = runPut putAction sha1Checksum =@@ -1698,7 +1994,7 @@ case sequence changed of Left err -> failWith- BadData+ KeyIsProtected err Right rewrittenTks -> let output = runPut (mapM_ (Bin.put . someTKToUnknown) rewrittenTks)@@ -1754,6 +2050,10 @@ validateAtTime <- verificationUpperBound cpt validateUserIdAt input <- runConduitRes $ CB.sourceHandle stdin .| CC.sinkLazy certPkts <- decodeOpenPGPInput "standard input" input+ rejectSecretKeyPackets+ "validate-userid"+ "standard input"+ certPkts certTks <- runConduitRes $ CL.sourceList certPkts@@ -1881,6 +2181,7 @@ "certify-userid: no signer certificate found" input <- runConduitRes $ CB.sourceHandle stdin .| CC.sinkLazy certPkts <- decodeOpenPGPInput "standard input" input+ rejectSecretKeyPackets "certify-userid" "standard input" certPkts targetTks <- runConduitRes $ CL.sourceList certPkts@@ -2180,11 +2481,19 @@ BadData ("revoke-key: failed: " ++ show err) Right sig -> pure sig- let output = runPut (mapM_ Bin.put revocationSigPkts)+ let mergedCerts =+ zipWith+ ( \sk sig ->+ let pubTk = someTKToPublicViewTK (SomeSecretTK sk)+ in SomePublicTK pubTk {_tkRevs = _tkRevs pubTk ++ [sig]}+ )+ secretKeyTks+ revocationSigPkts+ output = runPut (mapM_ (Bin.put . someTKToUnknown) mergedCerts) BL.putStr $ if revokeKeyNoArmor then output- else AA.encodeLazy [Armor ArmorSignature [] output]+ else AA.encodeLazy [Armor ArmorPublicKeyBlock [] output] hasBadPrimaryKey :: TK 'SecretTK -> Bool hasBadPrimaryKey tk =@@ -2313,6 +2622,7 @@ stdinInput <- runConduitRes $ CB.sourceHandle stdin .| CC.sinkLazy stdinPkts <- decodeOpenPGPInput "stdin" stdinInput+ rejectSecretKeyPackets "merge-certs" "stdin" stdinPkts stdinTks <- runConduitRes $ CL.sourceList stdinPkts@@ -2322,7 +2632,7 @@ mergeInTks <- concat <$> mapM- (\p -> loadVerifyTKsFromFile "merge-certs" p)+ (\p -> loadCertTKsFromFile "merge-certs" p) mergeCertsFiles let mergedTks = mergeCertificatesForOutput stdinTks mergeInTks output = runPut (mapM_ (Bin.put . someTKToUnknown) mergedTks)@@ -2893,9 +3203,9 @@ ( \salt -> signDataWithRSAV6Builder ( SP.addUnhashedSubs- (SubpacketList usd)+ (SP.listToUnhashedSubs usd) ( SP.addHashedSubs- (SubpacketList hsd)+ (SP.listToHashedSubs hsd) (SP.sigBuilderInitV6 st signHash salt) ) )@@ -2924,9 +3234,9 @@ signWithRSABuilder hashToUse privateKey = let builder = SP.addUnhashedSubs- (SubpacketList usd)+ (SP.listToUnhashedSubs usd) ( SP.addHashedSubs- (SubpacketList hsd)+ (SP.listToHashedSubs hsd) (SP.sigBuilderInit st hashToUse) ) in case signDataWithRSABuilder builder privateKey payload of@@ -3001,7 +3311,7 @@ Left err -> failWith BadData- (ctx ++ " failed: unable to determine RSA key size: " ++ err)+ (ctx ++ " failed: unable to determine RSA key size: " ++ show err) -- ============================== -- update-key modernization helpers@@ -3895,6 +4205,7 @@ _ -> "" where signatureMicalg (SigV4 _ _ ha _ _ _ _) = hashAlgorithmMicalg ha+ signatureMicalg (SigV6 _ _ ha _ _ _ _ _) = hashAlgorithmMicalg ha signatureMicalg _ = Nothing hashAlgorithmMicalg DeprecatedMD5 = Just "pgp-md5" hashAlgorithmMicalg SHA1 = Just "pgp-sha1"@@ -4047,7 +4358,7 @@ doVerify cpt VerifyOptions {..} = do (krs, verifyTks) <- loadVerifyContext cpt verifyCertFiles signatureInput <-- runConduitRes $ CC.sourceFile verifySigFile .| CC.sinkLazy+ loadInputFromFile "verify" "signature file" verifySigFile sigPkts <- decodeLikeSignaturePackets signatureInput let sigs = V.fromList (filter isDetachedVerificationSignaturePkt sigPkts) blob <- runConduitRes $ CB.sourceHandle stdin .| CC.sinkLazy@@ -4597,69 +4908,151 @@ -> Maybe String -> IO BL.ByteString doEncryptWithPassword encryptProfile payload passwords sessionKeyOutFile = do- password <-- case passwords of- [] ->- failWith- MissingArg- "encrypt: supply at least one recipient certificate or --with-password"- [p] -> pure p- _ ->- failWith- UnsupportedOption- "encrypt: multiple --with-password values are not yet supported"- let exposure =- if isJust sessionKeyOutFile- then ExposeSessionMaterial- else DoNotExposeSessionMaterial- encrypted <-- case encryptProfile of- EncryptProfileRFC9580 -> do- s2kSalt <- Salt16 <$> getRandomBytes 16- iv <- IV <$> getRandomBytes 32- pure $- encryptMessage- RFC9580EncryptMessageOptions- { rfc9580EncryptMessageExposure = exposure- , rfc9580EncryptMessageSymmetricAlgorithm = AES256- , rfc9580EncryptMessageS2K = Argon2 s2kSalt 1 4 15- , rfc9580EncryptMessageIV = iv- }- password- (mkClearPayload payload)- EncryptProfileRFC4880 -> do- salt <- Salt8 <$> getRandomBytes 8- iv <- IV <$> getRandomBytes 16- pure $- encryptMessage- RFC4880EncryptMessageOptions- { rfc4880EncryptMessageExposure = exposure- , rfc4880EncryptMessageSymmetricAlgorithm = AES256- , rfc4880EncryptMessageS2K = IteratedSalted SHA256 salt 65536- , rfc4880EncryptMessageIV = iv- }- password- (mkClearPayload payload)- case encrypted of- Left err -> failWith BadData ("encrypt failed: " ++ show err)- Right (ciphertext, mRecoveredSession) -> do- forM_ sessionKeyOutFile $ \path ->- case mRecoveredSession of- Just recoveredSession ->- writeFileWithOutputExistsCheck- "encrypt"- path- ( renderSessionKeyOutLine- (fromFVal (recoveredSessionAlgorithm recoveredSession))- (unSessionKey (recoveredSessionKey recoveredSession))- ++ "\n"- )- Nothing ->- failWith- UnsupportedOption- "encrypt: --session-key-out unavailable for this password encryption mode"- pure (encryptedPayloadBytes ciphertext)+ case passwords of+ [] ->+ failWith+ MissingArg+ "encrypt: supply at least one recipient certificate or --with-password"+ [p] ->+ encryptWithSinglePassword+ encryptProfile+ payload+ p+ sessionKeyOutFile+ _ ->+ case encryptProfile of+ EncryptProfileRFC9580 ->+ encryptWithSharedSessionKey payload passwords sessionKeyOutFile+ EncryptProfileRFC4880 ->+ failWith+ UnsupportedOption+ "encrypt: multiple --with-password values are not supported with the rfc4880 profile"+ where+ encryptWithSinglePassword prof pl pw skOut = do+ let exposure =+ if isJust skOut+ then ExposeSessionMaterial+ else DoNotExposeSessionMaterial+ encrypted <-+ case prof of+ EncryptProfileRFC9580 -> do+ s2kSalt <- Salt16 <$> getRandomBytes 16+ iv <- IV <$> getRandomBytes 32+ pure $+ encryptMessage+ RFC9580EncryptMessageOptions+ { rfc9580EncryptMessageExposure = exposure+ , rfc9580EncryptMessageSymmetricAlgorithm = AES256+ , rfc9580EncryptMessageS2K = Argon2 s2kSalt 1 4 15+ , rfc9580EncryptMessageIV = iv+ }+ pw+ (mkClearPayload pl)+ EncryptProfileRFC4880 -> do+ salt <- Salt8 <$> getRandomBytes 8+ iv <- IV <$> getRandomBytes 16+ pure $+ encryptMessage+ RFC4880EncryptMessageOptions+ { rfc4880EncryptMessageExposure = exposure+ , rfc4880EncryptMessageSymmetricAlgorithm = AES256+ , rfc4880EncryptMessageS2K = IteratedSalted SHA256 salt 65536+ , rfc4880EncryptMessageIV = iv+ }+ pw+ (mkClearPayload pl)+ case encrypted of+ Left err -> failWith BadData ("encrypt failed: " ++ show err)+ Right (ciphertext, mRecoveredSession) -> do+ forM_ skOut $ \path ->+ case mRecoveredSession of+ Just recoveredSession ->+ writeFileWithOutputExistsCheck+ "encrypt"+ path+ ( renderSessionKeyOutLine+ (fromFVal (recoveredSessionAlgorithm recoveredSession))+ (unSessionKey (recoveredSessionKey recoveredSession))+ ++ "\n"+ )+ Nothing ->+ failWith+ UnsupportedOption+ "encrypt: --session-key-out unavailable for this password encryption mode"+ pure (encryptedPayloadBytes ciphertext) + encryptWithSharedSessionKey pl pws skOut = do+ let messagePolicy = policyMessageEncryption defaultPolicy+ aead = messageDefaultAEADAlgorithm messagePolicy+ chunkSize = messageDefaultChunkSize messagePolicy+ saltOctets = messageSEIPDv2SaltOctets messagePolicy+ genRes <- generateSessionKeyMaterial AES256+ sessionMaterial <-+ either (failWith BadData . show) (pure . pkeskSessionKey) genRes+ let skBytes = unSessionKey sessionMaterial+ iv <- IV <$> getRandomBytes 32+ let salt = defaultSEIPDv2SaltFromIV saltOctets iv+ (_, nonceSize) <-+ either+ (failWith BadData . renderSEIPDv2Failure)+ pure+ (aeadModeAndNonceSizeForSEIPDv2 aead)+ let skeskIV = B.take nonceSize (unSalt salt)+ s2kSalt = Salt16 (B.take 16 (unSalt salt))+ s2k = Argon2 s2kSalt 1 4 15+ literalBlock =+ Block [LiteralDataPkt BinaryData (FileName B.empty) 0 pl]+ literalBytes = BL.toStrict (runPut (Bin.put literalBlock))+ encRes =+ encryptSEIPDv2Payload+ AES256+ aead+ chunkSize+ salt+ (SessionKey skBytes)+ literalBytes+ encBytes <-+ either (failWith BadData . renderSEIPDv2Failure) pure encRes+ let seipdPkt =+ SymEncIntegrityProtectedDataPkt+ (SEIPD2 AES256 aead chunkSize salt (BL.fromStrict encBytes))+ skeskPkts <- forM pws $ \pw -> do+ let keyLen = 32+ ikm <-+ either+ (failWith BadData . renderS2KError)+ pure+ (string2Key s2k keyLen (unPassphrase pw))+ kek <-+ either+ (failWith BadData . renderSEIPDv2Failure)+ pure+ (deriveSKESK6KEK AES256 aead ikm)+ (wrapped, tag) <-+ either+ (failWith BadData . renderSEIPDv2Failure)+ pure+ (encryptSKESK6SessionKey AES256 aead kek skeskIV skBytes)+ pure+ ( SKESKPkt+ ( SKESKPayloadV6Packet+ (SKESKPayloadV6 AES256 aead s2k skeskIV wrapped tag)+ )+ )+ let out = runPut (mapM_ Bin.put (skeskPkts ++ [seipdPkt]))+ forM_ skOut $ \path ->+ writeFileWithOutputExistsCheck+ "encrypt"+ path+ (renderSessionKeyOutLine (fromFVal AES256) skBytes ++ "\n")+ pure out++defaultSEIPDv2SaltFromIV :: Int -> IV -> Salt+defaultSEIPDv2SaltFromIV outputLen (IV ivBytes) =+ Salt (B.take outputLen (B.concat (replicate outputLen seed)))+ where+ seed = if B.null ivBytes then B.singleton 0 else ivBytes+ doEncryptForRecipients :: EncryptProfile -> AsBinaryText@@ -4833,20 +5226,23 @@ parseEncryptProfile :: Maybe String -> IO EncryptProfile parseEncryptProfile Nothing = pure EncryptProfileRFC9580 parseEncryptProfile (Just name) =- case resolveProfile name encryptProfiles of- Just p -> pure p- Nothing ->+ if not (validProfileName name)+ then failWith UnsupportedProfile- ("encrypt: unsupported profile " ++ name)+ ("encrypt: invalid profile name " ++ name)+ else case resolveProfile name encryptProfiles of+ Just p -> pure p+ Nothing ->+ failWith+ UnsupportedProfile+ ("encrypt: unsupported profile " ++ name) doDecrypt :: POSIXTime -> DecryptOptions -> IO () doDecrypt cpt DecryptOptions {..} = do sessionKeys <- parseDecryptSessionKeys decSessionKeys- verificationOutputPath <-- resolveDecryptVerificationsOut decVerificationsOutFile let hasVerifyWith = not (null decVerifyCerts)- hasVerifyOut = isJust verificationOutputPath+ hasVerifyOut = isJust decVerificationsOutFile hasVerifyBounds = isJust decVerifyNotBefore || isJust decVerifyNotAfter doingVerification = hasVerifyWith && hasVerifyOut when (hasVerifyWith /= hasVerifyOut) $@@ -5029,7 +5425,7 @@ doDecryptVerifyOutput cpt decVerifyCerts- verificationOutputPath+ decVerificationsOutFile decVerifyNotBefore decVerifyNotAfter decryptedPkts@@ -5229,13 +5625,14 @@ ("decrypt: invalid --with-session-key algorithm: " ++ algoSpec) decodeHexBytes :: String -> IO B.ByteString-decodeHexBytes hex =- if odd (length hex)- then- failWith- BadData- "decrypt: hex key material must have an even number of digits"- else B.pack <$> go hex+decodeHexBytes rawHex =+ let hex = filter (`notElem` (" \t\r\n\f\v" :: String)) rawHex+ in if odd (length hex)+ then+ failWith+ BadData+ "decrypt: hex key material must have an even number of digits"+ else B.pack <$> go hex where go [] = pure [] go (a : b : rest) = do@@ -5504,13 +5901,6 @@ BadData "decrypt failed: malformed signed message structure (multiple literal payloads)" -resolveDecryptVerificationsOut- :: Maybe String -> IO (Maybe String)-resolveDecryptVerificationsOut newPath =- pure $ case newPath of- Just p -> Just p- Nothing -> Nothing- renderSOPVerificationLine :: [SomeTK] -> Verification -> String renderSOPVerificationLine verifyTks v =@@ -5560,8 +5950,28 @@ :: String -> FilePath -> String -> IO () writeFileWithOutputExistsCheck subcommand path content = do ensureOutputPathAvailable subcommand path- writeFile path content+ outputPath <- outputPathForWrite subcommand path+ writeFile outputPath content `catch` outputFailure+ where+ outputFailure :: IOException -> IO ()+ outputFailure err =+ failWith+ BadData+ (subcommand ++ ": failed writing output: " ++ displayException err) +writeLazyByteStringWithOutputExistsCheck+ :: String -> FilePath -> BL.ByteString -> IO ()+writeLazyByteStringWithOutputExistsCheck subcommand path content = do+ ensureOutputPathAvailable subcommand path+ outputPath <- outputPathForWrite subcommand path+ BL.writeFile outputPath content `catch` outputFailure+ where+ outputFailure :: IOException -> IO ()+ outputFailure err =+ failWith+ BadData+ (subcommand ++ ": failed writing output: " ++ displayException err)+ parseOpenPGPPackets :: String -> BL.ByteString -> IO [Pkt] parseOpenPGPPackets context bytes = ( do@@ -5739,13 +6149,47 @@ noteLeft err = maybe (Left err) Right ensureOutputPathAvailable :: String -> FilePath -> IO ()-ensureOutputPathAvailable subcommand path = do- exists <- doesFileExist path- when exists $- failWith- OutputExists- (subcommand ++ ": output path already exists: " ++ path)+ensureOutputPathAvailable subcommand path =+ case stripPrefix "@ENV:" path of+ Just _ ->+ failWith+ UnsupportedSpecialPrefix+ (subcommand ++ ": @ENV: is not supported for output: " ++ path)+ Nothing ->+ case stripPrefix "@FD:" path of+ Just fdSpec ->+ case readMaybe fdSpec :: Maybe Int of+ Just fdNum+ | fdNum >= 0 -> pure ()+ _ ->+ failWith+ BadData+ (subcommand ++ ": invalid output file descriptor: " ++ path)+ Nothing+ | "@" `isPrefixOf` path ->+ failWith+ UnsupportedSpecialPrefix+ (subcommand ++ ": unsupported output prefix: " ++ path)+ | otherwise -> do+ exists <- doesFileExist path+ when exists $+ failWith+ OutputExists+ (subcommand ++ ": output path already exists: " ++ path) +outputPathForWrite :: String -> FilePath -> IO FilePath+outputPathForWrite subcommand path =+ case stripPrefix "@FD:" path of+ Just fdSpec ->+ case readMaybe fdSpec :: Maybe Int of+ Just fdNum+ | fdNum >= 0 -> pure ("/dev/fd/" ++ show fdNum)+ _ ->+ failWith+ BadData+ (subcommand ++ ": invalid output file descriptor: " ++ path)+ Nothing -> pure path+ loadVerifyContext :: POSIXTime -> [String] -> IO (PublicKeyring, [SomeTK]) loadVerifyContext _ certFiles = do@@ -6448,8 +6892,10 @@ partition ( \pkt -> case pkt of- PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid _ _)) ->- any (matchesRecipientIdentifier rid) keyInfos+ PKESKPkt+ (PKESKPayloadV6Packet (PKESKPayloadV6 (Just (_, fp)) _ _)) ->+ any (matchesRecipientIdentifier (unFingerprint fp)) keyInfos+ PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 Nothing _ _)) -> False PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ eoki _ _)) -> any (matchesLegacyRecipientKeyId eoki) keyInfos _ -> False@@ -6567,8 +7013,12 @@ signingKeys = filter isInlineRSASigner funkeys inlineSignHash = selectSigningHash signingKeys [] legacySigningHashFallbackOrder+ when (null processedKeys) $+ failWith MissingInput "inline-sign: no signing key found" when (null signingKeys) $- failWith MissingInput "inline-sign: no signing-capable key found"+ failWith+ KeyCannotSign+ "inline-sign: supplied key is not capable of signing" sigs <- mapM ( signInlineData@@ -6704,7 +7154,12 @@ splitInlineSigned lbs = do decodedArmors <- decodeAsciiArmorInput "inline-detach input" lbs case decodedArmors of- Just armors ->+ Just armors -> do+ let candidates = filter isInlineSignedArmorCandidate armors+ when (length candidates > 1) $+ failWith+ BadData+ "inline-detach: more than one inline-signed object found in input" case firstBy isInlineSignedArmorCandidate armors of Just (Armor ArmorMessage _ bs) -> parseOpenPGPPackets@@ -6997,7 +7452,10 @@ else BL.fromStrict (BLC8.toStrict (AA.encodeLazy [Armor ArmorSignature [] sigBytes]))- BL.writeFile outPath out+ writeLazyByteStringWithOutputExistsCheck+ "inline-detach"+ outPath+ out doListProfiles :: ListProfilesOptions -> IO () doListProfiles lpos =@@ -7024,5 +7482,5 @@ where aliasesSuffix p = case profileAliases p of [] -> ""- s : [] -> " (alias: " ++ s ++ ")"+ [s] -> " (alias: " ++ s ++ ")" as -> " (aliases: " ++ intercalate ", " as ++ ")"
hopenpgp-tools.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hopenpgp-tools-version: 0.25.9+version: 0.25.10 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.5 && < 3.6+ , hOpenPGP >= 3.6 && < 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.9+ tag: hopenpgp-tools/0.25.10