2 files changed, 71 insertions, 67 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 3268070..ee60765 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -19,7 +19,7 @@ import Data.Monoid
 import Data.Tuple             ( swap )
 import Data.Bits              ( (.|.) )
 import Control.Applicative    ( liftA2, (<$>) )
-import System.Directory       ( getHomeDirectory, doesFileExist )
+import System.Directory       ( getHomeDirectory, doesFileExist, createDirectoryIfMissing )
 import Control.Arrow          ( first, second )
 import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign)
 import Data.ByteString.Lazy   ( ByteString )
@@ -34,7 +34,8 @@ import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' )
 import Data.ASN1.BinaryEncoding ( DER(..) )
 import Data.Time.Clock.POSIX ( getPOSIXTime )
 import qualified Data.Map as Map
-import qualified Data.ByteString.Lazy as L ( pack, null, readFile, writeFile, ByteString, toChunks )
+import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile
+        , ByteString, toChunks )
 import qualified Data.ByteString      as S ( unpack, splitAt, concat, cons )
 import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines )
 import qualified Crypto.Types.PubKey.ECC as ECC
@@ -44,7 +45,9 @@ import qualified Crypto.Hash.SHA1 as SHA1
 import qualified Data.Text as T ( Text, unpack, pack,
         strip, reverse, drop, break, dropAround )
 import System.Posix.Types (EpochTime)
-import System.Posix.Files ( modificationTime, getFileStatus )
+import System.Posix.Files ( modificationTime, getFileStatus
+        , setFileCreationMask, setFileTimes )
+import System.FilePath ( takeDirectory )
 import System.IO (hPutStrLn,withFile,IOMode(..))
 import Data.Binary ( encode )
 
@@ -260,6 +263,8 @@ data KikiReportAction =
         | WarnFailedToMakeSignature
         | FailedExternal Int
         | ExternallyGeneratedFile
+        | UnableToExport KeyAlgorithm String
+        | FailedFileWrite
 
 data KikiResult a = KikiResult
     { kikiCondition :: KikiCondition a
@@ -999,6 +1004,69 @@ subkeysForExport subspec (KeyData key _ _ subkeys) = do
                           sigtrusts
         in fmap fst v==Just True
 
+writePEM typ dta = pem
+ where
+    pem = unlines . concat $
+            [ ["-----BEGIN " <> typ <> "-----"]
+            , split64s dta
+            , ["-----END " <> typ <> "-----"] ]
+    split64s "" = []
+    split64s dta = line : split64s rest where (line,rest) = splitAt 64 dta
+
+    -- 64 byte lines
+
+rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey
+rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
+    -- public fields...
+    n <- lookup 'n' $ key pkt
+    e <- lookup 'e' $ key pkt
+    -- secret fields
+    MPI d <- lookup 'd' $ key pkt
+    MPI q <- lookup 'p' $ key pkt -- Note: p & q swapped
+    MPI p <- lookup 'q' $ key pkt -- Note: p & q swapped
+
+    -- Note: Here we fail if 'u' key is missing.
+    -- Ideally, it would be better to compute (inverse q) mod p
+    -- see Algebra.Structures.EuclideanDomain.extendedEuclidAlg
+    --     (package constructive-algebra)
+    coefficient <- lookup 'u' $ key pkt 
+
+    let dmodp1 = MPI $ d `mod` (p - 1)
+        dmodqminus1 = MPI $ d `mod` (q - 1)
+    return $ RSAPrivateKey 
+        { rsaN = n
+        , rsaE = e
+        , rsaD = MPI d
+        , rsaP = MPI p
+        , rsaQ = MPI q
+        , rsaDmodP1 = dmodp1
+        , rsaDmodQminus1 = dmodqminus1
+        , rsaCoefficient = coefficient }
+rsaPrivateKeyFromPacket _ = Nothing
+
+
+writeKeyToFile False "PEM" fname packet =
+    case key_algorithm packet of
+    RSA -> do
+        flip (maybe (return []))
+             (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
+            $ \rsa -> do
+        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
+        createDirectoryIfMissing True (takeDirectory fname)
+        handleIO_ (return [(fname, FailedFileWrite)]) $ do
+            saved_mask <- setFileCreationMask 0o077
+            writeFile fname output
+            -- Note: The key's timestamp is included in it's fingerprint.
+            --       Therefore, we should attempt to preserve it.
+            setFileTimes fname stamp stamp
+            setFileCreationMask saved_mask
+            return [(fname, ExportedSubkey)]
+    algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
+
 writePEMKeys :: KeyDB
                 -> [(FilePath,Maybe String,[Packet],Maybe Initializer)]
                 -> IO (KikiCondition [(FilePath,KikiReportAction)])
diff --git a/kiki.hs b/kiki.hs
index 43d170c..1586517 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -125,35 +125,6 @@ decode_sshrsa bs = do
     return rsakey
         
 
-rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey
-rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
-    -- public fields...
-    n <- lookup 'n' $ key pkt
-    e <- lookup 'e' $ key pkt
-    -- secret fields
-    MPI d <- lookup 'd' $ key pkt
-    MPI q <- lookup 'p' $ key pkt -- Note: p & q swapped
-    MPI p <- lookup 'q' $ key pkt -- Note: p & q swapped
-
-    -- Note: Here we fail if 'u' key is missing.
-    -- Ideally, it would be better to compute (inverse q) mod p
-    -- see Algebra.Structures.EuclideanDomain.extendedEuclidAlg
-    --     (package constructive-algebra)
-    coefficient <- lookup 'u' $ key pkt 
-
-    let dmodp1 = MPI $ d `mod` (p - 1)
-        dmodqminus1 = MPI $ d `mod` (q - 1)
-    return $ RSAPrivateKey 
-        { rsaN = n
-        , rsaE = e
-        , rsaD = MPI d
-        , rsaP = MPI p
-        , rsaQ = MPI q
-        , rsaDmodP1 = dmodp1
-        , rsaDmodQminus1 = dmodqminus1
-        , rsaCoefficient = coefficient }
-rsaPrivateKeyFromPacket _ = Nothing
-
 
 {-
 getPackets :: IO [Packet]
@@ -165,17 +136,6 @@ getPackets = do
 -}
 
 
-writePEM typ dta = pem
- where
-    pem = unlines . concat $
-            [ ["-----BEGIN " <> typ <> "-----"]
-            , split64s dta
-            , ["-----END " <> typ <> "-----"] ]
-    split64s "" = []
-    split64s dta = line : split64s rest where (line,rest) = splitAt 64 dta
-
-    -- 64 byte lines
-
 isEmbeddedSignature (EmbeddedSignaturePacket {}) = True
 isEmbeddedSignature _                            = False
 
@@ -603,30 +563,6 @@ guessKeyFormat 'S' "ssh-client" = "PEM"
 guessKeyFormat 'S' "ssh-host"   = "PEM"
 guessKeyFormat _   _            = "PEM" -- "PGP"
 
-writeKeyToFile False "PEM" fname packet =
-    case key_algorithm packet of
-    RSA -> do
-        flip (maybe (return ()))
-             (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
-            $ \rsa -> do
-        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
-        createDirectoryIfMissing True (takeDirectory fname)
-        handleIO_ (warn $ fname ++ ": write failure") $ do
-            saved_mask <- setFileCreationMask 0o077
-            writeFile fname output
-            -- Note: The key's timestamp is included in it's fingerprint.
-            --       Therefore, we should attempt to preserve it.
-            setFileTimes fname stamp stamp
-            setFileCreationMask saved_mask
-            return ()
-        warn $ fname ++ ": exported"
-        return ()
-    algo -> warn $ fname ++ ": unable to export "++show algo++" key "++fingerprint packet
-
 readPublicKey :: Char8.ByteString -> RSAPublicKey
 readPublicKey bs = maybe er id $ do
     let (pre,bs1) = Char8.splitAt 7 bs