parse email-style Date: headers when importing PEM files.

1 files changed, 12 insertions, 5 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index e0c3b77..94039f6 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -113,7 +113,7 @@ import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1
 import Data.ASN1.BitArray ( BitArray(..), toBitArray )
 import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' )
 import Data.ASN1.BinaryEncoding ( DER(..) )
-import Data.Time.Clock.POSIX ( POSIXTime, utcTimeToPOSIXSeconds )
+import Data.Time.Clock.POSIX ( POSIXTime, utcTimeToPOSIXSeconds, posixSecondsToUTCTime )
 import Data.Time.Clock ( UTCTime )
 import Data.Bits ( Bits )
 import Data.Text.Encoding ( encodeUtf8 )
@@ -1500,9 +1500,9 @@ readSecretPEMFile fname = do
     let ctx = InputFileContext "" ""
     -- Note: The key's timestamp is included in it's fingerprint.
     --       Therefore, we should attempt to preserve it.
-    timestamp <- getInputFileTime ctx fname
+    stamp <- getInputFileTime ctx fname
     input <- readInputFileL ctx fname
-    let dta = catMaybes $ scanAndParse (pkcs1 <> cert) $ Char8.lines input
+    let edta = scanAndParse (fmap Left dateParser <> fmap Right (pkcs1 <> cert)) $ Char8.lines input
         pkcs1 = fmap (parseRSAPrivateKey . pemBlob)
                     $ pemParser $ Just "RSA PRIVATE KEY"
         cert  = fmap (fmap PEMCertificate . parseCertBlob False . pemBlob)
@@ -1514,7 +1514,7 @@ readSecretPEMFile fname = do
            let _ = rsa :: RSAPrivateKey
            return $ PEMPacket $ SecretKeyPacket
                 { version = 4
-                , timestamp = toEnum (fromEnum timestamp)
+                , timestamp = fromTime stamp -- toEnum (fromEnum stamp)
                 , key_algorithm = RSA
                 , key = [ -- public fields...
                          ('n',rsaN rsa)
@@ -1532,7 +1532,14 @@ readSecretPEMFile fname = do
                 , encrypted_data = ""
                 , is_subkey = True
                 }
-    return dta
+        dta = catMaybes $ map snd $ scanl mergeDate (stamp,Nothing) edta
+        mergeDate (_,obj) (Left tm) = (fromTime tm,obj)
+        mergeDate (tm,_) (Right (Just (PEMPacket key))) = (tm,Just $ PEMPacket key')
+            where key' = if tm < fromTime (timestamp key)
+                            then key { timestamp = fromTime tm }
+                            else key
+        mergeDate (tm,_) (Right mb) = (tm,mb)
+    return $ dta
 
 doImport
   :: Ord k =>