hopenpgp-tools 0.3 → 0.4
raw patch · 5 files changed
+188/−91 lines, 5 filesdep ~hOpenPGP
Dependency ranges changed: hOpenPGP
Files
- HOpenPGP/Tools/ExpressionParsing.hs +72/−0
- hkt.hs +36/−7
- hokey.hs +72/−50
- hopenpgp-tools.cabal +6/−4
- hot.hs +2/−30
+ HOpenPGP/Tools/ExpressionParsing.hs view
@@ -0,0 +1,72 @@+-- ExpressionParsing.hs: hOpenPGP tools expression parsing+-- Copyright © 2013-2014 Clint Adams+--+-- vim: softtabstop=4:shiftwidth=4:expandtab+--+-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU Affero General Public License as+-- published by the Free Software Foundation, either version 3 of the+-- License, or (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU Affero General Public License for more details.+--+-- You should have received a copy of the GNU Affero General Public License+-- along with this program. If not, see <http://www.gnu.org/licenses/>.++{-# LANGUAGE OverloadedStrings #-}++module HOpenPGP.Tools.ExpressionParsing (pPE) where+import Codec.Encryption.OpenPGP.Types+import Control.Applicative ((<$>), (<*>), (*>), (<|>), pure)+import qualified Data.Attoparsec.Text as A+import Data.Conduit.OpenPGP.Filter (conduitFilter, Expr(..), FilterPredicates(..), PKPPredicate(..), PKPVar(..), PKPOp(..), PKPValue(..), SPPredicate(..), SPVar(..), SPOp(..), SPValue(..), OPredicate(..), OVar(..), OOp(..), OValue(..))++pPE :: A.Parser (Expr PKPPredicate)+pPE = complex (anyP <|> simplePE)++complex :: A.Parser (Expr a) -> A.Parser (Expr a)+complex p = andP p <|> orP p <|> notP p <|> p++notP :: A.Parser (Expr a) -> A.Parser (Expr a)+notP p = ENot <$> (A.skipSpace *> A.string "not" *> A.skipSpace *> p)++andP :: A.Parser (Expr a) -> A.Parser (Expr a)+andP p = EAnd <$> p <*> (A.skipSpace *> A.string "and" *> A.skipSpace *> p)++orP :: A.Parser (Expr a) -> A.Parser (Expr a)+orP p = EAnd <$> p <*> (A.skipSpace *> A.string "or" *> A.skipSpace *> p)++anyP :: A.Parser (Expr a)+anyP = A.string "any" *> pure EAny++simplePE :: A.Parser (Expr PKPPredicate)+simplePE = do+ _ <- A.skipSpace+ lhs <- pVarToken+ _ <- A.skipSpace+ op <- pOpToken+ _ <- A.skipSpace+ rhs <- pValToken+ return (E (PKPPredicate lhs op rhs))+ where+ pVarToken = (A.string "version" *> pure PKPVVersion)+ <|> (A.string "pkalgo" *> pure PKPVPKA)+ <|> (A.string "keysize" *> pure PKPVKeysize)+ <|> (A.string "timestamp" *> pure PKPVTimestamp)+ pOpToken = (A.string "==" *> pure PKEquals)+ <|> (A.string "=" *> pure PKEquals)+ <|> (A.string "<" *> pure PKLessThan)+ <|> (A.string ">" *> pure PKGreaterThan)+ pValToken = (A.asciiCI "rsa" *> pure (PKPPKA RSA))+ <|> (A.asciiCI "dsa" *> pure (PKPPKA DSA))+ <|> (A.asciiCI "elgamal" *> pure (PKPPKA ElgamalEncryptOnly))+ <|> (A.asciiCI "ecdsa" *> pure (PKPPKA ECDSA))+ <|> (A.asciiCI "ec" *> pure (PKPPKA EC))+ <|> (A.asciiCI "dh" *> pure (PKPPKA DH))+ <|> (PKPInt <$> hexordec)++hexordec :: A.Parser Int+hexordec = (A.string "0x" *> A.hexadecimal) <|> A.decimal
hkt.hs view
@@ -17,6 +17,7 @@ -- along with this program. If not, see <http://www.gnu.org/licenses/>. import HOpenPGP.Tools.Common (banner, versioner, warranty, keyMatchesFingerprint, keyMatchesEightOctetKeyId, keyMatchesUIDSubString)+import HOpenPGP.Tools.ExpressionParsing (pPE) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID) import Codec.Encryption.OpenPGP.KeyInfo (keySize, pkalgoAbbrev) import Codec.Encryption.OpenPGP.KeySelection (parseEightOctetKeyId, parseFingerprint)@@ -25,11 +26,13 @@ import Control.Applicative ((<$>),(<*>), optional, (<|>)) import Control.Lens ((^.)) import Control.Monad.Trans.Writer.Lazy (execWriter, tell)+import qualified Data.Attoparsec.Text as A import qualified Data.ByteString as B import Data.Conduit (($=),($$), runResourceT) import qualified Data.Conduit.Binary as CB import Data.Conduit.Cereal (conduitGet) import qualified Data.Conduit.List as CL+import Data.Conduit.OpenPGP.Filter (Expr(..), PKPPredicate(..), PKPOp(..), PKPVar(..), PKPValue(..)) import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping) import Data.Foldable (traverse_) import Data.Maybe (fromMaybe)@@ -38,17 +41,18 @@ import qualified Data.Text as T import System.Directory (getHomeDirectory) -import Options.Applicative.Builder (argument, command, footer, header, help, info, long, metavar, prefs, progDesc, showHelpOnError, str, strOption, subparser)+import Options.Applicative.Builder (argument, command, footer, header, help, info, long, metavar, prefs, progDesc, showHelpOnError, str, strOption, subparser, switch) import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser) import System.IO (Handle, hFlush, hPutStrLn, stderr, hSetBuffering, BufferMode(..)) -grabMatchingKeys :: FilePath -> String -> IO [TK]-grabMatchingKeys fp srch = runResourceT $- CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $= CL.filter matchAny $$ CL.consume+grabMatchingKeys :: FilePath -> Bool -> String -> IO [TK]+grabMatchingKeys fp filt srch = runResourceT $+ CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $= CL.filter (if filt then filterMatch else matchAny) $$ CL.consume where matchAny tk = either (const False) id $ fmap (keyMatchesFingerprint True tk) efp <|> fmap (keyMatchesEightOctetKeyId True tk) eeok <|> return (keyMatchesUIDSubString srch tk)+ filterMatch tk = eval pkpEval (either error id (A.parseOnly pPE (T.pack srch))) (_tkPKP tk) efp = parseFingerprint . T.pack $ srch eeok = parseEightOctetKeyId . T.pack $ srch @@ -60,6 +64,7 @@ data Options = Options { keyring :: String+ , targetIsFilter :: Bool , target :: String } @@ -71,6 +76,7 @@ ( long "keyring" <> metavar "FILE" <> help "file containing keyring" )))+ <*> switch ( long "filter" <> help "treat target as filter" ) <*> argument str ( metavar "TARGET" ) dispatch :: Command -> IO ()@@ -81,7 +87,7 @@ main = do hSetBuffering stderr LineBuffering homedir <- getHomeDirectory- customExecParser (prefs showHelpOnError) (info (helper <*> versioner <*> cmd homedir) (header (banner "hkt") <> progDesc "hOpenPGP Keyring Tool" <> footer (warranty "hot"))) >>= dispatch+ customExecParser (prefs showHelpOnError) (info (helper <*> versioner <*> cmd homedir) (header (banner "hkt") <> progDesc "hOpenPGP Keyring Tool" <> footer (warranty "hkt"))) >>= dispatch cmd :: String -> Parser Command cmd homedir = subparser@@ -93,12 +99,12 @@ doList :: Options -> IO () doList o = do- keys <- grabMatchingKeys (keyring o) (target o)+ keys <- grabMatchingKeys (keyring o) (targetIsFilter o) (target o) mapM_ showKey keys doExportPubkeys :: Options -> IO () doExportPubkeys o = do- keys <- grabMatchingKeys (keyring o) (target o)+ keys <- grabMatchingKeys (keyring o) (targetIsFilter o) (target o) mapM_ (B.putStr . putTK') keys where putTK' key = runPut $ do@@ -110,3 +116,26 @@ putUid' (u, sps) = put (UserId u) >> mapM_ (put . Signature) sps putUat' (us, sps) = put (UserAttribute us) >> mapM_ (put . Signature) sps putSub' (p, sp, msp) = put p >> (put . Signature) sp >> traverse_ (put . Signature) msp++-- FIXME: deduplicate the following code+eval :: (a -> v -> Bool) -> Expr a -> v -> Bool+eval t e v = ev e+ where+ ev EAny = True+ ev (EAnd e1 e2) = ev e1 && ev e2+ ev (EOr e1 e2) = ev e1 || ev e2+ ev (ENot e1) = (not . ev) e1+ ev (E e') = t e' v++pkpEval :: PKPPredicate -> PKPayload -> Bool+pkpEval (PKPPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs)+ where+ opreduce PKEquals = (==)+ opreduce PKLessThan = (<)+ opreduce PKGreaterThan = (>)+ vreduce (PKPVVersion, p) = PKPInt (kv (_keyVersion p))+ vreduce (PKPVPKA, p) = PKPPKA (_pkalgo p)+ vreduce (PKPVKeysize, p) = PKPInt (keySize . _pubkey $ p)+ vreduce (PKPVTimestamp, p) = PKPInt (fromIntegral (_timestamp p))+ kv DeprecatedV3 = 3+ kv V4 = 4
hokey.hs view
@@ -16,16 +16,17 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see <http://www.gnu.org/licenses/>. -{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleInstances #-} import HOpenPGP.Tools.Common (banner, versioner, warranty)+import Codec.Encryption.OpenPGP.Expirations (getKeyExpirationTimesFromSignature) import Codec.Encryption.OpenPGP.Fingerprint (fingerprint, eightOctetKeyID) import Codec.Encryption.OpenPGP.KeyInfo (keySize) import Codec.Encryption.OpenPGP.Signatures (verifyTKWith, verifySigWith, verifyAgainstKeys) import Codec.Encryption.OpenPGP.Types import Control.Applicative ((<$>),(<*>)) import Control.Arrow ((***), second)-import Control.Lens ((^.), (^?!), ix)+import Control.Lens ((^.)) import Control.Monad.Trans.Writer.Lazy (execWriter, tell) import qualified Crypto.Hash.SHA3 as SHA3 import qualified Data.Aeson as A@@ -38,13 +39,12 @@ import Data.Conduit.Cereal (conduitGet) import qualified Data.Conduit.List as CL import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping)-import Data.IxSet (empty, insert) import Data.List (unfoldr, elemIndex, findIndex, sortBy, intercalate)-import Data.Maybe (fromMaybe)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe, catMaybes, listToMaybe) import Data.Monoid ((<>), mconcat) import Data.Ord (comparing, Down(..)) import Data.Serialize (get)-import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime, POSIXTime) import Data.Time.Format (formatTime) import GHC.Generics@@ -59,28 +59,43 @@ import Text.PrettyPrint.ANSI.Leijen (colon, green, indent, linebreak, list, putDoc, red, text, yellow, (<+>), Doc) -- need 0.6.7 for hardline data KAS = KAS {- pubkeyalgo :: PubKeyAlgorithm- , pubkeysize :: Int+ pubkeyalgo :: Colored PubKeyAlgorithm+ , pubkeysize :: Colored Int } deriving Generic +data Color = Green | Yellow | Red+ deriving Generic++data Colored a = Colored {+ color :: Maybe Color+ , explanation :: Maybe String+ , val :: a+} deriving (Functor, Generic)++newtype FakeMap a b = FakeMap { unFakeMap :: [(a, b)] }+ data KeyReport = KeyReport { keyStatus :: String , keyFingerprint :: TwentyOctetFingerprint- , keyVer :: KeyVersion+ , keyVer :: Colored KeyVersion , keyCreationTime :: TimeStamp , keyAlgorithmAndSize :: KAS- , keyUIDsAndUAts :: [(String, UIDReport)]+ , keyUIDsAndUAts :: FakeMap String UIDReport } deriving Generic data UIDReport = UIDReport {- uidSelfSigHashAlgorithms :: [HashAlgorithm]- , uidPreferredHashAlgorithms :: [[HashAlgorithm]]- , uidKeyExpirationTimes :: [[TimeStamp]]+ uidSelfSigHashAlgorithms :: [Colored HashAlgorithm]+ , uidPreferredHashAlgorithms :: [Colored [HashAlgorithm]]+ , uidKeyExpirationTimes :: [Colored [TimeStamp]] } deriving Generic instance A.ToJSON KAS+instance A.ToJSON Color+instance (A.ToJSON a) => A.ToJSON (Colored a) instance A.ToJSON KeyReport instance A.ToJSON UIDReport+instance A.ToJSON b => A.ToJSON (FakeMap String b) where+ toJSON = A.toJSON . Map.fromList . unFakeMap instance A.ToJSON HashAlgorithm where toJSON = A.toJSON . show instance A.ToJSON PubKeyAlgorithm where@@ -91,29 +106,45 @@ instance A.ToJSON TwentyOctetFingerprint where toJSON = A.toJSON . show -checkKey :: Maybe UTCTime -> TK -> KeyReport-checkKey mct key = KeyReport (either (const "not-good") (const "good") processedTK) (fingerprint $ key^.tkPKP) (key^.tkPKP^.keyVersion) (key^.tkPKP^.timestamp) (KAS (key^.tkPKP^.pkalgo) (keySize (key^.tkPKP^.pubkey))) (map (second uidr) (processedOrOrig^.tkUIDs) ++ map (uatspsToString *** uidr) (processedOrOrig^.tkUAts))+checkKey :: Maybe POSIXTime -> TK -> KeyReport+checkKey mpt key = KeyReport (either id (const "good") processedTK) (fingerprint $ key^.tkPKP) (colorizeKV (key^.tkPKP^.keyVersion)) (key^.tkPKP^.timestamp) (KAS (colorizePKA (key^.tkPKP^.pkalgo)) (colorizePKS (keySize (key^.tkPKP^.pubkey)))) (FakeMap (map (second uidr) (processedOrOrig^.tkUIDs) ++ map (uatspsToString *** uidr) (processedOrOrig^.tkUAts))) where processedOrOrig = either (const key) id processedTK- processedTK = verifyTKWith (verifySigWith (verifyAgainstKeys [key])) mct . stripOlderSigs . stripOtherSigs $ key- sigissuer (SigVOther 2 _) = OtherSigSub 666 B.empty -- this is dumb- sigissuer (SigV3 {}) = OtherSigSub 666 B.empty -- this is dumb- sigissuer (SigV4 _ _ _ _ xs _ _) = xs^?!ix 0^.sspPayload -- this is a horrible stack of stupid assumptions- sigissuer (SigVOther _ _) = error "We're in the future."- sigissuer _ = error "WTF"+ processedTK = verifyTKWith (verifySigWith (verifyAgainstKeys [key])) (fmap posixSecondsToUTCTime mpt) . stripOlderSigs . stripOtherSigs $ key+ 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) pks+ colorizePKS' pks+ | pks >= 3072 = (Just Green, Nothing)+ | pks >= 2048 = (Just Yellow, Just "Public key size between 2048 and 3072 bits")+ | otherwise = (Just Red, Just "Public key size under 2048 bits")+ colorizePHAs x = uncurry Colored (if fSHA2Family x < ei DeprecatedMD5 x && fSHA2Family x < ei SHA1 x then (Just Green, Nothing) else (Just Red, Just "weak hash with higher preference")) x+ fSHA2Family = fi (`elem` [SHA512,SHA384,SHA256,SHA224])+ ei x y = fromMaybe maxBound (elemIndex x y)+ fi x y = fromMaybe maxBound (findIndex x y)+ colorizeKETs ct ts kes+ | null kes = Colored (Just Red) (Just "no expiration set") kes+ | any (\ke -> realToFrac ts + realToFrac ke < ct) kes = Colored (Just Red) (Just "expiration passed") kes+ | any (\ke -> realToFrac ts + realToFrac ke > ct + (5*31557600)) kes = Colored (Just Yellow) (Just "expiration too far in future") kes+ | otherwise = Colored (Just Green) Nothing kes+ sigissuer (SigVOther 2 _) = Nothing+ sigissuer (SigV3 {}) = Nothing+ sigissuer (SigV4 _ _ _ ys xs _ _) = listToMaybe . catMaybes . map (getIssuer . _sspPayload) $ (ys++xs) -- FIXME: what should this be if there are multiple matches?+ sigissuer (SigVOther _ _) = error "We're in the future." -- FIXME+ getIssuer i@(Issuer _) = Just i+ getIssuer _ = Nothing eoki = eightOctetKeyID . _tkPKP hashAlgo (SigV4 _ _ x _ _ _ _) = x- phas (SigV4 _ _ _ xs _ _ _) = concatMap (\(SigSubPacket _ (PreferredHashAlgorithms x)) -> x) $ filter isPHA xs+ phas (SigV4 _ _ _ xs _ _ _) = colorizePHAs . concatMap (\(SigSubPacket _ (PreferredHashAlgorithms x)) -> x) $ filter isPHA xs+ phas _ = Colored Nothing Nothing [] isPHA (SigSubPacket _ (PreferredHashAlgorithms _)) = True isPHA _ = False- kets (SigV4 _ _ _ xs _ _ _) = map (\(SigSubPacket _ (KeyExpirationTime x)) -> x) $ filter isKET xs- isKET (SigSubPacket _ (KeyExpirationTime _)) = True- isKET _ = False- has = map hashAlgo . alleged+ has = map (colorizeHA . hashAlgo) . alleged+ colorizeHA ha = uncurry Colored (if ha `elem` [DeprecatedMD5, SHA1] then (Just Red, Just "weak hash algorithm") else (Nothing, Nothing)) ha isCT (SigSubPacket _ (SigCreationTime _)) = True isCT _ = False sigcts (SigV4 _ _ _ xs _ _ _) = map (\(SigSubPacket _ (SigCreationTime x)) -> x) $ filter isCT xs- alleged = filter (\x -> sigissuer x == Issuer (eoki key))+ alleged = filter (\x -> sigissuer x == Just (Issuer (eoki key))) newest = take 1 . sortBy (comparing (Down . take 1 . sigcts)) -- FIXME: this is terrible stripOtherSigs tk = tk { _tkUIDs = map (second alleged) (_tkUIDs tk)@@ -128,42 +159,33 @@ uaspToString (OtherUASub t d) = "other-" ++ show t ++ ':':show (B.length d) ++ ':':BC8.unpack (Base16.encode (SHA3.hash 48 d)) hdrToString (ImageHV1 JPEG) = "jpeg" hdrToString (ImageHV1 fmt) = "image-" ++ show (fromFVal fmt)- uidr sps = UIDReport (has sps) (map phas sps) (map kets sps)+ uidr sps = UIDReport (has sps) (map phas sps) (map (colorizeKETs (fromMaybe 0 mpt) (key^.tkPKP^.timestamp) . getKeyExpirationTimesFromSignature) sps) -- should that be 0? prettyKeyReport :: POSIXTime -> TK -> Doc prettyKeyReport cpt key = do- let keyReport = checkKey (Just (posixSecondsToUTCTime cpt)) key+ let keyReport = checkKey (Just cpt) key execWriter $ tell ( linebreak <> text "Key has potential validity:" <+> text (keyStatus keyReport) <> linebreak <> text "Key has fingerprint:" <+> text (show (keyFingerprint keyReport))- <> linebreak <> text "Checking to see if key is OpenPGPv4:" <+> colorIf (green,red) (==V4) (keyVer keyReport)- <> linebreak <> (\kas -> text "Checking to see if key is RSA or DSA (>= 2048-bit):" <+> colorIf (green,yellow) (==RSA) (pubkeyalgo kas) <+> colorIf3 (green,yellow,red) (>= 3072) (>=2048) (pubkeysize kas)) (keyAlgorithmAndSize 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 (text . show) (pubkeyalgo kas) <+> coloredToColor (text . show) (pubkeysize kas)) (keyAlgorithmAndSize keyReport) <> linebreak <> text "Checking user-ID- and user-attribute-related items:"- <> mconcat (map (uidtrip (keyCreationTime keyReport)) (keyUIDsAndUAts keyReport))+ <> mconcat (map (uidtrip (keyCreationTime keyReport)) (unFakeMap (keyUIDsAndUAts keyReport))) <> linebreak ) where- colorIf (y,n) p x = ((if p x then y else n) . text . show) x- colorIf3 (g,y,r) p1 p2 x = ((if p1 x then g else (if p2 x then y else r)) . text . show) x+ coloredToColor f (Colored (Just Green) _ x) = green (f x)+ coloredToColor f (Colored (Just Yellow) _ x) = yellow (f x)+ coloredToColor f (Colored (Just Red) _ x) = red (f x)+ coloredToColor f (Colored Nothing _ x) = f x uidtrip ts (u, ur) = linebreak <> indent 2 (text u) <> colon- <> linebreak <> indent 4 (text "Self-sig hash algorithms" <> colon <+> (listHAs . uidSelfSigHashAlgorithms) ur)- <> linebreak <> indent 4 (text "Preferred hash algorithms" <> colon <+> mconcat (map ((linebreak <>) . indent 2 . listPHAs) (uidPreferredHashAlgorithms ur)))- <> linebreak <> indent 4 (text "Key expiration times" <> colon <+> mconcat (map ((linebreak <>) . indent 2 . listKETs cpt ts) (uidKeyExpirationTimes ur)))- listHAs = list . map (\x -> ((if x `elem` [DeprecatedMD5, SHA1] then red else id) . text . show) x)- listPHAs x = (if fSHA2Family x < ei DeprecatedMD5 x && fSHA2Family x < ei SHA1 x then green else red) . list . map (text . show) $ x- listKETs ct ts x = colorExpiration ct ts x . list . map (text . keyExp ts) $ x- fSHA2Family = fi (`elem` [SHA512,SHA384,SHA256,SHA224])- ei x y = fromMaybe maxBound (elemIndex x y)- fi x y = fromMaybe maxBound (findIndex x y)- colorExpiration ct ts kes- | null kes = red- | any (\ke -> realToFrac ts + realToFrac ke < ct) kes = red- | any (\ke -> realToFrac ts + realToFrac ke > ct + (5*31557600)) kes = yellow- | otherwise = green+ <> linebreak <> indent 4 (text "Self-sig hash algorithms" <> colon <+> (list . map (coloredToColor (text . show)) . uidSelfSigHashAlgorithms) ur)+ <> linebreak <> indent 4 (text "Preferred hash algorithms" <> colon <+> mconcat (map ((linebreak <>) . indent 2 . coloredToColor (text . show)) (uidPreferredHashAlgorithms ur)))+ <> linebreak <> indent 4 (text "Key expiration times" <> colon <+> mconcat (map ((linebreak <>) . indent 2 . coloredToColor list . fmap (map (text . keyExp ts))) (uidKeyExpirationTimes ur))) keyExp ts ke = durationPrettyPrinter ke ++ " = " ++ formatTime defaultTimeLocale "%c" (posixSecondsToUTCTime (realToFrac ts + realToFrac ke)) -jsonReport :: POSIXTime -> TK -> BL.ByteString-jsonReport _ key = A.encode (checkKey Nothing key) -- FIXME: pass time when it matters in the JSON+jsonReport :: POSIXTime -> [TK] -> BL.ByteString+jsonReport ps keys = A.encode (map (checkKey (Just ps)) keys) -- this does not have the same sense of calendar anyone else might durationPrettyPrinter :: TimeStamp -> String@@ -213,7 +235,7 @@ output (outputFormat o) cpt keys where output Pretty cpt = mapM_ (putDoc . prettyKeyReport cpt)- output JSON cpt = BL.putStr . BL.concat . map (jsonReport cpt)+ output JSON cpt = BL.putStr . jsonReport cpt banner' :: Handle -> IO () banner' h = hPutStrLn h (banner "hokey" ++ "\n" ++ warranty "hokey")
hopenpgp-tools.cabal view
@@ -1,5 +1,5 @@ name: hopenpgp-tools-version: 0.3+version: 0.4 synopsis: hOpenPGP-based command-line tools description: command-line tools for performing some OpenPGP-related operations homepage: http://floss.scru.org/hopenpgp-tools@@ -16,6 +16,7 @@ main-is: hot.hs ghc-options: -Wall other-modules: HOpenPGP.Tools.Common+ , HOpenPGP.Tools.ExpressionParsing build-depends: base > 4 && < 5 , attoparsec >= 0.10.0.0 , bytestring@@ -46,8 +47,7 @@ , crypto-pubkey , cryptohash >= 0.7.7 , directory- , hOpenPGP >= 0.12- , ixset+ , hOpenPGP >= 0.13 , lens , old-locale , optparse-applicative >= 0.5.0@@ -60,7 +60,9 @@ main-is: hkt.hs ghc-options: -Wall other-modules: HOpenPGP.Tools.Common+ , HOpenPGP.Tools.ExpressionParsing build-depends: base > 4 && < 5+ , attoparsec >= 0.10.0.0 , bytestring , cereal , cereal-conduit@@ -82,4 +84,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hopenpgp-tools.git- tag: hopenpgp-tools/0.3+ tag: hopenpgp-tools/0.4
hot.hs view
@@ -20,6 +20,7 @@ import Paths_hopenpgp_tools (version) import HOpenPGP.Tools.Common (banner, versioner, warranty)+import HOpenPGP.Tools.ExpressionParsing (pPE) import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..)) import Codec.Encryption.OpenPGP.Serialize ()@@ -33,7 +34,7 @@ import Data.Conduit.Cereal (conduitGet, conduitPut) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL-import Data.Conduit.OpenPGP.Filter (conduitFilter, Expr(..), FilterPredicates(..), PKPPredicate(..), PKPVar(..), PKPOp(..), PKPValue(..), SPPredicate(..), SPVar(..), SPOp(..), SPValue(..), OPredicate(..), OVar(..), OOp(..), OValue(..))+import Data.Conduit.OpenPGP.Filter (conduitFilter, Expr(..), FilterPredicates(..), SPPredicate(..), SPVar(..), SPOp(..), SPValue(..), OPredicate(..), OVar(..), OOp(..), OValue(..)) import Data.Serialize (get, put) import Data.Serialize.Get (Get) import Data.Monoid ((<>))@@ -134,9 +135,6 @@ parseSE e = either (error . ("signature filter parse error: "++)) id (A.parseOnly pSE e) parseOE e = either (error . ("otherpacket filter parse error: "++)) id (A.parseOnly pOE e) -pPE :: A.Parser (Expr PKPPredicate)-pPE = complex (anyP <|> simplePE)- pSE :: A.Parser (Expr SPPredicate) pSE = complex (anyP <|> simpleSE) @@ -157,32 +155,6 @@ anyP :: A.Parser (Expr a) anyP = A.string "any" *> pure EAny--simplePE :: A.Parser (Expr PKPPredicate)-simplePE = do- _ <- A.skipSpace- lhs <- pVarToken- _ <- A.skipSpace- op <- pOpToken- _ <- A.skipSpace- rhs <- pValToken- return (E (PKPPredicate lhs op rhs))- where- pVarToken = (A.string "version" *> pure PKPVVersion)- <|> (A.string "pkalgo" *> pure PKPVPKA)- <|> (A.string "keysize" *> pure PKPVKeysize)- <|> (A.string "timestamp" *> pure PKPVTimestamp)- pOpToken = (A.string "==" *> pure PKEquals)- <|> (A.string "=" *> pure PKEquals)- <|> (A.string "<" *> pure PKLessThan)- <|> (A.string ">" *> pure PKGreaterThan)- pValToken = (A.asciiCI "rsa" *> pure (PKPPKA RSA))- <|> (A.asciiCI "dsa" *> pure (PKPPKA DSA))- <|> (A.asciiCI "elgamal" *> pure (PKPPKA ElgamalEncryptOnly))- <|> (A.asciiCI "ecdsa" *> pure (PKPPKA ECDSA))- <|> (A.asciiCI "ec" *> pure (PKPPKA EC))- <|> (A.asciiCI "dh" *> pure (PKPPKA DH))- <|> (PKPInt <$> hexordec) hexordec :: A.Parser Int hexordec = (A.string "0x" *> A.hexadecimal) <|> A.decimal