summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs20
1 files changed, 17 insertions, 3 deletions
diff --git a/kiki.hs b/kiki.hs
index a50c237..d05424f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -49,6 +49,7 @@ import qualified CryptoCoins
49-- import Chroot 49-- import Chroot
50import ProcessUtils 50import ProcessUtils
51import qualified SSHKey as SSH 51import qualified SSHKey as SSH
52import Text.Printf
52 53
53-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} 54-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
54-- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} 55-- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
@@ -124,9 +125,15 @@ fpmatch grip key =
124 125
125listKeys pkts = listKeysFiltered [] pkts 126listKeys pkts = listKeysFiltered [] pkts
126 127
128-- | listKeysFiltered
129-- @grips fingerprints of keys to show
130-- @pkts list of pgp packets
131-- Build the display output
132-- Operates in List Monad...
133-- returns all output as a single string
127listKeysFiltered grips pkts = do 134listKeysFiltered grips pkts = do
128 -- FIXME: Will not show any output when there are no subkeys. 135 let masterkeys = filter (\k -> isKey k && not (is_subkey k)) pkts
129 let (certs,bs) = getBindings pkts 136 (certs,bs) = getBindings pkts
130 as = accBindings bs 137 as = accBindings bs
131 defaultkind (k:_) hs = k 138 defaultkind (k:_) hs = k
132 defaultkind [] hs = fromMaybe "subkey" 139 defaultkind [] hs = fromMaybe "subkey"
@@ -143,8 +150,14 @@ listKeysFiltered grips pkts = do
143 matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip fpmatch top . Just) grips = True 150 matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip fpmatch top . Just) grips = True
144 matchgrip _ = False 151 matchgrip _ = False
145 gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as) 152 gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as)
153 singles = filter (\k -> fingerprint k `notElem` map fingerprint parents) masterkeys -- \\ parents
154 where parents = do
155 subs@((_,(top,_),_,_,_):_) <- gs
156 return top
146 showsigs claimants = map (\k -> " " ++ "^ signed: " ++ fingerprint k) claimants 157 showsigs claimants = map (\k -> " " ++ "^ signed: " ++ fingerprint k) claimants
147 subs@((_,(top,_),_,_,_):_) <- gs 158 subs0 <- map Left gs ++ map Right singles
159 let (top,subs) = case subs0 of Left subs1@((_,(top0,_),_,_,_):_) -> (top0,subs1)
160 Right top0 -> (top0,[])
148 let subkeys = do 161 let subkeys = do
149 (code,(top,sub), kind, hashed,claimants) <- subs 162 (code,(top,sub), kind, hashed,claimants) <- subs
150 let ar = case code of 163 let ar = case code of
@@ -244,6 +257,7 @@ partitionStaticArguments specs args = psa args
244 Just n -> first ((a:take n as):) $ psa (drop n as) 257 Just n -> first ((a:take n as):) $ psa (drop n as)
245 258
246show_wk secring_file grip db = do 259show_wk secring_file grip db = do
260 -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db)
247 let sec_db = Map.filter gripmatch db 261 let sec_db = Map.filter gripmatch db
248 gripmatch (KeyData p _ _ _) = 262 gripmatch (KeyData p _ _ _) =
249 Map.member secring_file (locations p) 263 Map.member secring_file (locations p)