From 78c2c3753e69818aa7fd5d3a0354fea5d0fc452b Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 29 Aug 2016 22:24:08 -0400 Subject: cokiki build fix & show --packets option. --- cokiki.hs | 9 +++++---- kiki.cabal | 1 + kiki.hs | 6 ++++++ lib/GnuPGAgent.hs | 3 ++- lib/KeyRing.hs | 24 +++++++++++++++++++++--- lib/PacketTranscoder.hs | 5 ++++- 6 files changed, 39 insertions(+), 9 deletions(-) diff --git a/cokiki.hs b/cokiki.hs index f8eed0a..54cc4ba 100644 --- a/cokiki.hs +++ b/cokiki.hs @@ -19,6 +19,7 @@ import System.Exit import System.IO import System.Posix.User import CommandLine +import Data.OpenPGP (SymmetricAlgorithm(Unencrypted)) usage = unlines [ "cokiki [--chroot=ROOTDIR]" @@ -116,7 +117,7 @@ sshClient uid root cmn = whenRoot uid root cmn $ do maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig' -- /var/cache/kiki/config/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... - Kiki.importAndRefresh root cmn + Kiki.importAndRefresh root cmn Unencrypted sshServer uid root cmn = whenRoot uid root cmn $ do sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/sshd_config") @@ -129,7 +130,7 @@ sshServer uid root cmn = whenRoot uid root cmn $ do hPutStrLn stderr "adding HostKey directive" myWriteFile (root "/etc/ssh/sshd_config") $ unparseSshConfig sshconfig' -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/config/ssh_host_ecdsa_key' etc. - Kiki.importAndRefresh root cmn + Kiki.importAndRefresh root cmn Unencrypted strongswan uid root cmn = whenRoot uid root cmn $ do -- Parsing as if ssh config, that's not right, but good enough for now. @@ -143,7 +144,7 @@ strongswan uid root cmn = whenRoot uid root cmn $ do hPutStrLn stderr "adding include directive" myWriteFile (root "/etc/ipsec.conf") $ unparseSshConfig ipsecconf' -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' - Kiki.importAndRefresh root cmn + Kiki.importAndRefresh root cmn Unencrypted configureTor uid root cmn = whenRoot uid root cmn $ do -- Parsing as if ssh config, that's not right, but good enough for now. @@ -197,7 +198,7 @@ configureTor uid root cmn = whenRoot uid root cmn $ do , ["HiddenServicePort"," ","22"," ","127.0.0.1:22"] , ["HiddenServicePort"," ","25"," ","127.0.0.1:25"] ] myWriteFile (root "/etc/tor/torrc") $ unparseSshConfig torrc' - Kiki.importAndRefresh root cmn + Kiki.importAndRefresh root cmn Unencrypted return () diff --git a/kiki.cabal b/kiki.cabal index 8eb4f17..012bdf9 100644 --- a/kiki.cabal +++ b/kiki.cabal @@ -70,6 +70,7 @@ Executable cokiki unix, directory, deepseq, + openpgp-util, kiki library diff --git a/kiki.hs b/kiki.hs index f42ee22..d3e505a 100644 --- a/kiki.hs +++ b/kiki.hs @@ -306,6 +306,10 @@ show_all db = do let Message packets = flattenKeys True db putStrLn $ listKeys packets +show_packets puborsec db = do + let Message packets = flattenKeys (case puborsec of { "sec":_ -> False; _ -> True }) db + forM_ packets $ putStrLn . showPacket + show_whose_key input_key db = flip (maybe $ return ()) input_key $ \input_key -> do let ks = whoseKey input_key db @@ -1220,6 +1224,7 @@ kiki "show" args = do , ("--dump",0) --("--show-all",0) , ("--all",0) --("--show-all",0) , ("--whose-key",0) + , ("--packets",1) , ("--key",1) , ("--pem",1) , ("--dns",1) @@ -1271,6 +1276,7 @@ kiki "show" args = do let shspec = Map.fromList [("--working", const $ show_wk (rtSecring rt) grip) ,("--all",const show_all) ,("--whose-key", const $ show_whose_key input_key) + ,("--packets", show_packets) ,("--key",\[x] -> show_id x $ fromMaybe "" grip) ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) ,("--dns",\[x] -> show_dns x $ fromMaybe "" grip) diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs index 5878357..7161b92 100644 --- a/lib/GnuPGAgent.hs +++ b/lib/GnuPGAgent.hs @@ -7,7 +7,8 @@ module GnuPGAgent , QueryMode(..) , getPassphrase , clearPassphrase - , quit ) where + , quit + , key_nbits) where import Debug.Trace import Control.Monad diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 8a23ff9..84d484d 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs @@ -114,6 +114,7 @@ module KeyRing , resolveForReport , KeyKey -- needed for Type sigs , makeMemoizingDecrypter + , showPacket ) where import System.Environment @@ -1983,9 +1984,26 @@ showPacket :: Packet -> String showPacket p | isKey p = (if is_subkey p then showPacket0 p else ifSecret p "----Secret-----" "----Public-----") - ++ " "++show (key_algorithm p)++" "++fingerprint p - | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) - | otherwise = showPacket0 p + ++ " "++fingerprint p + ++ " "++show (key_algorithm p) + ++ case key_nbits p of { 0 -> ""; n -> "("++show n++")" } + | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) + -- | isSignaturePacket p = showPacket0 p ++ maybe "" ((++) (" ^ signed"++sigusage p++": ")) (signature_issuer p) + | isSignaturePacket p = showPacket0 p ++ maybe "" (" ^ signed: "++) (signature_issuer p) ++ sigusage p + | otherwise = showPacket0 p + where + sigusage p = + case take 1 (tagStrings p) of + [] -> "" + tag:_ -> " "++show tag -- "("++tag++")" + where + tagStrings p = usage_tags ++ flags + where + usage_tags = mapMaybe usage xs + flags = mapMaybe (fmap usageString . keyflags) xs + xs = hashed_subpackets p + + showPacket0 p = concat . take 1 $ words (show p) diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs index 07f235c..6d1d9b8 100644 --- a/lib/PacketTranscoder.hs +++ b/lib/PacketTranscoder.hs @@ -19,6 +19,7 @@ import System.IO ( stderr) import System.Posix.IO ( fdToHandle ) import Text.Show.Pretty as PP ( ppShow ) import Types +import ControlMaybe (handleIO_) -- | Merge two representations of the same key, prefering secret version -- because they have more information. @@ -168,6 +169,7 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do -- in the 'locations' field, so this would effectively -- allow you to run 'decryptIt' on an unencrypted public key -- to obtain it's secret key. + handleIO_ (decryptIt []) $ do (pw,wants_retry) <- getpw (count,qry) let wkun = fromMaybe wk $ do guard $ symmetric_algorithm (packet mp) /= Unencrypted @@ -218,11 +220,12 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do | otherwise = return () clear let sanitizeQry qry = (fingerprint $ queryPacket qry, queryUID qry, fmap fingerprint $ queryMainKey qry) - putStrLn $ "(count,firsttime,ask,qry,actual_qry)="++show (count,firsttime,ask,sanitizeQry qry, sanitizeQry actual_qry) + -- putStrLn $ "(count,firsttime,ask,qry,actual_qry)="++show (count,firsttime,ask,sanitizeQry qry, sanitizeQry actual_qry) mbpw <- getPassphrase s ask actual_qry quit s return ( maybe "" S8.pack mbpw, guard (ask /= AskNew) >> Just clear ) + -- putStrLn $ concat [show (symmetric_algorithm wk,s2k wk)," --> ",show (dest_alg,dest_s2k)] if symmetric_algorithm wk == dest_alg && ( symmetric_algorithm wk == Unencrypted || s2k wk == dest_s2k ) then return (KikiSuccess wk) -- cgit v1.2.3