packages feed

hopenpgp-tools 0.0.4 → 0.1

raw patch · 4 files changed

+171/−25 lines, 4 filesdep +attoparsecdep ~hOpenPGP

Dependencies added: attoparsec

Dependency ranges changed: hOpenPGP

Files

hkt.hs view
@@ -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
hokey.hs view
@@ -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
hopenpgp-tools.cabal view
@@ -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
hot.hs view
@@ -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