From 59b38a6070707e77b0e7b4b22c928806eb9415d3 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 23 Apr 2016 02:19:30 -0400
Subject: Added --secrets support to tar file export.

---
 KeyRing.hs | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

(limited to 'KeyRing.hs')

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
-- 
cgit v1.2.3