3 files changed, 53 insertions, 20 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index d4bb099..620f9ad 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -45,6 +45,7 @@ module KeyRing
     , KeyFilter(..)
     -- * Results of a KeyRing Operation
     , KeyRingRuntime(..)
+    , MappedPacket(..)
     , KeyDB
     , KeyData(..)
     , SubKey(..)
@@ -97,6 +98,7 @@ module KeyRing
     , keyPacket
     , KeySpec(..)
     , getHostnames
+    , secretPemFromPacket
     ) where
 
 import System.Environment
@@ -132,7 +134,7 @@ import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile
         , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt
         , index, break, pack )
-import qualified Data.ByteString      as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, putStr, singleton, unfoldr, reverse )
+import qualified Data.ByteString      as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, hPutStr, singleton, unfoldr, reverse )
 import qualified Codec.Binary.Base32 as Base32
 import qualified Codec.Binary.Base64 as Base64
 #if !defined(VERSION_cryptonite)
@@ -166,7 +168,7 @@ import Foreign.C.Error ( throwErrnoIfMinus1_ )
 import Foreign.Storable
 #endif
 import System.FilePath ( takeDirectory )
-import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr)
+import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr, stderr)
 import Data.IORef
 import System.Posix.IO ( fdToHandle )
 import qualified Data.Traversable as Traversable
@@ -1181,7 +1183,7 @@ cachedContents maybePrompt ctx fd = do
         pw <- readIORef ref
         flip (flip maybe return) pw $ do
             if fd == FileDesc 0 then case maybePrompt of
-                                    Just prompt -> S.putStr prompt
+                                    Just prompt -> S.hPutStr stderr prompt
                                     Nothing -> return ()
                                else return ()
             pw <- fmap trimCR $ readInputFileS ctx fd
@@ -2059,20 +2061,23 @@ rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
         , rsaCoefficient = coefficient }
 rsaPrivateKeyFromPacket _ = Nothing
 
-
-writeKeyToFile ::
-  Bool -> FileType -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
-writeKeyToFile False PEMFile fname packet = do
+secretPemFromPacket packet =
     case key_algorithm packet of
      RSA -> do
-        flip (maybe (return []))
-             (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
-            $ \rsa -> do
+        rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey
         let asn1 = toASN1 rsa []
             bs = encodeASN1 DER asn1
             dta = Base64.encode (L.unpack bs)
             output = writePEM "RSA PRIVATE KEY" dta
-            stamp = toEnum . fromEnum $ timestamp packet
+        Just output
+     algo -> Nothing
+
+writeKeyToFile ::
+  Bool -> FileType -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
+writeKeyToFile False PEMFile fname packet = do
+    case secretPemFromPacket packet of
+     Just output -> do
+        let stamp = toEnum . fromEnum $ timestamp packet
         handleIO_ (return [(fname, FailedFileWrite)]) $ do
             saved_mask <- setFileCreationMask 0o077
             -- Note: The key's timestamp is included in it's fingerprint.
@@ -2080,7 +2085,7 @@ writeKeyToFile False PEMFile fname packet = do
             writeStamped (InputFileContext "" "") fname stamp output
             setFileCreationMask saved_mask
             return [(fname, ExportedSubkey)]
-     algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
+     Nothing -> return [(fname, UnableToExport (key_algorithm packet) $ fingerprint packet)]
 
 writeKeyToFile False DNSPresentation fname packet = do
     case key_algorithm packet of
diff --git a/kiki.cabal b/kiki.cabal
index 3658aa4..176d09c 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -30,7 +30,8 @@ Executable kiki
                      bytestring -any, binary -any,
                      unix, time,
                      containers -any, process -any, filepath -any,
-                     network -any, old-locale -any, zlib -any
+                     network -any, old-locale -any, zlib -any,
+                     tar
     if !flag(cryptonite)
       Build-Depends:   crypto-pubkey >=0.2.3, cryptohash -any,
                        crypto-pubkey-types -any
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