summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs36
1 files changed, 9 insertions, 27 deletions
diff --git a/kiki.hs b/kiki.hs
index 5fcef99..217f70f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -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{-
1393data Arguments =
1394 Cross_Merge { homedir :: Maybe FilePath
1395 , passphrase_fd :: Maybe Int
1396 , files :: [FilePath]
1397 }
1398 deriving (Show, Data, Typeable)
1399-}
1400
1401toLast f [] = [] 1390toLast f [] = []
1402toLast f [x] = [f x] 1391toLast f [x] = [f x]
1403toLast f (x:xs) = x : toLast f xs 1392toLast f (x:xs) = x : toLast f xs
@@ -1420,11 +1409,7 @@ show_wk secring_file grip db = do
1420 1409
1421show_all db = do 1410show_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
1429show_whose_key input_key db = do 1414show_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)