Bug-fix. (internal key generation)

1 files changed, 24 insertions, 13 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index b59fb9e..1c6dea8 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -243,9 +243,11 @@ data InputFile = HomeSec
                -- ^ Contents will be read from the first descriptor and updated
                -- content will be writen to the second. Note: Don't use Pipe
                -- for 'Wallet' files. (TODO: Wallet support)
-               | Generate GenerateKeyParams
+               | Generate Int GenerateKeyParams
                -- ^ New key packets will be generated if there is no
-               -- matching content already in the key pool.
+               -- matching content already in the key pool. The integer is
+               -- a unique id number so that multiple generations can be
+               -- inserted into 'opFiles'
  deriving (Eq,Ord,Show)
 
 -- type UsageTag = String
@@ -1307,7 +1309,9 @@ generateSubkey doDecrypt kd' (genparam,StreamInfo { spill = KF_Match tag }) = do
         kdr <- insertSubkey doDecrypt (keykey (keyPacket kd)) kd [mkUsage tag] "" newkey
         try kdr $ \(newkd,report) -> do
         return $ KikiSuccess (newkd, report ++ [("", NewPacket $ showPacket newkey)])
-      else return $ KikiSuccess (kd,report0)
+      else do
+        return $ KikiSuccess (kd,report0)
+generateSubkey _ kd _ = return kd
 
 importSecretKey ::
   (MappedPacket -> IO (KikiCondition Packet))
@@ -1447,8 +1451,8 @@ buildKeyDB ctx grip0 keyring = do
         ringMap0 = Map.filter (isring . typ) $ opFiles keyring
         (genMap,ringMap) = Map.partitionWithKey isgen ringMap0
             where
-                isgen (Generate _) _ = True
-                isgen _            _ = False
+                isgen (Generate _ _) _ = True
+                isgen _              _ = False
 
         readp f stream = fmap readp0 $ readPacketsFromFile ctx f
          where
@@ -1568,8 +1572,8 @@ buildKeyDB ctx grip0 keyring = do
 
     -- generate keys
     let gens = mapMaybe g $ Map.toList genMap
-                where g (Generate params,v) = Just (params,v)
-                      g _                   = Nothing
+                where g (Generate _ params,v) = Just (params,v)
+                      g _                     = Nothing
 
     db <- generateInternals doDecrypt mwk db gens
     try db $ \(db,reportGens) -> do
@@ -2474,9 +2478,15 @@ initializeMissingPEMFiles operation ctx grip mwk decrypt db = do
 
         let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do
                 (fname,stream) <- nonexistents
-                guard $ isMutable stream
-                guard $ isSecretKeyFile (typ stream)
-                usage <- usageFromFilter (fill stream) -- TODO: Error if no result?
+                let internalInitializer StreamInfo
+                        { initializer = Internal _
+                        , spill       = KF_Match tag } = Just tag
+                    internalInitializer _              = Nothing
+                    mutableTag
+                        | isMutable stream = usageFromFilter (fill stream)
+                        | otherwise        = Nothing
+                usage <- maybeToList $ internalInitializer stream `mplus` mutableTag
+                -- TODO: Report error if generating without specifying usage tag.
                 let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage
                     -- ms will contain duplicates if a top key has multiple matching
                     -- subkeys.  This is intentional.
@@ -2530,7 +2540,7 @@ initializeMissingPEMFiles operation ctx grip mwk decrypt db = do
                 where
                     getParams (fname,subspec,ms,stream) =
                         case initializer stream of
-                            Internal p -> Just (p, stream)[
+                            Internal p -> Just (p, stream)
                             _          -> Nothing
            v <- generateInternals decrypt mwk db internals
 
@@ -3568,5 +3578,6 @@ foreign import ccall unsafe "futimens"
 onionNameForContact :: KeyKey -> KeyDB -> Maybe String
 onionNameForContact kk db = do
     contact <- Map.lookup kk db
-    let (_,(name:_,_)) = getHostnames contact
-    return $ Char8.unpack name
+    case getHostnames contact of
+        (_,(name:_,_)) -> Just $ Char8.unpack name
+        _              -> Nothing