put the proper time stamps on ipsec/ssh exports.

2 files changed, 42 insertions, 17 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index a0d1e1a..21d7c3e 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -100,6 +100,8 @@ module KeyRing
     , secretPemFromPacket
     , SubkeyStatus(..)
     , getSubkeys
+    , writeKeyToFile
+    , resolveForReport
     ) where
 
 import System.Environment
@@ -662,7 +664,7 @@ data KikiReportAction =
         | FailedFileWrite
         | HostsDiff ByteString
         | DeletedPacket String
- deriving Show
+ deriving (Eq,Show)
 
 uncamel :: String -> String
 uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args
@@ -2246,8 +2248,8 @@ pemFromPacket AutoAccess p@(SecretKeyPacket {}) = pemFromPacket Sec p
 pemFromPacket AutoAccess _ = Nothing
 
 writeKeyToFile ::
-  Bool -> StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
-writeKeyToFile False stream@(StreamInfo { typ = PEMFile }) fname packet = do
+  StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
+writeKeyToFile stream@(StreamInfo { typ = PEMFile }) fname packet = do
     case pemFromPacket (access stream) packet of
      Just output -> do
         let stamp = toEnum . fromEnum $ timestamp packet
@@ -2260,7 +2262,7 @@ writeKeyToFile False stream@(StreamInfo { typ = PEMFile }) fname packet = do
             return [(fname, ExportedSubkey)]
      Nothing -> return [(fname, UnableToExport (key_algorithm packet) $ fingerprint packet)]
 
-writeKeyToFile False StreamInfo { typ = DNSPresentation } fname packet = do
+writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do
     case key_algorithm packet of
      RSA -> do
         flip (maybe (return []))
@@ -2308,7 +2310,7 @@ writePEMKeys doDecrypt db exports = do
     let ds' = map functorToEither ds
     if null (lefts ds')
         then do
-            rs <- mapM (\(f,stream,p) -> writeKeyToFile False stream (ArgFile f) p)
+            rs <- mapM (\(f,stream,p) -> writeKeyToFile stream (ArgFile f) p)
                        (rights ds')
             return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs)
         else do
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index b1f7ad7..8a1878b 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -82,6 +82,11 @@ run args x =
         Left e   -> hPutStrLn stderr $ usageErrorMessage e
         Right io -> io
 
+outputReport :: [(FilePath, KikiReportAction)] -> IO ()
+outputReport report = do
+    forM_ report $ \(fname,act) -> do
+        putStrLn $ fname ++ ": " ++ reportString act
+
 importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
 importAndRefresh root cmn = do
     let rootdir = do guard (root "x" /= "x")
@@ -195,8 +200,7 @@ importAndRefresh root cmn = do
             }
     -- if bUnprivileged then doNothing else mkdirFor torpath
     KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
-    forM_ report $ \(fname,act) -> do
-        putStrLn $ fname ++ ": " ++ reportString act
+    outputReport report
     rt <- case rt of
         BadPassphrase ->
             error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
@@ -237,16 +241,35 @@ refreshCache rt rootdir = do
 
     let grip = fingerprint wk
         wkkd = rtKeyDB rt Map.! keykey wk
-
-    either warn (write $ mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") $ do
-        -- Note: no sig check here. That may be incautious...
-        let my_ipsecs :: [Packet]
-            my_ipsecs = sortOn (Down . timestamp)
-                         $ getSubkeys Unsigned wk (keySubKeys wkkd) "ipsec"
-        case my_ipsecs of
-            ipsec:_ -> maybe (Left "unsupported ipsec key type") Right
-                            $ secretPemFromPacket ipsec
-            _       -> Left "missing ipsec key?"
+        getSecret tag = sortOn (Down . timestamp)
+                        $ getSubkeys Unsigned wk (keySubKeys wkkd) tag
+
+    let writeSecret tag path warning = do
+        let my_ks :: [Packet]
+            my_ks = getSecret "ipsec"
+        case my_ks of
+            sec:_ -> do report <- writeKeyToFile streaminfo { typ = PEMFile
+                                                            , access = Sec
+                                                            , spill = KF_All
+                                                            }
+                                                 (ArgFile path)
+                                                 sec
+                        let ctx = Just $ InputFileContext "secring.gpg" "pubring.gpg"
+                        outputReport $ map (first $ resolveForReport ctx)
+                                     $ filter ((/=ExportedSubkey) . snd) report
+            _     -> warn warning
+
+    writeSecret "ipsec"
+                (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem")
+                "missing ipsec key?"
+
+    writeSecret "ssh-client"
+                (mkpath "root/.ssh/id_rsa")
+                "missing ssh-client key?"
+
+    writeSecret "ssh-server"
+                (mkpath "ssh_host_rsa_key")
+                "missing ssh host key?"
 
     -- Finally, export public keys if they do not exist.
     either warn (write $ mkpath "root/.ssh/id_rsa.pub")