cokiki build fix & show --packets option.

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 <command> [--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)