hopenpgp-tools 0.25.4 → 0.25.5

raw patch · 2 files changed

+66/−31 lines, 2 files

Files

• hop.hs +64/−29
• hopenpgp-tools.cabal +2/−2

@@ -106,7 +106,6 @@     , displayException     , evaluate     , throwIO-    , try     ) import Control.Lens ((^..)) import Control.Monad (forM, forM_, unless, when, (>=>))@@ -220,11 +219,16 @@     , value     ) import Options.Applicative.Extra-    ( customExecParser+    ( execParserPure     , helper     , hsubparser+    , renderFailure     )-import Options.Applicative.Types (Parser)+import Options.Applicative.Types+    ( CompletionResult (..)+    , Parser+    , ParserResult (..)+    ) import Prettyprinter     ( hardline     , list@@ -233,7 +237,7 @@     ) import Prettyprinter.Render.Text (hPutDoc) import System.Directory (doesFileExist)-import System.Environment (getArgs, lookupEnv)+import System.Environment (getArgs, getProgName, lookupEnv) import System.Exit     ( ExitCode (..)     , exitSuccess@@ -459,6 +463,7 @@     | IncompatibleOptions     | UnsupportedProfile     | UnsupportedSubcommand+    | PrimaryKeyBad     | CertUserIdNoMatch     | KeyCannotCertify @@ -481,6 +486,7 @@ failureCode IncompatibleOptions = 83 failureCode UnsupportedProfile = 89 failureCode UnsupportedSubcommand = 69+failureCode PrimaryKeyBad = 103 failureCode CertUserIdNoMatch = 107 failureCode KeyCannotCertify = 109 @@ -848,32 +854,37 @@     args <- getArgs     ensureKnownSubcommand knownSopSubcommands args     cpt <- getPOSIXTime-    exitCode <--        try-            ( do-                CliOptions {..} <--                    customExecParser-                        (prefs showHelpOnError)-                        ( info-                            (helper <*> versioner "hop" <*> cliP)-                            ( headerDoc (Just (banner "hop"))-                                <> progDesc "hOpenPGP Validator Tool"-                                <> footerDoc (Just (warranty "hop"))-                            )-                        )-                let _ = cliDebug-                dispatch cpt cliCommand-            )-            :: IO (Either ExitCode ())-    case exitCode of-        Left (ExitFailure n) ->-            exitWith-                ( if n == 1-                    then ExitFailure 19-                    else ExitFailure n+    let result =+            execParserPure+                (prefs showHelpOnError)+                ( info+                    (helper <*> versioner "hop" <*> cliP)+                    ( headerDoc (Just (banner "hop"))+                        <> progDesc "hOpenPGP SOP Tool"+                        <> footerDoc (Just (warranty "hop"))+                    )                 )-        Left _ -> exitWith (ExitFailure 1)-        Right () -> pure ()+                args+    case result of+        Success cliOptions -> do+            let _ = cliDebug cliOptions+            dispatch cpt (cliCommand cliOptions)+        Failure f -> do+            let (msg, ec) = renderFailure f "hop"+            case ec of+                ExitSuccess -> putStrLn msg >> exitSuccess+                ExitFailure 1+                    | "Invalid option" `isInfixOf` msg+                        || "Invalid argument" `isInfixOf` msg ->+                        hPutStrLn stderr msg >> exitWith (ExitFailure 37)+                    | otherwise ->+                        hPutStrLn stderr msg >> exitWith (ExitFailure 19)+                _ -> hPutStrLn stderr msg >> exitWith ec+        CompletionInvoked compl -> do+            progn <- getProgName+            msg <- execCompletion compl progn+            putStr msg+            exitSuccess  knownSopSubcommands :: [String] knownSopSubcommands =@@ -2191,6 +2202,26 @@                     ("revoke-key: failed to create revocation: " ++ show err)             Right sig -> pure (SignaturePkt sig) +hasBadPrimaryKey :: SomeTK -> Bool+hasBadPrimaryKey stk =+    primaryKeyTooSmallForVerification stk+        || hasHardPrimaryKeyRevocation stk++hasHardPrimaryKeyRevocation :: SomeTK -> Bool+hasHardPrimaryKeyRevocation stk =+    any isHardKeyRevocation (_tkRevs (someTKToPublicViewTK stk))+  where+    isHardKeyRevocation sig = case sig of+        SigV4 KeyRevocationSig _ _ hashedSubs _ _ _ ->+            any hasHardReason hashedSubs+        SigV6 KeyRevocationSig _ _ _ hashedSubs _ _ _ ->+            any hasHardReason hashedSubs+        _ -> False+      where+        hasHardReason (SigSubPacket _ (ReasonForRevocation reason _)) =+            not (reason `elem` [KeySuperseded, KeyRetiredAndNoLongerUsed])+        hasHardReason _ = False+ doUpdateKey :: POSIXTime -> UpdateKeyOptions -> IO () doUpdateKey cpt UpdateKeyOptions {..} = do     keyPasswordsRaw <-@@ -2227,6 +2258,10 @@         mapM             (unlockUpdateKeyMaterial "standard input" keyPasswords)             stdinTks+    when (any hasBadPrimaryKey stdinUnlocked) $+        failWith+            PrimaryKeyBad+            "update-key: primary key is too weak or hard-revoked"     updateUnlocked <-         mapM             (unlockUpdateKeyMaterial "update input" keyPasswords)

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                hopenpgp-tools-version:             0.25.4+version:             0.25.5 synopsis:            hOpenPGP-based command-line tools description:         command-line tools for performing some OpenPGP-related operations homepage:            https://salsa.debian.org/clint/hOpenPGP-tools@@ -130,4 +130,4 @@ source-repository this   type:     git   location: https://salsa.debian.org/clint/hopenpgp-tools.git-  tag:      hopenpgp-tools/0.25.4+  tag:      hopenpgp-tools/0.25.5