{-# LANGUAGE RecordWildCards #-}
-- hot.hs: hOpenPGP Tool
-- Copyright © 2012-2013 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/>.
import Paths_hopenpgp_tools (version)
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 Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Conduit (($=), ($$), Sink, runResourceT)
import Data.Conduit.Cereal (conduitGet)
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Serialize (get)
import Data.Serialize.Get (Get)
import Data.Version (showVersion)
import Data.Monoid ((<>))
import System.IO (stdin, stderr, hPutStrLn, hFlush, hSetBuffering, BufferMode(..))
import Options.Applicative.Builder (command, help, idm, info, long, metavar, nullOption, reader, progDesc, strOption, subparser, ParseError(..))
import Options.Applicative.Extra (execParser)
import Options.Applicative.Types (Parser)
data Command = DumpC | DeArmorC | ArmorC ArmoringOptions
data ArmoringOptions = ArmoringOptions {
comment :: Maybe String
, armortype :: ArmorType
}
doDump :: IO ()
doDump = do
runResourceT $ CB.sourceHandle stdin $= conduitGet (get :: Get Pkt) $$ printer
-- Print every input value to standard output.
printer :: (Show a, MonadIO m) => Sink a m ()
printer = CL.mapM_ (liftIO . print)
doDeArmor :: IO ()
doDeArmor = do
a <- runResourceT $ CB.sourceHandle stdin $$ CL.consume
case AA.decode (B.concat a) of
Left e -> hPutStrLn stderr $ "Failure to decode ASCII Armor:" ++ e
Right msgs -> BL.putStr $ BL.concat (map (\(Armor _ _ bs) -> bs) msgs)
doArmor :: ArmoringOptions -> IO ()
doArmor ArmoringOptions{..} = do
m <- runResourceT $ CB.sourceHandle stdin $$ CL.consume
let a = Armor armortype ([("Version", "hot " ++ showVersion version)] ++ maybe [] (\x -> [("Comment", x)]) comment ) (BL.fromChunks m)
BL.putStr $ AA.encodeLazy [a]
armorTypeReader :: String -> Either ParseError ArmorType
armorTypeReader "message" = Right ArmorMessage
armorTypeReader "pubkeyblock" = Right ArmorPublicKeyBlock
armorTypeReader "privkeyblock" = Right ArmorPrivateKeyBlock
armorTypeReader "signature" = Right ArmorSignature
armorTypeReader _ = Left (ErrorMsg "unknown armor type")
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")
dispatch :: Command -> IO ()
dispatch DumpC = doDump
dispatch DeArmorC = doDeArmor
dispatch (ArmorC o) = doArmor o
main :: IO ()
main = do
hSetBuffering stderr LineBuffering
hPutStrLn stderr $ "hot version " ++ showVersion version ++ ", Copyright (C) 2012-2013 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
execParser (info 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" ))
)