packages feed

hopenpgp-tools 0.1 → 0.2

raw patch · 5 files changed

+271/−104 lines, 5 filesdep +aesondep +containersdep +old-localedep ~hOpenPGP

Dependencies added: aeson, containers, old-locale, time

Dependency ranges changed: hOpenPGP

Files

+ HOpenPGP/Tools/Common.hs view
@@ -0,0 +1,75 @@+-- Common.hs: hOpenPGP-tools common functions+-- Copyright © 2012-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/>.++module HOpenPGP.Tools.Common (+    banner+  , versioner+  , warranty+  , keyMatchesFingerprint+  , keyMatchesEightOctetKeyId+  , keyMatchesExactUIDString+  , keyMatchesUIDSubString+  , keyMatchesPKPred+) where++import Paths_hopenpgp_tools (version)+import Data.Version (showVersion)++import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)+import Codec.Encryption.OpenPGP.Types+import Control.Lens ((^..))+import Data.Char (toLower)+import Data.Data.Lens (biplate)+import Data.List (isInfixOf)+import Data.Monoid ((<>))+import Options.Applicative.Builder (help, infoOption, long, short)+import Options.Applicative.Types (Parser)++banner :: String -> String+{-# INLINE banner #-}+banner name = name ++ " (hopenpgp-tools) " ++ showVersion version ++ "\n\+     \Copyright (C) 2012-2014  Clint Adams"++warranty :: String -> String+{-# INLINE warranty #-}+warranty name = name ++ " comes with ABSOLUTELY NO WARRANTY.\n\+     \This is free software, and you are welcome to redistribute it\n\+     \under certain conditions."++versioner :: Parser (a -> a)+{-# INLINE versioner #-}+versioner = infoOption (showVersion version) $+    long "version"+   <> short 'V'+   <> help "Show version information"++keyMatchesFingerprint :: Bool -> TK -> TwentyOctetFingerprint -> Bool+keyMatchesFingerprint = keyMatchesPKPred fingerprint++keyMatchesEightOctetKeyId :: Bool -> TK -> EightOctetKeyId -> Bool+keyMatchesEightOctetKeyId = keyMatchesPKPred eightOctetKeyID++keyMatchesExactUIDString :: String -> TK -> Bool+keyMatchesExactUIDString uidstr = any (==uidstr) . map fst . _tkUIDs++keyMatchesUIDSubString :: String -> TK -> Bool+keyMatchesUIDSubString uidstr = any (map toLower uidstr `isInfixOf`) . map (map toLower . fst) . _tkUIDs++keyMatchesPKPred :: Eq a => (PKPayload -> a) -> Bool -> TK -> a -> Bool+keyMatchesPKPred p False = (==) . p . _tkPKP+keyMatchesPKPred p True = \tk v -> any (== v) (map p (tk ^.. biplate))
hkt.hs view
@@ -16,35 +16,41 @@ -- 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/>. -import Paths_hopenpgp_tools (version)+import HOpenPGP.Tools.Common (banner, versioner, warranty, keyMatchesFingerprint, keyMatchesEightOctetKeyId, keyMatchesUIDSubString) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID) import Codec.Encryption.OpenPGP.KeyInfo (keySize, pkalgoAbbrev)+import Codec.Encryption.OpenPGP.KeySelection (parseEightOctetKeyId, parseFingerprint)+import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types-import Control.Applicative ((<$>),(<*>), optional)+import Control.Applicative ((<$>),(<*>), optional, (<|>)) import Control.Lens ((^.)) import Control.Monad.Trans.Writer.Lazy (execWriter, tell)+import qualified Data.ByteString as B import Data.Conduit (($=),($$), runResourceT) import qualified Data.Conduit.Binary as CB import Data.Conduit.Cereal (conduitGet)-import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping, sinkKeyringMap)+import qualified Data.Conduit.List as CL+import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping)+import Data.Foldable (traverse_) import Data.Maybe (fromMaybe) import Data.Monoid ((<>))-import Data.IxSet ((@=))-import qualified Data.IxSet as IxSet-import Data.Serialize (get)-import Data.Version (showVersion)+import Data.Serialize (get, put, runPut)+import qualified Data.Text as T import System.Directory (getHomeDirectory) -import Options.Applicative.Builder (argument, command, help, idm, 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) import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser) -import System.IO (hPutStrLn, stderr)+import System.IO (Handle, hFlush, hPutStrLn, stderr, hSetBuffering, BufferMode(..))  grabMatchingKeys :: FilePath -> String -> IO [TK]-grabMatchingKeys fp eok = do-    kr <- runResourceT $ CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $$ sinkKeyringMap-    return $! IxSet.toList (kr @= (read eok :: EightOctetKeyId))+grabMatchingKeys fp srch = runResourceT $+    CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $= CL.filter matchAny $$ CL.consume+    where+        matchAny tk = either (const False) id $ fmap (keyMatchesFingerprint True tk) efp <|> fmap (keyMatchesEightOctetKeyId True tk) eeok <|> return (keyMatchesUIDSubString srch tk)+        efp = parseFingerprint . T.pack $ srch+        eeok = parseEightOctetKeyId . T.pack $ srch  showKey :: TK -> IO () showKey key = putStrLn . unlines . execWriter $ do@@ -57,7 +63,7 @@   , target :: String } -data Command = List Options+data Command = List Options | ExportPubkeys Options  listO :: String -> Parser Options listO homedir = Options@@ -68,22 +74,39 @@     <*> argument str ( metavar "TARGET" )  dispatch :: Command -> IO ()-dispatch (List o) = doList o+dispatch (List o) = banner' stderr >> hFlush stderr >> doList o+dispatch (ExportPubkeys o) = banner' stderr >> hFlush stderr >> doExportPubkeys o  main :: IO () main = do+    hSetBuffering stderr LineBuffering     homedir <- getHomeDirectory-    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 (helper <*> cmd homedir) idm) >>= dispatch+    customExecParser (prefs showHelpOnError) (info (helper <*> versioner <*> cmd homedir) (header (banner "hkt") <> progDesc "hOpenPGP Keyring Tool" <> footer (warranty "hot"))) >>= dispatch  cmd :: String -> Parser Command cmd homedir = subparser-    ( command "list" (info ( List <$> listO homedir) ( progDesc "list matching keys" )))+    ( command "list" (info ( List <$> listO homedir) ( progDesc "list matching keys" ))+   <> command "export-pubkeys" (info ( ExportPubkeys <$> listO homedir) ( progDesc "export matching keys to stdout" ))) +banner' :: Handle -> IO ()+banner' h = hPutStrLn h (banner "hkt" ++ "\n" ++ warranty "hkt")+ doList :: Options -> IO () doList o = do     keys <- grabMatchingKeys (keyring o) (target o)     mapM_ showKey keys++doExportPubkeys :: Options -> IO ()+doExportPubkeys o = do+    keys <- grabMatchingKeys (keyring o) (target o)+    mapM_ (B.putStr . putTK') keys+    where+        putTK' key = runPut $ do+            put (PublicKey (_tkPKP key))+            mapM_ (put . Signature) (_tkRevs key)+            mapM_ putUid' (_tkUIDs key)+            mapM_ putUat' (_tkUAts key)+            mapM_ putSub' (_tkSubs key)+        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
hokey.hs view
@@ -16,87 +16,142 @@ -- 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/>. -import Paths_hopenpgp_tools (version)+{-# LANGUAGE DeriveGeneric #-}++import HOpenPGP.Tools.Common (banner, versioner, warranty) import Codec.Encryption.OpenPGP.Fingerprint (fingerprint, eightOctetKeyID) import Codec.Encryption.OpenPGP.KeyInfo (keySize)-import Codec.Encryption.OpenPGP.KeySelection (parseEightOctetKeyId)+import Codec.Encryption.OpenPGP.Signatures (verifyTK) import Codec.Encryption.OpenPGP.Types-import Control.Applicative ((<$>),(<*>), optional)+import Control.Applicative ((<$>),(<*>))+import Control.Arrow ((***), second) import Control.Lens ((^.), (^?!), ix) import Control.Monad.Trans.Writer.Lazy (execWriter, tell)+import qualified Data.Aeson as A import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import Data.Conduit (($=),($$), runResourceT) import qualified Data.Conduit.Binary as CB import Data.Conduit.Cereal (conduitGet)-import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping, sinkKeyringMap)-import Data.List (unfoldr, elemIndex, findIndex)+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)+import Data.Map (Map)+import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Monoid ((<>), mconcat)-import Data.IxSet ((@=))-import qualified Data.IxSet as IxSet+import Data.Ord (comparing, Down(..)) import Data.Serialize (get)-import qualified Data.Text as T-import Data.Version (showVersion)+import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime)+import Data.Time.Format (formatTime)+import GHC.Generics -import Options.Applicative.Builder (argument, command, help, idm, info, long, metavar, prefs, progDesc, showHelpOnError, str, strOption, subparser)+import Options.Applicative.Builder (command, footer, header, help, info, long, metavar, prefs, progDesc, showDefault, showHelpOnError, option, subparser, value) import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser) -import System.Directory (getHomeDirectory)-import System.IO (hPutStrLn, stderr)+import System.IO (Handle, hFlush, hPutStrLn, stderr, stdin, hSetBuffering, BufferMode(..))+import System.Locale (defaultTimeLocale)  import Text.PrettyPrint.ANSI.Leijen (colon, green, indent, linebreak, list, putDoc, red, text, yellow, (<+>)) -- need 0.6.7 for hardline -grabMatchingKeys :: FilePath -> String -> IO [TK]-grabMatchingKeys fp eok = do-    kr <- runResourceT $ CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $$ sinkKeyringMap-    let eoki = either ((const . error) "you must specify an eight-octet key ID") id (parseEightOctetKeyId (T.pack eok))-    return $! IxSet.toList (kr @= eoki)+data KAS = KAS {+    pubkeyalgo :: PubKeyAlgorithm+  , pubkeysize :: Int+} deriving Generic -checkKey :: TK -> IO ()-checkKey key = putDoc . execWriter $ tell-   ( linebreak <> text "Key has fingerprint:" <+> text (show . fingerprint $ key^.tkPKP)-  <> linebreak <> text "Checking to see if key is OpenPGPv4:" <+> colorIf (green,red) (==V4) (key^.tkPKP^.keyVersion)-  <> linebreak <> text "Checking to see if key is RSA or DSA (>= 2048-bit):" <+> colorIf (green,yellow) (==RSA) (key^.tkPKP^.pkalgo) <+> colorIf3 (green,yellow,red) (>= 3072) (>=2048) keysize-  <> linebreak <> text "Checking self-sig hash algorithms (poorly):"-  <> mconcat (map (\(x,ys) -> slpair x (listHAs ys)) (key^.tkUIDs))-  <> mconcat (map (\(_,ys) -> slpair "<uat>" (listHAs ys)) (key^.tkUAts))-  <> linebreak <> text "Checking preferred hash algorithms (poorly):" -- FIXME-  <> mconcat (map (\(x,ys) -> mlpair x listPHAs (alleged ys)) (key^.tkUIDs))-  <> mconcat (map (\(_,ys) -> mlpair "<uat>" listPHAs (alleged ys)) (key^.tkUAts))-  <> linebreak <> text "Checking key expiration times (poorly):" -- FIXME-  <> mconcat (map (\(x,ys) -> mlpair x listKETs (alleged ys)) (key^.tkUIDs))-  <> mconcat (map (\(_,ys) -> mlpair "<uat>" listKETs (alleged ys)) (key^.tkUAts))-  <> linebreak-   )+data KeyReport = KeyReport {+    keyStatus :: String+  , keyFingerprint :: TwentyOctetFingerprint+  , keyVer :: KeyVersion+  , keyCreationTime :: TimeStamp+  , keyAlgorithmAndSize :: KAS+  , keySelfSigHashAlgorithms :: Map String [HashAlgorithm]+  , keyPreferredHashAlgorithms :: Map String [[HashAlgorithm]]+  , keyExpirationTimes :: Map String [[TimeStamp]]+} deriving Generic++instance A.ToJSON KAS+instance A.ToJSON KeyReport+instance A.ToJSON HashAlgorithm where+    toJSON = A.toJSON . show+instance A.ToJSON PubKeyAlgorithm where+    toJSON = A.toJSON . show+instance A.ToJSON KeyVersion where+    toJSON DeprecatedV3 = A.toJSON (3 :: Int)+    toJSON V4 = A.toJSON (4 :: Int)+instance A.ToJSON TwentyOctetFingerprint where+    toJSON = A.toJSON . show++checkKey :: TK -> IO KeyReport+checkKey key = getPOSIXTime >>= \cpt -> return (KeyReport (either (const "not-good") (const "good") (processedTK cpt)) (fingerprint $ key^.tkPKP) (key^.tkPKP^.keyVersion) (key^.tkPKP^.timestamp) (KAS (key^.tkPKP^.pkalgo) (keySize (key^.tkPKP^.pubkey))) (Map.fromList (map (second has) ((processedOrOrig cpt)^.tkUIDs) ++ map (const "<uat>" *** has) ((processedOrOrig cpt)^.tkUAts))) (Map.fromList (map (second (map phas . alleged)) ((processedOrOrig cpt)^.tkUIDs) ++ map (const "<uat>" *** (map phas . alleged)) ((processedOrOrig cpt)^.tkUAts))) (Map.fromList (map (second (map kets . alleged)) ((processedOrOrig cpt)^.tkUIDs) ++ map (const "<uat>" *** (map kets . alleged)) ((processedOrOrig cpt)^.tkUAts))))     where-        keysize = keySize (key^.tkPKP^.pubkey)-	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"-	eoki = eightOctetKeyID . _tkPKP-	hashAlgo (SigV4 _ _ x _ _ _ _) = x+        processedOrOrig = either (const key) id . processedTK+        processedTK t = verifyTK (insert key empty) (Just (posixSecondsToUTCTime t)) . 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"+        eoki = eightOctetKeyID . _tkPKP+        hashAlgo (SigV4 _ _ x _ _ _ _) = x         phas (SigV4 _ _ _ xs _ _ _) = concatMap (\(SigSubPacket _ (PreferredHashAlgorithms x)) -> x) $ filter isPHA xs         isPHA (SigSubPacket _ (PreferredHashAlgorithms _)) = True         isPHA _ = False         kets (SigV4 _ _ _ xs _ _ _) = map (\(SigSubPacket _ (KeyExpirationTime x)) -> x) $ filter isKET xs         isKET (SigSubPacket _ (KeyExpirationTime _)) = True         isKET _ = False-        slpair x y = linebreak <> indent 2 (text x <> colon <+> y)         has = map hashAlgo . alleged+        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))-        mlpair x f ys = linebreak <> indent 2 (text x) <> colon <> mconcat (map ((linebreak <>) . indent 4 . f) ys)+        newest = take 1 . sortBy (comparing (Down . take 1 . sigcts)) -- FIXME: this is terrible+        stripOtherSigs tk = tk {+            _tkUIDs = map (second alleged) (_tkUIDs tk)+          , _tkUAts = map (second alleged) (_tkUAts tk)+        }+        stripOlderSigs tk = tk {+            _tkUIDs = map (second newest) (_tkUIDs tk)+          , _tkUAts = map (second newest) (_tkUAts tk)+        }++prettyKeyReport :: TK -> IO ()+prettyKeyReport key = getPOSIXTime >>= \cpt -> checkKey key >>= \keyReport -> putDoc . 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 self-sig hash algorithms (poorly):"+  <> mconcat (map (\(x,ys) -> slpair x (listHAs ys)) (Map.toList (keySelfSigHashAlgorithms keyReport)))+  <> linebreak <> text "Checking preferred hash algorithms (poorly):" -- FIXME+  <> mconcat (map (\(x,ys) -> mlpair x listPHAs ys) (Map.toList (keyPreferredHashAlgorithms keyReport)))+  <> linebreak <> text "Checking key expiration times based on" <+> text (formatTime defaultTimeLocale "%c" (posixSecondsToUTCTime . realToFrac $ (key^.tkPKP^.timestamp))) <+> text "(creation) and" <+> text (formatTime defaultTimeLocale "%c" (posixSecondsToUTCTime cpt)) <+> text "(current) times (poorly):" -- FIXME+  <> mconcat (map (\(x,ys) -> mlpair x (listKETs cpt (keyCreationTime keyReport)) ys) (Map.toList (keyExpirationTimes 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-        listHAs = list . map (\x -> ((if x `elem` [DeprecatedMD5, SHA1] then red else id) . text . show) x) . has-        listPHAs = (\x -> (if fSHA2Family x < ei DeprecatedMD5 x && fSHA2Family x < ei SHA1 x then green else red) . list . map (text . show) $ x) . phas+        slpair x y = linebreak <> indent 2 (text x <> colon <+> y)+        mlpair x f ys = linebreak <> indent 2 (text x) <> colon <> mconcat (map ((linebreak <>) . indent 4 . f) ys)+        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)-        listKETs = (\x -> (if null x || any (> (5*31557600)) x then red else green) . list . map (text . durationPrettyPrinter) $ x) . kets+        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+        keyExp ts ke = durationPrettyPrinter ke ++ " = " ++ formatTime defaultTimeLocale "%c" (posixSecondsToUTCTime (realToFrac ts + realToFrac ke)) +jsonReport :: TK -> IO ()+jsonReport key = checkKey key >>= \keyReport -> BL.putStr (A.encode keyReport)+ -- this does not have the same sense of calendar anyone else might durationPrettyPrinter :: TimeStamp -> String durationPrettyPrinter = concat . unfoldr durU@@ -108,38 +163,43 @@          | x > 0 = Just ((++"s") . show $ x, 0)          | otherwise = Nothing +data OutputFormat = Pretty | JSON+    deriving (Eq, Read, Show)+ data Options = Options {-    keyring :: String-  , target :: String+    outputFormat :: OutputFormat }  data Command = Lint Options -lintO :: String -> Parser Options-lintO homedir = Options-    <$> (fromMaybe (homedir ++ "/.gnupg/pubring.gpg") <$> optional (strOption-        ( long "keyring"-       <> metavar "FILE"-       <> help "file containing keyring" )))-    <*> argument str ( metavar "TARGET" )+lintO :: Parser Options+lintO = Options+    <$> option+        ( long "output-format"+       <> metavar "FORMAT"+       <> value Pretty+       <> showDefault+       <> help "output format" )  dispatch :: Command -> IO ()-dispatch (Lint o) = doLint o+dispatch (Lint o) = banner' stderr >> hFlush stderr >> doLint o  main :: IO () main = do-    homedir <- getHomeDirectory-    hPutStrLn stderr $ "hokey version " ++ showVersion version ++ ", Copyright (C) 2013-2014  Clint Adams\n\-     \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 (helper <*> cmd homedir) idm) >>= dispatch+    hSetBuffering stderr LineBuffering+    customExecParser (prefs showHelpOnError) (info (helper <*> versioner <*> cmd) (header (banner "hokey") <> progDesc "hOpenPGP Key utility" <> footer (warranty "hokey"))) >>= dispatch -cmd :: String -> Parser Command-cmd homedir = subparser-    ( command "lint" (info ( Lint <$> lintO homedir) ( progDesc "check key(s) for 'best practices'" )))+cmd :: Parser Command+cmd = subparser+    ( command "lint" (info ( Lint <$> lintO) ( progDesc "check key(s) for 'best practices'" )))  doLint :: Options -> IO () doLint o = do-    keys <- grabMatchingKeys (keyring o) (target o)-    mapM_ checkKey keys+    keys <- runResourceT $ CB.sourceHandle stdin $= conduitGet get $= conduitToTKsDropping $$ CL.consume+    mapM_ (output (outputFormat o)) keys+    where+        output Pretty = prettyKeyReport+        output JSON = jsonReport++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.1+version:             0.2 synopsis:            hOpenPGP-based command-line tools description:         command-line tools for performing some OpenPGP-related operations homepage:            http://floss.scru.org/hopenpgp-tools@@ -15,6 +15,7 @@ executable hot   main-is:             hot.hs   ghc-options:         -Wall+  other-modules:       HOpenPGP.Tools.Common   build-depends:       base                   > 4    && < 5                ,       attoparsec             >= 0.10.0.0                ,       bytestring@@ -22,6 +23,7 @@                ,       cereal-conduit                ,       conduit                ,       hOpenPGP               >= 0.11+               ,       lens                ,       openpgp-asciiarmor     >= 0.1                ,       optparse-applicative   >= 0.7                ,       text@@ -31,25 +33,31 @@ executable hokey   main-is:             hokey.hs   ghc-options:         -Wall+  other-modules:       HOpenPGP.Tools.Common   build-depends:       base                   > 4    && < 5+               ,       aeson                ,       ansi-wl-pprint                ,       bytestring                ,       cereal                ,       cereal-conduit                ,       conduit+               ,       containers                ,       crypto-pubkey                ,       directory                ,       hOpenPGP               >= 0.10.2                ,       ixset                ,       lens+               ,       old-locale                ,       optparse-applicative   >= 0.5.0                ,       text+               ,       time                ,       transformers   default-language: Haskell2010  executable hkt   main-is:             hkt.hs   ghc-options:         -Wall+  other-modules:       HOpenPGP.Tools.Common   build-depends:       base                   > 4    && < 5                ,       bytestring                ,       cereal@@ -57,10 +65,11 @@                ,       conduit                ,       crypto-pubkey                ,       directory-               ,       hOpenPGP               >= 0.8+               ,       hOpenPGP               >= 0.11.2                ,       ixset                ,       lens                ,       optparse-applicative   >= 0.5.0+               ,       text                ,       transformers   default-language: Haskell2010 @@ -71,4 +80,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hopenpgp-tools.git-  tag:      hopenpgp-tools/0.1+  tag:      hopenpgp-tools/0.2
hot.hs view
@@ -19,6 +19,7 @@ -- along with this program.  If not, see <http://www.gnu.org/licenses/>.  import Paths_hopenpgp_tools (version)+import HOpenPGP.Tools.Common (banner, versioner, warranty) import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..)) import Codec.Encryption.OpenPGP.Serialize ()@@ -39,9 +40,9 @@ import qualified Data.Text as T import Data.Version (showVersion) -import System.IO (stdin, stderr, stdout, hPutStrLn, hFlush, hSetBuffering, BufferMode(..))+import System.IO (stdin, stderr, stdout, Handle, hFlush, hPutStrLn, hSetBuffering, BufferMode(..)) -import Options.Applicative.Builder (command, help, idm, info, long, metavar, nullOption, reader, prefs, progDesc, showHelpOnError, strOption, subparser, ParseError(..))+import Options.Applicative.Builder (command, footer, header, help, info, long, metavar, nullOption, reader, prefs, progDesc, showHelpOnError, strOption, subparser, ParseError(..)) import Options.Applicative.Extra (customExecParser, helper) import Options.Applicative.Types (Parser, ReadM(..)) @@ -102,21 +103,17 @@     <*> 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+dispatch c = (banner' stderr >> hFlush stderr) >> dispatch' c+    where+        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-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 (helper <*> cmd) idm) >>= dispatch+    customExecParser (prefs showHelpOnError) (info (helper <*> versioner <*> cmd) (header (banner "hot") <> progDesc "hOpenPGP OpenPGP-message Tool" <> footer (warranty "hot"))) >>= dispatch  cmd :: Parser Command cmd = subparser@@ -126,6 +123,9 @@  <> command "filter" (info ( FilterC <$> foP ) ( progDesc "Filter some packets from stdin to stdout" ))   ) +banner' :: Handle -> IO ()+banner' h = hPutStrLn h (banner "hot" ++ "\n" ++ warranty "hot")+ parseExpressions :: FilteringOptions -> FilterPredicates parseExpressions FilteringOptions{..} = FilterPredicates (mp parsePE pkpExpression) (mp parseSE spExpression) (mp parseOE oExpression)     where@@ -244,7 +244,7 @@     rhs <- oValToken     return (E (OPredicate lhs op rhs))     where-        oVarToken = (A.string "tag" *> pure OVTag)+        oVarToken = A.string "tag" *> pure OVTag         oOpToken = (A.string "==" *> pure OEquals)                <|> (A.string "=" *> pure OEquals)                <|> (A.string "<" *> pure OLessThan)