Implemented export of DNS secret key.

1 files changed, 49 insertions, 9 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 0bf3e32..7369acf 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -126,13 +126,13 @@ import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' )
 import Data.ASN1.BinaryEncoding ( DER(..) )
 import Data.Time.Clock.POSIX ( POSIXTime, utcTimeToPOSIXSeconds )
 import Data.Time.Clock ( UTCTime )
-import Data.Bits ( Bits )
+import Data.Bits ( Bits, shiftR )
 import Data.Text.Encoding ( encodeUtf8 )
 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 )
+import qualified Data.ByteString      as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, putStr, singleton, unfoldr, reverse )
 import qualified Codec.Binary.Base32 as Base32
 import qualified Codec.Binary.Base64 as Base64
 #if !defined(VERSION_cryptonite)
@@ -2058,8 +2058,8 @@ rsaPrivateKeyFromPacket _ = Nothing
 
 
 writeKeyToFile ::
-  Bool -> String -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
-writeKeyToFile False "PEM" fname packet = do
+  Bool -> FileType -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
+writeKeyToFile False PEMFile fname packet = do
     case key_algorithm packet of
      RSA -> do
         flip (maybe (return []))
@@ -2079,25 +2079,64 @@ writeKeyToFile False "PEM" fname packet = do
             return [(fname, ExportedSubkey)]
      algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
 
+writeKeyToFile False DNSPresentation fname packet = do
+    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)
+            b64 ac rsa = Base64.encode (S.unpack $ i2bs_unsized i)
+             where
+                MPI i = ac rsa
+                i2bs_unsized :: Integer -> S.ByteString
+                i2bs_unsized 0 = S.singleton 0
+                i2bs_unsized i = S.reverse $ S.unfoldr go i
+                 where go i' = if i' <= 0 then Nothing
+                                          else Just (fromIntegral i', (i' `shiftR` 8))
+            output = unlines
+                [ "Private-key-format: v1.2"
+                , "Algorithm: 8 (RSASHA256)"
+                , "Modulus: " ++ b64 rsaN rsa
+                , "PublicExponent: " ++ b64 rsaE rsa
+                , "PrivateExponent: " ++ b64 rsaD rsa
+                , "Prime1: " ++ b64 rsaP rsa
+                , "Prime2: " ++ b64 rsaQ rsa
+                , "Exponent1: " ++ b64 rsaDmodP1 rsa
+                , "Exponent2: " ++ b64 rsaDmodQminus1 rsa
+                , "Coefficient: " ++ b64 rsaCoefficient rsa
+                ]
+            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.
+            --       Therefore, we should attempt to preserve it.
+            writeStamped (InputFileContext "" "") fname stamp output
+            setFileCreationMask saved_mask
+            return [(fname, ExportedSubkey)]
+     algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
+
 writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet))
                 -> KeyDB
-                -> [(FilePath,Maybe String,[MappedPacket],Maybe Initializer)]
+                -> [(FilePath,Maybe String,[MappedPacket],FileType,Maybe Initializer)]
                 -> IO (KikiCondition [(FilePath,KikiReportAction)])
 writePEMKeys doDecrypt db exports = do
     ds <- mapM decryptKeys exports
     let ds' = map functorToEither ds
     if null (lefts ds')
         then do
-            rs <- mapM (\(f,p) -> writeKeyToFile False "PEM" (ArgFile f) p)
+            rs <- mapM (\(f,typ,p) -> writeKeyToFile False typ (ArgFile f) p)
                        (rights ds')
             return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs)
         else do
             return (head $ lefts ds')
  where
-    decryptKeys (fname,subspec,[p],_) = do
+    decryptKeys (fname,subspec,[p],typ,_) = do
         pun <- doDecrypt p
         try pun $ \pun -> do
-        return $ KikiSuccess (fname,pun)
+        return $ KikiSuccess (fname,typ,pun)
 
 makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
                         -> Map.Map KeyKey MappedPacket
@@ -2249,6 +2288,7 @@ initializeMissingPEMFiles ::
       -> IO (KikiCondition ( (KeyDB,[( FilePath
                                      , Maybe String
                                      , [MappedPacket]
+                                     , FileType
                                      , Maybe Initializer)])
                            , [(FilePath,KikiReportAction)]))
 initializeMissingPEMFiles operation ctx grip decrypt db = do
@@ -2274,7 +2314,7 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
                 return (fname,subspec,ns,(typ stream),initializer stream)
             (exports0,ambiguous) = partition (\(_,_,ns,_,_)->null $ drop 1 $ (ns>>=snd))
                                              notmissing
-            exports = map (\(f,subspec,ns,typ,cmd) -> (f,subspec,ns >>= snd,cmd)) exports0
+            exports = map (\(f,subspec,ns,typ,cmd) -> (f,subspec,ns >>= snd,typ,cmd)) exports0
 
             ambiguity (f,topspec,subspec,_,_) = do
                return $ AmbiguousKeySpec f