diff options
Diffstat (limited to 'lib/KeyRing.hs')
-rw-r--r-- | lib/KeyRing.hs | 37 |
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 | |||
243 | -- ^ Contents will be read from the first descriptor and updated | 243 | -- ^ Contents will be read from the first descriptor and updated |
244 | -- content will be writen to the second. Note: Don't use Pipe | 244 | -- content will be writen to the second. Note: Don't use Pipe |
245 | -- for 'Wallet' files. (TODO: Wallet support) | 245 | -- for 'Wallet' files. (TODO: Wallet support) |
246 | | Generate GenerateKeyParams | 246 | | Generate Int GenerateKeyParams |
247 | -- ^ New key packets will be generated if there is no | 247 | -- ^ New key packets will be generated if there is no |
248 | -- matching content already in the key pool. | 248 | -- matching content already in the key pool. The integer is |
249 | -- a unique id number so that multiple generations can be | ||
250 | -- inserted into 'opFiles' | ||
249 | deriving (Eq,Ord,Show) | 251 | deriving (Eq,Ord,Show) |
250 | 252 | ||
251 | -- type UsageTag = String | 253 | -- type UsageTag = String |
@@ -1307,7 +1309,9 @@ generateSubkey doDecrypt kd' (genparam,StreamInfo { spill = KF_Match tag }) = do | |||
1307 | kdr <- insertSubkey doDecrypt (keykey (keyPacket kd)) kd [mkUsage tag] "" newkey | 1309 | kdr <- insertSubkey doDecrypt (keykey (keyPacket kd)) kd [mkUsage tag] "" newkey |
1308 | try kdr $ \(newkd,report) -> do | 1310 | try kdr $ \(newkd,report) -> do |
1309 | return $ KikiSuccess (newkd, report ++ [("", NewPacket $ showPacket newkey)]) | 1311 | return $ KikiSuccess (newkd, report ++ [("", NewPacket $ showPacket newkey)]) |
1310 | else return $ KikiSuccess (kd,report0) | 1312 | else do |
1313 | return $ KikiSuccess (kd,report0) | ||
1314 | generateSubkey _ kd _ = return kd | ||
1311 | 1315 | ||
1312 | importSecretKey :: | 1316 | importSecretKey :: |
1313 | (MappedPacket -> IO (KikiCondition Packet)) | 1317 | (MappedPacket -> IO (KikiCondition Packet)) |
@@ -1447,8 +1451,8 @@ buildKeyDB ctx grip0 keyring = do | |||
1447 | ringMap0 = Map.filter (isring . typ) $ opFiles keyring | 1451 | ringMap0 = Map.filter (isring . typ) $ opFiles keyring |
1448 | (genMap,ringMap) = Map.partitionWithKey isgen ringMap0 | 1452 | (genMap,ringMap) = Map.partitionWithKey isgen ringMap0 |
1449 | where | 1453 | where |
1450 | isgen (Generate _) _ = True | 1454 | isgen (Generate _ _) _ = True |
1451 | isgen _ _ = False | 1455 | isgen _ _ = False |
1452 | 1456 | ||
1453 | readp f stream = fmap readp0 $ readPacketsFromFile ctx f | 1457 | readp f stream = fmap readp0 $ readPacketsFromFile ctx f |
1454 | where | 1458 | where |
@@ -1568,8 +1572,8 @@ buildKeyDB ctx grip0 keyring = do | |||
1568 | 1572 | ||
1569 | -- generate keys | 1573 | -- generate keys |
1570 | let gens = mapMaybe g $ Map.toList genMap | 1574 | let gens = mapMaybe g $ Map.toList genMap |
1571 | where g (Generate params,v) = Just (params,v) | 1575 | where g (Generate _ params,v) = Just (params,v) |
1572 | g _ = Nothing | 1576 | g _ = Nothing |
1573 | 1577 | ||
1574 | db <- generateInternals doDecrypt mwk db gens | 1578 | db <- generateInternals doDecrypt mwk db gens |
1575 | try db $ \(db,reportGens) -> do | 1579 | try db $ \(db,reportGens) -> do |
@@ -2474,9 +2478,15 @@ initializeMissingPEMFiles operation ctx grip mwk decrypt db = do | |||
2474 | 2478 | ||
2475 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do | 2479 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do |
2476 | (fname,stream) <- nonexistents | 2480 | (fname,stream) <- nonexistents |
2477 | guard $ isMutable stream | 2481 | let internalInitializer StreamInfo |
2478 | guard $ isSecretKeyFile (typ stream) | 2482 | { initializer = Internal _ |
2479 | usage <- usageFromFilter (fill stream) -- TODO: Error if no result? | 2483 | , spill = KF_Match tag } = Just tag |
2484 | internalInitializer _ = Nothing | ||
2485 | mutableTag | ||
2486 | | isMutable stream = usageFromFilter (fill stream) | ||
2487 | | otherwise = Nothing | ||
2488 | usage <- maybeToList $ internalInitializer stream `mplus` mutableTag | ||
2489 | -- TODO: Report error if generating without specifying usage tag. | ||
2480 | let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage | 2490 | let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage |
2481 | -- ms will contain duplicates if a top key has multiple matching | 2491 | -- ms will contain duplicates if a top key has multiple matching |
2482 | -- subkeys. This is intentional. | 2492 | -- subkeys. This is intentional. |
@@ -2530,7 +2540,7 @@ initializeMissingPEMFiles operation ctx grip mwk decrypt db = do | |||
2530 | where | 2540 | where |
2531 | getParams (fname,subspec,ms,stream) = | 2541 | getParams (fname,subspec,ms,stream) = |
2532 | case initializer stream of | 2542 | case initializer stream of |
2533 | Internal p -> Just (p, stream)[ | 2543 | Internal p -> Just (p, stream) |
2534 | _ -> Nothing | 2544 | _ -> Nothing |
2535 | v <- generateInternals decrypt mwk db internals | 2545 | v <- generateInternals decrypt mwk db internals |
2536 | 2546 | ||
@@ -3568,5 +3578,6 @@ foreign import ccall unsafe "futimens" | |||
3568 | onionNameForContact :: KeyKey -> KeyDB -> Maybe String | 3578 | onionNameForContact :: KeyKey -> KeyDB -> Maybe String |
3569 | onionNameForContact kk db = do | 3579 | onionNameForContact kk db = do |
3570 | contact <- Map.lookup kk db | 3580 | contact <- Map.lookup kk db |
3571 | let (_,(name:_,_)) = getHostnames contact | 3581 | case getHostnames contact of |
3572 | return $ Char8.unpack name | 3582 | (_,(name:_,_)) -> Just $ Char8.unpack name |
3583 | _ -> Nothing | ||