diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 36 |
1 files changed, 9 insertions, 27 deletions
@@ -1324,7 +1324,7 @@ cross_merge doDecrypt keyrings wallets kd f = do | |||
1324 | let readp n = fmap (n,) (readPacketsFromFile n) | 1324 | let readp n = fmap (n,) (readPacketsFromFile n) |
1325 | readw wk n = fmap (n,) (readPacketsFromWallet wk n) | 1325 | readw wk n = fmap (n,) (readPacketsFromWallet wk n) |
1326 | 1326 | ||
1327 | let pass n = do | 1327 | let pass = do |
1328 | ms <- mapM readp (rtRings rt) | 1328 | ms <- mapM readp (rtRings rt) |
1329 | let grip = rtGrip rt `mplus` (fingerprint <$> fstkey) | 1329 | let grip = rtGrip rt `mplus` (fingerprint <$> fstkey) |
1330 | where | 1330 | where |
@@ -1380,24 +1380,13 @@ cross_merge doDecrypt keyrings wallets kd f = do | |||
1380 | hPutStrLn fh wip | 1380 | hPutStrLn fh wip |
1381 | 1381 | ||
1382 | db' <- f (rtSecring rt,grip) db (rtPubring rt) | 1382 | db' <- f (rtSecring rt,grip) db (rtPubring rt) |
1383 | maybe (if n==0 then pass 1 else return (rtRings rt,db)) | 1383 | return (rtRings rt,db') |
1384 | (return . (rtRings rt,)) | 1384 | (fsns,db) <- pass |
1385 | db' | ||
1386 | (fsns,db) <- pass 0 | ||
1387 | 1385 | ||
1388 | let lkmap = Map.fromList $ map (,()) fsns | 1386 | let lkmap = Map.fromList $ map (,()) fsns |
1389 | writeOutKeyrings lkmap db | 1387 | writeOutKeyrings lkmap db |
1390 | 1388 | ||
1391 | 1389 | ||
1392 | {- | ||
1393 | data Arguments = | ||
1394 | Cross_Merge { homedir :: Maybe FilePath | ||
1395 | , passphrase_fd :: Maybe Int | ||
1396 | , files :: [FilePath] | ||
1397 | } | ||
1398 | deriving (Show, Data, Typeable) | ||
1399 | -} | ||
1400 | |||
1401 | toLast f [] = [] | 1390 | toLast f [] = [] |
1402 | toLast f [x] = [f x] | 1391 | toLast f [x] = [f x] |
1403 | toLast f (x:xs) = x : toLast f xs | 1392 | toLast f (x:xs) = x : toLast f xs |
@@ -1420,11 +1409,7 @@ show_wk secring_file grip db = do | |||
1420 | 1409 | ||
1421 | show_all db = do | 1410 | show_all db = do |
1422 | let Message packets = flattenKeys True db | 1411 | let Message packets = flattenKeys True db |
1423 | -- let ks = filter isKey packets | ||
1424 | -- forM_ ks (warn . showPacket) | ||
1425 | -- warn $ "BEGIN LIST "++show (length packets)++" packets." | ||
1426 | putStrLn $ listKeys packets | 1412 | putStrLn $ listKeys packets |
1427 | -- warn $ "END LIST "++show (length packets)++" packets." | ||
1428 | 1413 | ||
1429 | show_whose_key input_key db = do | 1414 | show_whose_key input_key db = do |
1430 | flip (maybe $ return ()) input_key $ \input_key -> do | 1415 | flip (maybe $ return ()) input_key $ \input_key -> do |
@@ -1553,8 +1538,6 @@ doExport doDecrypt (db,use_db) (fname,subspec,ms,cmd) = | |||
1553 | ExitFailure num -> noop $ fname ++ ": failed external (code="++show num++")" | 1538 | ExitFailure num -> noop $ fname ++ ": failed external (code="++show num++")" |
1554 | ExitSuccess -> do | 1539 | ExitSuccess -> do |
1555 | warn $ fname ++ ": generated" | 1540 | warn $ fname ++ ": generated" |
1556 | -- return (Nothing,use_db) -- need another pass | ||
1557 | -- flip (maybe $ return (Nothing,use_db)) db $ \db -> do | ||
1558 | db' <- doImport doDecrypt db (fname,subspec,ms,cmd) | 1541 | db' <- doImport doDecrypt db (fname,subspec,ms,cmd) |
1559 | return (db', use_db) | 1542 | return (db', use_db) |
1560 | export = do | 1543 | export = do |
@@ -2451,7 +2434,7 @@ main = do | |||
2451 | 2434 | ||
2452 | use_db <- foldM (doBTCImport decrypt) use_db pbtcs | 2435 | use_db <- foldM (doBTCImport decrypt) use_db pbtcs |
2453 | 2436 | ||
2454 | (Just -> ret_db,_) <- foldM (doExport decrypt) (use_db,use_db) (map snd exports) | 2437 | (ret_db,_) <- foldM (doExport decrypt) (use_db,use_db) (map snd exports) |
2455 | 2438 | ||
2456 | use_db <- | 2439 | use_db <- |
2457 | flip (maybe $ return use_db) | 2440 | flip (maybe $ return use_db) |
@@ -2469,9 +2452,10 @@ main = do | |||
2469 | 2452 | ||
2470 | use_db <- markForImport margs grip pubring use_db | 2453 | use_db <- markForImport margs grip pubring use_db |
2471 | 2454 | ||
2472 | ret_db <- return $ fmap (const use_db) ret_db | 2455 | ret_db <- return use_db |
2473 | 2456 | ||
2474 | ret_db <- flip (maybe $ return ret_db) ret_db $ \db -> do | 2457 | ret_db <- do |
2458 | let db = ret_db | ||
2475 | let hns = maybe [] id $ Map.lookup "--hosts" margs | 2459 | let hns = maybe [] id $ Map.lookup "--hosts" margs |
2476 | hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns | 2460 | hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns |
2477 | 2461 | ||
@@ -2538,11 +2522,9 @@ main = do | |||
2538 | when (not $ null d) $ L.writeFile fname $ Hosts.encode h | 2522 | when (not $ null d) $ L.writeFile fname $ Hosts.encode h |
2539 | return () | 2523 | return () |
2540 | 2524 | ||
2541 | return (Just db') | 2525 | return db' |
2542 | |||
2543 | flip (maybe $ return ()) ret_db . const $ do | ||
2544 | 2526 | ||
2545 | 2527 | do | |
2546 | -- On last pass, interpret --show-* commands. | 2528 | -- On last pass, interpret --show-* commands. |
2547 | let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) | 2529 | let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) |
2548 | ,("--show-all",const $ show_all) | 2530 | ,("--show-all",const $ show_all) |