1 files changed, 71 insertions, 3 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)])