Added --secrets support to tar file export.

1 files changed, 34 insertions, 7 deletions

diff --git a/kiki.hs b/kiki.hs
index d58ef2a..087e24f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -10,6 +10,7 @@ module Main ( main ) where
 
 import Control.Applicative
 import Control.Monad
+import Control.Monad.Fix
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.Encoding
 import Data.ASN1.Types
@@ -268,6 +269,9 @@ partitionStaticArguments specs args = psa args
     psa [] = ([],[])
     psa (a:as) =
       case Map.lookup a smap of
+        Nothing | (k,'=':v) <- break (=='=') a
+                , Just 1 <- Map.lookup k smap
+            -> first ([k,v]:) $ psa as
         Nothing -> second (a:) $ psa as
         Just n  -> first ((a:take n as):) $ psa (drop n as)
 
@@ -1729,25 +1733,48 @@ tarC (sargs,margs) = do
       KikiSuccess rt -> do
         CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt)
         let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs
-            fs = tarContent rt keyspec build_ipsec (build_ssh rt pubtime) (error "todo")
+            fs = tarContent rt keyspec build_ipsec (build_ssh rt pubtime) (build_secret rt)
             es = do
-                (n,(epoch_time_int64,bs)) <- fs
-                entry <- either (const []) (return . flip Tar.fileEntry bs) $ Tar.toTarPath False n
-                return $ entry { Tar.entryTime = epoch_time_int64 }
-            tarbs = Tar.write es
+                (n,(epoch_time_int64,ebs)) <- fs
+                let mktar' = mktar n epoch_time_int64
+                return $ case ebs of
+                    Right bs -> return $ either (const Nothing) Just $  mktar' bs
+                    Left iombs -> do
+                        mbs <- iombs
+                        case mbs of
+                            Nothing -> return Nothing
+                            Just bs -> return $ either (const Nothing) Just $ mktar' bs
+        tarbs <- Tar.write . mapMaybe id <$> sequence es
         L.putStr tarbs
       err -> putStrLn $ errorString err
  where
     build_ipsec ns addr ipsec sigs
        = ( fromIntegral $ timestamp ipsec
-         , Char8.pack $ fromJust $ pemFromPacket ipsec)
-    build_ssh rt timestamp sshs = (timestamp, Char8.unlines $ map knownhost sshs)
+         , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec)
+    build_ssh rt timestamp sshs = (timestamp, Right $ Char8.unlines $ map knownhost sshs)
      where
         knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey)
          where
             ns = onames ++ others
             (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk
 
+    build_secret rt k = ( fromIntegral $ timestamp k
+                        , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k )
+
+    mktar n epoch_time_int64 bs = do
+        torpath <- Tar.toTarPath False n
+        Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 }
+
+    decrypt :: KeyRingRuntime -> Packet -> IO (Maybe Packet)
+    decrypt rt k@SecretKeyPacket { symmetric_algorithm = Unencrypted } = return $ Just k
+    decrypt rt k = do
+        r <- rtPassphrases rt (MappedPacket k Map.empty)
+        case r of
+            KikiSuccess p -> return $ Just p
+            _ -> do
+                hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"."
+                return Nothing
+
 minimalOp :: CommonArgsParsed -> KeyRingOperation
 minimalOp cap = op
  where