diff --git a/hkt.hs b/hkt.hs --- a/hkt.hs +++ b/hkt.hs @@ -1,5 +1,5 @@ -- hkt.hs: hOpenPGP key tool --- Copyright © 2013 Clint Adams +-- Copyright © 2013-2014 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab -- @@ -36,7 +36,7 @@ import System.Directory (getHomeDirectory) import Options.Applicative.Builder (argument, command, help, idm, info, long, metavar, prefs, progDesc, showHelpOnError, str, strOption, subparser) -import Options.Applicative.Extra (customExecParser) +import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser) import System.IO (hPutStrLn, stderr) @@ -73,11 +73,11 @@ main :: IO () main = do homedir <- getHomeDirectory - hPutStrLn stderr $ "hkt version " ++ showVersion version ++ ", Copyright (C) 2013 Clint Adams\n\ + hPutStrLn stderr $ "hkt version " ++ showVersion version ++ ", Copyright (C) 2013-2014 Clint Adams\n\ \hkt comes with ABSOLUTELY NO WARRANTY.\n\ \This is free software, and you are welcome to redistribute it\n\ \under certain conditions.\n" - customExecParser (prefs showHelpOnError) (info (cmd homedir) idm) >>= dispatch + customExecParser (prefs showHelpOnError) (info (helper <*> cmd homedir) idm) >>= dispatch cmd :: String -> Parser Command cmd homedir = subparser diff --git a/hokey.hs b/hokey.hs --- a/hokey.hs +++ b/hokey.hs @@ -39,7 +39,7 @@ import Data.Version (showVersion) import Options.Applicative.Builder (argument, command, help, idm, info, long, metavar, prefs, progDesc, showHelpOnError, str, strOption, subparser) -import Options.Applicative.Extra (customExecParser) +import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser) import System.Directory (getHomeDirectory) @@ -133,7 +133,7 @@ \hokey comes with ABSOLUTELY NO WARRANTY.\n\ \This is free software, and you are welcome to redistribute it\n\ \under certain conditions.\n" - customExecParser (prefs showHelpOnError) (info (cmd homedir) idm) >>= dispatch + customExecParser (prefs showHelpOnError) (info (helper <*> cmd homedir) idm) >>= dispatch cmd :: String -> Parser Command cmd homedir = subparser diff --git a/hopenpgp-tools.cabal b/hopenpgp-tools.cabal --- a/hopenpgp-tools.cabal +++ b/hopenpgp-tools.cabal @@ -1,5 +1,5 @@ name: hopenpgp-tools -version: 0.0.4 +version: 0.1 synopsis: hOpenPGP-based command-line tools description: command-line tools for performing some OpenPGP-related operations homepage: http://floss.scru.org/hopenpgp-tools @@ -16,13 +16,15 @@ main-is: hot.hs ghc-options: -Wall build-depends: base > 4 && < 5 + , attoparsec >= 0.10.0.0 , bytestring , cereal , cereal-conduit , conduit - , hOpenPGP >= 0.10.2 + , hOpenPGP >= 0.11 , openpgp-asciiarmor >= 0.1 , optparse-applicative >= 0.7 + , text , transformers default-language: Haskell2010 @@ -69,4 +71,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hopenpgp-tools.git - tag: hopenpgp-tools/0.0.4 + tag: hopenpgp-tools/0.1 diff --git a/hot.hs b/hot.hs --- a/hot.hs +++ b/hot.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} -- hot.hs: hOpenPGP Tool --- Copyright © 2012-2013 Clint Adams +-- Copyright © 2012-2014 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab -- @@ -22,34 +22,42 @@ import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..)) import Codec.Encryption.OpenPGP.Serialize () -import Codec.Encryption.OpenPGP.Types (Pkt) -import Control.Applicative ((<$>),(<*>), optional, pure) +import Codec.Encryption.OpenPGP.Types +import Control.Applicative ((<$>), (<*>), (*>), (<|>), optional, pure) import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Data.Attoparsec.Text as A import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Conduit (($=), ($$), Sink, runResourceT) -import Data.Conduit.Cereal (conduitGet) +import Data.Conduit.Cereal (conduitGet, conduitPut) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL -import Data.Serialize (get) +import Data.Conduit.OpenPGP.Filter (conduitFilter, Expr(..), FilterPredicates(..), PKPPredicate(..), PKPVar(..), PKPOp(..), PKPValue(..), SPPredicate(..), SPVar(..), SPOp(..), SPValue(..), OPredicate(..), OVar(..), OOp(..), OValue(..)) +import Data.Serialize (get, put) import Data.Serialize.Get (Get) - -import Data.Version (showVersion) import Data.Monoid ((<>)) +import qualified Data.Text as T +import Data.Version (showVersion) -import System.IO (stdin, stderr, hPutStrLn, hFlush, hSetBuffering, BufferMode(..)) +import System.IO (stdin, stderr, stdout, hPutStrLn, hFlush, hSetBuffering, BufferMode(..)) import Options.Applicative.Builder (command, help, idm, info, long, metavar, nullOption, reader, prefs, progDesc, showHelpOnError, strOption, subparser, ParseError(..)) -import Options.Applicative.Extra (customExecParser) +import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser, ReadM(..)) -data Command = DumpC | DeArmorC | ArmorC ArmoringOptions +data Command = DumpC | DeArmorC | ArmorC ArmoringOptions | FilterC FilteringOptions data ArmoringOptions = ArmoringOptions { comment :: Maybe String , armortype :: ArmorType } +data FilteringOptions = FilteringOptions { + pkpExpression :: Maybe String + , spExpression :: Maybe String + , oExpression :: Maybe String +} + doDump :: IO () doDump = runResourceT $ CB.sourceHandle stdin $= conduitGet (get :: Get Pkt) $$ printer @@ -73,36 +81,172 @@ armorTypeReader :: String -> ReadM ArmorType armorTypeReader = ReadM . armorTypeReader' where - armorTypeReader' "message" = Right ArmorMessage   - armorTypeReader' "pubkeyblock" = Right ArmorPublicKeyBlock   - armorTypeReader' "privkeyblock" = Right ArmorPrivateKeyBlock   + armorTypeReader' "message" = Right ArmorMessage   + armorTypeReader' "pubkeyblock" = Right ArmorPublicKeyBlock   + armorTypeReader' "privkeyblock" = Right ArmorPrivateKeyBlock   armorTypeReader' "signature" = Right ArmorSignature armorTypeReader' _ = Left (ErrorMsg "unknown armor type") +doFilter :: FilteringOptions -> IO () +doFilter fo = runResourceT $ CB.sourceHandle stdin $= conduitGet (get :: Get Pkt) $= conduitFilter (parseExpressions fo) $= conduitPut put $$ CB.sinkHandle stdout + aoP :: Parser ArmoringOptions aoP = ArmoringOptions <$> optional (strOption (long "comment" <> metavar "COMMENT" <> help "ASCII armor Comment field")) <*> nullOption (long "armor-type" <> reader armorTypeReader <> metavar "ARMORTYPE" <> help "ASCII armor type") +foP :: Parser FilteringOptions +foP = FilteringOptions + <$> optional (strOption (long "pubkey" <> metavar "EXPR" <> help "pubkey filtering expression")) + <*> optional (strOption (long "sig" <> metavar "EXPR" <> help "sig filtering expression")) + <*> optional (strOption (long "other" <> metavar "EXPR" <> help "other-packet filtering expression")) + dispatch :: Command -> IO () dispatch DumpC = doDump dispatch DeArmorC = doDeArmor dispatch (ArmorC o) = doArmor o +dispatch (FilterC o) = doFilter o main :: IO () main = do hSetBuffering stderr LineBuffering - hPutStrLn stderr $ "hot version " ++ showVersion version ++ ", Copyright (C) 2012-2013 Clint Adams\n\ + hPutStrLn stderr $ "hot version " ++ showVersion version ++ ", Copyright (C) 2012-2014 Clint Adams\n\ \hot comes with ABSOLUTELY NO WARRANTY.\n\ \This is free software, and you are welcome to redistribute it\n\ \under certain conditions.\n" hFlush stderr - customExecParser (prefs showHelpOnError) (info cmd idm) >>= dispatch + customExecParser (prefs showHelpOnError) (info (helper <*> cmd) idm) >>= dispatch cmd :: Parser Command cmd = subparser ( command "dump" (info ( pure DumpC ) ( progDesc "Dump OpenPGP packets from stdin" )) <> command "dearmor" (info ( pure DeArmorC ) ( progDesc "Dearmor stdin to stdout" )) <> command "armor" (info ( ArmorC <$> aoP ) ( progDesc "Armor stdin to stdout" )) + <> command "filter" (info ( FilterC <$> foP ) ( progDesc "Filter some packets from stdin to stdout" )) ) + +parseExpressions :: FilteringOptions -> FilterPredicates +parseExpressions FilteringOptions{..} = FilterPredicates (mp parsePE pkpExpression) (mp parseSE spExpression) (mp parseOE oExpression) + where + mp p e = maybe EAny p (T.pack <$> e) + parsePE e = either (error . ("pubkey filter parse error: "++)) id (A.parseOnly pPE e) + 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) + +pOE :: A.Parser (Expr OPredicate) +pOE = complex (anyP <|> simpleOE) + +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 + +simpleSE :: A.Parser (Expr SPPredicate) +simpleSE = do + _ <- A.skipSpace + lhs <- sVarToken + _ <- A.skipSpace + op <- sOpToken + _ <- A.skipSpace + rhs <- sValToken + return (E (SPPredicate lhs op rhs)) + where + sVarToken = (A.string "version" *> pure SPVVersion) + <|> (A.string "sigtype" *> pure SPVSigType) + <|> (A.string "pkalgo" *> pure SPVPKA) + <|> (A.string "hashalgo" *> pure SPVHA) + sOpToken = (A.string "==" *> pure SPEquals) + <|> (A.string "=" *> pure SPEquals) + <|> (A.string "<" *> pure SPLessThan) + <|> (A.string ">" *> pure SPGreaterThan) + sValToken = (A.asciiCI "rsa" *> pure (SPPKA RSA)) + <|> (A.asciiCI "dsa" *> pure (SPPKA DSA)) + <|> (A.asciiCI "elgamal" *> pure (SPPKA ElgamalEncryptOnly)) + <|> (A.asciiCI "ecdsa" *> pure (SPPKA ECDSA)) + <|> (A.asciiCI "ec" *> pure (SPPKA EC)) + <|> (A.asciiCI "dh" *> pure (SPPKA DH)) + <|> (A.asciiCI "binary" *> pure (SPSigType BinarySig)) + <|> (A.asciiCI "canonicaltext" *> pure (SPSigType CanonicalTextSig)) + <|> (A.asciiCI "standalone" *> pure (SPSigType StandaloneSig)) + <|> (A.asciiCI "genericcert" *> pure (SPSigType GenericCert)) + <|> (A.asciiCI "personacert" *> pure (SPSigType PersonaCert)) + <|> (A.asciiCI "casualcert" *> pure (SPSigType CasualCert)) + <|> (A.asciiCI "positivecert" *> pure (SPSigType PositiveCert)) + <|> (A.asciiCI "subkeybindingsig" *> pure (SPSigType SubkeyBindingSig)) + <|> (A.asciiCI "primarykeybindingsig" *> pure (SPSigType PrimaryKeyBindingSig)) + <|> (A.asciiCI "signaturedirectlyonakey" *> pure (SPSigType SignatureDirectlyOnAKey)) + <|> (A.asciiCI "keyrevocationsig" *> pure (SPSigType KeyRevocationSig)) + <|> (A.asciiCI "subkeyrevocationsig" *> pure (SPSigType SubkeyRevocationSig)) + <|> (A.asciiCI "certrevocationsig" *> pure (SPSigType CertRevocationSig)) + <|> (A.asciiCI "timestampsig" *> pure (SPSigType TimestampSig)) + <|> (A.asciiCI "md5" *> pure (SPHA DeprecatedMD5)) + <|> (A.asciiCI "sha1" *> pure (SPHA SHA1)) + <|> (A.asciiCI "ripemd160" *> pure (SPHA RIPEMD160)) + <|> (A.asciiCI "sha256" *> pure (SPHA SHA256)) + <|> (A.asciiCI "sha384" *> pure (SPHA SHA384)) + <|> (A.asciiCI "sha512" *> pure (SPHA SHA512)) + <|> (A.asciiCI "sha224" *> pure (SPHA SHA224)) + <|> (SPInt <$> hexordec) + +simpleOE :: A.Parser (Expr OPredicate) +simpleOE = do + _ <- A.skipSpace + lhs <- oVarToken + _ <- A.skipSpace + op <- oOpToken + _ <- A.skipSpace + rhs <- oValToken + return (E (OPredicate lhs op rhs)) + where + oVarToken = (A.string "tag" *> pure OVTag) + oOpToken = (A.string "==" *> pure OEquals) + <|> (A.string "=" *> pure OEquals) + <|> (A.string "<" *> pure OLessThan) + <|> (A.string ">" *> pure OGreaterThan) + oValToken = OInt <$> hexordec