summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-04-25 05:07:01 -0400
committerjoe <joe@jerkface.net>2016-04-25 05:07:01 -0400
commit35edce91c66282a053e80eb419876d258b373725 (patch)
tree8371f3ccfd2fd1b7c0d407d60715dfaf3179ac86 /lib
parent20131e89870ad889a76d44cb8ffcba3fbe00ecc1 (diff)
Bug-fix. (internal key generation)
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing.hs37
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)
1314generateSubkey _ kd _ = return kd
1311 1315
1312importSecretKey :: 1316importSecretKey ::
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"
3568onionNameForContact :: KeyKey -> KeyDB -> Maybe String 3578onionNameForContact :: KeyKey -> KeyDB -> Maybe String
3569onionNameForContact kk db = do 3579onionNameForContact 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