summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2013-11-09 20:37:42 -0500
committerjoe <joe@jerkface.net>2013-11-09 20:37:42 -0500
commit6f780117751873f519df8a38b9ee8d1220f390c4 (patch)
tree2cc54fc7d489a83acd1873dbaa87658a0743ea65 /kiki.hs
parentaceaab7b2f98188b269edf3ebd5223fbf7cdc2e9 (diff)
Ability to specify top key by substring of user id.
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs21
1 files changed, 19 insertions, 2 deletions
diff --git a/kiki.hs b/kiki.hs
index ccb2510..990e8e3 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -799,6 +799,7 @@ getPassphrase cmd =
799data KeySpec = 799data KeySpec =
800 KeyGrip String 800 KeyGrip String
801 | KeyTag Packet String 801 | KeyTag Packet String
802 | KeyUidMatch String
802 803
803 804
804is40digitHex xs = ys == xs && length ys==40 805is40digitHex 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
1606seek_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
1603groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps 1620groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps