diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 21 |
1 files changed, 19 insertions, 2 deletions
@@ -799,6 +799,7 @@ getPassphrase cmd = | |||
799 | data KeySpec = | 799 | data KeySpec = |
800 | KeyGrip String | 800 | KeyGrip String |
801 | | KeyTag Packet String | 801 | | KeyTag Packet String |
802 | | KeyUidMatch String | ||
802 | 803 | ||
803 | 804 | ||
804 | is40digitHex xs = ys == xs && length ys==40 | 805 | is40digitHex xs = ys == xs && length ys==40 |
@@ -1301,10 +1302,12 @@ main = do | |||
1301 | _ | null top -> KeyGrip grip | 1302 | _ | null top -> KeyGrip grip |
1302 | _ | toptyp=="fp" || (null toptyp && is40digitHex top) | 1303 | _ | toptyp=="fp" || (null toptyp && is40digitHex top) |
1303 | -> {- trace "using top" $ -} KeyGrip top | 1304 | -> {- trace "using top" $ -} KeyGrip top |
1304 | _ | otherwise -> todo | 1305 | _ | toptyp=="u" -> KeyUidMatch top |
1306 | _ | otherwise -> KeyUidMatch top | ||
1305 | (pre, wksubs) = seek_key topspec allpkts | 1307 | (pre, wksubs) = seek_key topspec allpkts |
1306 | if null wksubs then error ("No match for "++spec) else do | 1308 | if null wksubs then error ("No match for "++spec) else do |
1307 | let wk:subs = wksubs | 1309 | let wk:subs = wksubs |
1310 | (_,wksubs') = seek_key topspec subs -- ambiguity check | ||
1308 | (_,ys) = case subtyp of | 1311 | (_,ys) = case subtyp of |
1309 | "t" -> seek_key (KeyTag wk sub) subs | 1312 | "t" -> seek_key (KeyTag wk sub) subs |
1310 | "fp" | top=="" -> ([],wk:subs) | 1313 | "fp" | top=="" -> ([],wk:subs) |
@@ -1325,7 +1328,7 @@ main = do | |||
1325 | putStrLn $ show rsa | 1328 | putStrLn $ show rsa |
1326 | putStrLn $ show der | 1329 | putStrLn $ show der |
1327 | -} | 1330 | -} |
1328 | if null ys' | 1331 | if null ys' && null wksubs' |
1329 | then | 1332 | then |
1330 | putStr $ unlines (["-----BEGIN PUBLIC KEY-----"] | 1333 | putStr $ unlines (["-----BEGIN PUBLIC KEY-----"] |
1331 | ++split64 qq | 1334 | ++split64 qq |
@@ -1599,5 +1602,19 @@ seek_key (KeyTag key tag) ps = if null bs | |||
1599 | 1602 | ||
1600 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) | 1603 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) |
1601 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) | 1604 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) |
1605 | |||
1606 | seek_key (KeyUidMatch pat) ps = if null bs | ||
1607 | then (ps,[]) | ||
1608 | else if null qs | ||
1609 | then let (as',bs') = seek_key (KeyUidMatch pat) (tail bs) | ||
1610 | in (as ++ (head bs:as'), bs') | ||
1611 | else (reverse (tail qs), head qs : reverse rs ++ bs) | ||
1612 | where | ||
1613 | (as,bs) = break (isInfixOf pat . uidStr) | ||
1614 | ps | ||
1615 | (rs,qs) = break isKey (reverse as) | ||
1616 | |||
1617 | uidStr (UserIDPacket s) = s | ||
1618 | uidStr _ = "" | ||
1602 | 1619 | ||
1603 | groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps | 1620 | groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps |