doImport now capable of handling multiple keys from a single pem.

1 files changed, 14 insertions, 11 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index ad3e2ae..f7a1a12 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1454,8 +1454,8 @@ decodeBlob cert =
     key = maybe "" (encodeASN1 DER . flip toASN1 []) $ rsaKeyFromPacket $ pcertKey cert
 
 
-readKeyFromFile :: Bool -> String -> InputFile -> IO [SecretPEMData]
-readKeyFromFile False "PEM" fname = do
+readSecretPEMFile :: InputFile -> IO [SecretPEMData]
+readSecretPEMFile fname = do
     -- warn $ fname ++ ": reading ..."
     let ctx = InputFileContext "" ""
     -- Note: The key's timestamp is included in it's fingerprint.
@@ -1493,7 +1493,6 @@ readKeyFromFile False "PEM" fname = do
                 , is_subkey = True
                 }
     return dta
-readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
 
 doImport
   :: Ord k =>
@@ -1502,17 +1501,21 @@ doImport
      -> (FilePath, Maybe [Char], [k], t)
      -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)]))
 doImport doDecrypt db (fname,subspec,ms,_) = do
-    let fetchkey = readKeyFromFile False "PEM" (ArgFile fname)
     flip (maybe $ return CannotImportMasterKey)
          subspec $ \tag -> do
-    ps <- fetchkey
+    ps <- readSecretPEMFile (ArgFile fname)
     let parsedkey = mapMaybe spemPacket ps
-    flip (maybe $ return $ KikiSuccess (db,[]))
-         (listToMaybe parsedkey) $ \key -> do
-    let (m0,tailms) = splitAt 1 ms
-    if (not (null tailms) || null m0)
-        then return $ AmbiguousKeySpec fname
-        else doImportG doDecrypt db m0 tag fname key
+    foldM (importPemThing tag) (KikiSuccess (db,[])) parsedkey
+ where
+    importPemThing tag prior key = do
+        try prior $ \(db,report) -> do
+        let (m0,tailms) = splitAt 1 ms
+        if (not (null tailms) || null m0)
+            then return $ AmbiguousKeySpec fname
+            else do
+                r <- doImportG doDecrypt db m0 tag fname key
+                try r $ \(db',report') -> do
+                return $ KikiSuccess (db',report++report')
 
 doImportG
   :: Ord k =>