hopenpgp-tools 0.17 → 0.17.1
raw patch · 4 files changed
+46/−19 lines, 4 files
Files
- HOpenPGP/Tools/Common.hs +1/−1
- hkt.hs +3/−3
- hokey.hs +40/−13
- hopenpgp-tools.cabal +2/−2
HOpenPGP/Tools/Common.hs view
@@ -76,7 +76,7 @@ banner :: String -> Doc {-# INLINE banner #-} banner name = text name <+> text "(hopenpgp-tools)" <+> text (showVersion version) <> hardline- <> text "Copyright (C) 2012-2015 Clint Adams"+ <> text "Copyright (C) 2012-2016 Clint Adams" warranty :: String -> Doc {-# INLINE warranty #-}
hkt.hs view
@@ -1,5 +1,5 @@ -- hkt.hs: hOpenPGP key tool--- Copyright © 2013-2015 Clint Adams+-- Copyright © 2013-2016 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -162,7 +162,7 @@ <> showDefault <> help "output format" ) <*> switch ( long "filter" <> help "treat target as filter" )- <*> argument str ( metavar "TARGET" <> targetHelp )+ <*> (fromMaybe "" <$> optional (argument str ( metavar "TARGET" <> targetHelp ))) <*> pure "" <*> pure "" where@@ -182,7 +182,7 @@ <> ofhelp ) <*> pure Unstructured -- unused <*> switch ( long "filter" <> help "treat target as filter" )- <*> argument str ( metavar "TARGET" <> targetHelp )+ <*> (fromMaybe "" <$> optional (argument str ( metavar "TARGET" <> targetHelp ))) <*> pure "" <*> pure "" where
hokey.hs view
@@ -1,5 +1,5 @@ -- hokey.hs: hOpenPGP key tool--- Copyright © 2013-2015 Clint Adams+-- Copyright © 2013-2016 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -66,7 +66,7 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PPAL import Text.PrettyPrint.Free (colon, indent, linebreak, list, pretty, text, (<+>), Doc)-import System.Console.Terminfo.PrettyPrint (green, red, yellow, displayLn, Effect)+import System.Console.Terminfo.PrettyPrint (green, red, yellow, displayDoc, Effect) data KAS = KAS { pubkeyalgo :: Colored PubKeyAlgorithm@@ -93,6 +93,7 @@ , keyAlgorithmAndSize :: KAS , keyUIDsAndUAts :: FakeMap Text (Colored UIDReport) , keyBestOf :: Maybe UIDReport+ , keySubkeys :: [SubkeyReport] } deriving Generic data UIDReport = UIDReport {@@ -103,6 +104,13 @@ , uidRevocationStatus :: [RevocationStatus] } deriving Generic +data SubkeyReport = SubkeyReport {+ skFingerprint :: TwentyOctetFingerprint+ , skVer :: Colored KeyVersion+ , skCreationTime :: ThirtyTwoBitTimeStamp+ , skAlgorithmAndSize :: KAS+} deriving Generic+ data RevocationStatus = RevocationStatus { isRevoked :: Bool , revocationCode :: String@@ -114,6 +122,7 @@ instance (A.ToJSON a) => A.ToJSON (Colored a) instance A.ToJSON KeyReport instance A.ToJSON UIDReport+instance A.ToJSON SubkeyReport instance A.ToJSON b => A.ToJSON (FakeMap Text b) where toJSON = A.toJSON . Map.fromList . unFakeMap instance A.ToJSON RevocationStatus@@ -128,17 +137,20 @@ , keyFingerprint = key^.tkKey._1 & fingerprint , keyVer = key^.tkKey._1.keyVersion & colorizeKV , keyCreationTime = key^.tkKey._1.timestamp- , keyAlgorithmAndSize = KAS {- pubkeyalgo = key^.tkKey._1.pkalgo & colorizePKA- , pubkeysize = key^.tkKey._1.pubkey & colorizePKS . pubkeySize- , stringrep = (key^.tkKey._1.pubkey & either (const "unknown") show . pubkeySize) ++ (key^.tkKey._1.pkalgo & pkalgoAbbrev)- }+ , keyAlgorithmAndSize = kasIt (key^.tkKey._1) , keyUIDsAndUAts = FakeMap (map (\(x,y) -> (x, uidr (Just x) y)) (processedOrOrig^.tkUIDs) ++ map (uatspsToText *** uidr Nothing) (processedOrOrig^.tkUAts)) , keyBestOf = Nothing+ , keySubkeys = map checkSK (key^.tkSubs) } where processedOrOrig = either (const key) id processedTK processedTK = verifyTKWith (verifySigWith (verifyAgainstKeys [key])) (fmap posixSecondsToUTCTime mpt) . stripOlderSigs . stripOtherSigs $ key+ kasIt :: PKPayload -> KAS+ kasIt pkp = KAS {+ pubkeyalgo = pkp^.pkalgo & colorizePKA+ , pubkeysize = pkp^.pubkey & colorizePKS . pubkeySize+ , stringrep = (pkp^.pubkey & either (const "unknown") show . pubkeySize) ++ (pkp^.pkalgo & pkalgoAbbrev)+ } colorizeKV kv = uncurry Colored (if kv == V4 then (Just Green, Nothing) else (Just Red, Just "not a V4 key")) kv colorizePKA pka = uncurry Colored (if pka == RSA then (Just Green, Nothing) else (Just Yellow, Just "not an RSA key")) pka colorizePKS pks = uncurry Colored (colorizePKS' pks) (hush pks)@@ -217,17 +229,28 @@ newestWith p = take 1 . sortBy (comparing (Down . take 1 . sigcts)) . filter p -- FIXME: this is terrible hasheds (SigV4 _ _ _ xs _ _ _) = xs hasheds _ = []+ checkSK :: (Pkt, [SignaturePayload]) -> SubkeyReport+ checkSK (PublicSubkeyPkt pkp, sigs) = checkSK' pkp sigs+ checkSK (SecretSubkeyPkt pkp _, sigs) = checkSK' pkp sigs+ checkSK' pkp sigs = SubkeyReport {+ skFingerprint = fingerprint pkp+ , skVer = colorizeKV (pkp^.keyVersion)+ , skCreationTime = pkp^.timestamp+ , skAlgorithmAndSize = kasIt pkp+ } prettyKeyReport :: POSIXTime -> TK -> Doc Effect prettyKeyReport cpt key = do let keyReport = checkKey (Just cpt) key execWriter $ tell- ( linebreak <> text "Key has potential validity:" <+> text (keyStatus keyReport)- <> linebreak <> text "Key has fingerprint:" <+> pretty (SpacedFingerprint (keyFingerprint keyReport))- <> linebreak <> text "Checking to see if key is OpenPGPv4:" <+> coloredToColor (text . show) (keyVer keyReport)- <> linebreak <> (\kas -> text "Checking to see if key is RSA or DSA (>= 2048-bit):" <+> coloredToColor pretty (pubkeyalgo kas) <+> coloredToColor (maybe (text "unknown") pretty) (pubkeysize kas)) (keyAlgorithmAndSize keyReport)- <> linebreak <> text "Checking user-ID- and user-attribute-related items:"+ ( linebreak <> text "Key has potential validity" <> colon <+> text (keyStatus keyReport)+ <> linebreak <> text "Key has fingerprint" <> colon <+> pretty (SpacedFingerprint (keyFingerprint keyReport))+ <> linebreak <> text "Checking to see if key is OpenPGPv4" <> colon <+> coloredToColor (text . show) (keyVer keyReport)+ <> linebreak <> (\kas -> text "Checking to see if key is RSA or DSA (>= 2048-bit)" <> colon <+> coloredToColor pretty (pubkeyalgo kas) <+> coloredToColor (maybe (text "unknown") pretty) (pubkeysize kas)) (keyAlgorithmAndSize keyReport)+ <> linebreak <> text "Checking user-ID- and user-attribute-related items" <> colon <> mconcat (map (uidtrip (keyCreationTime keyReport) . gottabeabetterway) (unFakeMap (keyUIDsAndUAts keyReport)))+ <> linebreak <> text "Checking subkeys" <> colon+ <> mconcat (map (subkeyrep) (keySubkeys keyReport)) <> linebreak ) where@@ -246,6 +269,10 @@ <> linebreak <> indent 4 (text "Revocation reason" <> colon <+> list (map (text . T.unpack . revocationReason) (uidRevocationStatus ur))) keyExp ts ke = (show . pretty) ke ++ " = " ++ formatTime defaultTimeLocale "%c" (posixSecondsToUTCTime (realToFrac ts + realToFrac ke)) gottabeabetterway (a, Colored x y z) = (Colored x y a, z)+ subkeyrep skr = linebreak <> indent 2 (text "fpr" <> colon <+> pretty (SpacedFingerprint (skFingerprint skr)))+ <> linebreak <> indent 4 (text "version" <> colon <+> coloredToColor pretty (skVer skr))+ <> linebreak <> indent 4 (text "timestamp" <> colon <+> pretty (skCreationTime skr))+ <> linebreak <> indent 4 ((\kas -> text "algo/size" <> colon <+> coloredToColor pretty (pubkeyalgo kas) <+> coloredToColor (maybe (text "unknown") pretty) (pubkeysize kas)) (skAlgorithmAndSize skr)) jsonReport :: POSIXTime -> TK -> BL.ByteString jsonReport ps = A.encode . checkKey (Just ps)@@ -297,7 +324,7 @@ keys <- runResourceT $ CB.sourceHandle stdin $= conduitGet get $= conduitToTKsDropping $$ CL.consume output (lintOutputFormat o) cpt keys where- output Pretty cpt = mapM_ (displayLn . prettyKeyReport cpt)+ output Pretty cpt = mapM_ (displayDoc 0.8 . prettyKeyReport cpt) output JSON cpt = mapM_ (BL.putStr . flip BL.append (BL.singleton 0x0a) . jsonReport cpt) output YAML cpt = mapM_ (B.putStr . yamlReport cpt)
hopenpgp-tools.cabal view
@@ -1,5 +1,5 @@ name: hopenpgp-tools-version: 0.17+version: 0.17.1 synopsis: hOpenPGP-based command-line tools description: command-line tools for performing some OpenPGP-related operations homepage: http://floss.scru.org/hopenpgp-tools@@ -120,4 +120,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hopenpgp-tools.git- tag: hopenpgp-tools/0.17+ tag: hopenpgp-tools/0.17.1