diff options
-rw-r--r-- | kiki.hs | 13 |
1 files changed, 11 insertions, 2 deletions
@@ -1277,8 +1277,8 @@ main = do | |||
1277 | (toptyp,top) = unprefix ':' topspec | 1277 | (toptyp,top) = unprefix ':' topspec |
1278 | (subtyp,sub) = unprefix ':' subspec | 1278 | (subtyp,sub) = unprefix ':' subspec |
1279 | 1279 | ||
1280 | {- | ||
1281 | putStrLn $ "files = " ++ show files | 1280 | putStrLn $ "files = " ++ show files |
1281 | {- | ||
1282 | putStrLn $ "topspec = " ++show (toptyp,top) | 1282 | putStrLn $ "topspec = " ++show (toptyp,top) |
1283 | putStrLn $ "subspec = " ++show (subtyp,sub) | 1283 | putStrLn $ "subspec = " ++show (subtyp,sub) |
1284 | -} | 1284 | -} |
@@ -1289,11 +1289,19 @@ main = do | |||
1289 | 1289 | ||
1290 | flip (maybe (error "No working key?")) grip $ \grip -> do | 1290 | flip (maybe (error "No working key?")) grip $ \grip -> do |
1291 | 1291 | ||
1292 | ms <- mapM readPacketsFromFile files | ||
1293 | let db = merge Map.empty (Message sec) | ||
1294 | db' = foldl' merge db ms | ||
1295 | m = flattenKeys db' | ||
1296 | Message allpkts = m | ||
1297 | |||
1292 | let topspec = case () of | 1298 | let topspec = case () of |
1293 | _ | null top -> {- trace "using grip" $ -} KeyGrip grip | 1299 | _ | null top -> {- trace "using grip" $ -} KeyGrip grip |
1294 | _ | is40digitHex top -> {- trace "using top" $ -} KeyGrip top | 1300 | _ | is40digitHex top -> {- trace "using top" $ -} KeyGrip top |
1295 | _ | otherwise -> todo | 1301 | _ | otherwise -> todo |
1296 | (pre, wk:subs) = seek_key topspec sec | 1302 | (pre, wksubs) = seek_key topspec allpkts |
1303 | if null wksubs then error ("No match for "++spec) else do | ||
1304 | let wk:subs = wksubs | ||
1297 | (xs,ys) = seek_key (KeyTag wk sub) subs | 1305 | (xs,ys) = seek_key (KeyTag wk sub) subs |
1298 | when (not (null ys)) $ do | 1306 | when (not (null ys)) $ do |
1299 | let (xs',ys') = seek_key (KeyTag wk sub) (tail ys) | 1307 | let (xs',ys') = seek_key (KeyTag wk sub) (tail ys) |
@@ -1565,6 +1573,7 @@ seek_key (KeyGrip grip) sec = (pre, subs) | |||
1565 | where | 1573 | where |
1566 | (pre,subs) = break pred sec | 1574 | (pre,subs) = break pred sec |
1567 | pred p@(SecretKeyPacket {}) = matchpr grip p == grip | 1575 | pred p@(SecretKeyPacket {}) = matchpr grip p == grip |
1576 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip | ||
1568 | pred _ = False | 1577 | pred _ = False |
1569 | 1578 | ||
1570 | seek_key (KeyTag key tag) ps = if null bs | 1579 | seek_key (KeyTag key tag) ps = if null bs |