diff options
-rw-r--r-- | kiki.hs | 20 |
1 files changed, 17 insertions, 3 deletions
@@ -49,6 +49,7 @@ import qualified CryptoCoins | |||
49 | -- import Chroot | 49 | -- import Chroot |
50 | import ProcessUtils | 50 | import ProcessUtils |
51 | import qualified SSHKey as SSH | 51 | import qualified SSHKey as SSH |
52 | import 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 | ||
125 | listKeys pkts = listKeysFiltered [] pkts | 126 | listKeys 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 | ||
127 | listKeysFiltered grips pkts = do | 134 | listKeysFiltered 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 | ||
246 | show_wk secring_file grip db = do | 259 | show_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) |