diff options
author | joe <joe@jerkface.net> | 2014-05-02 14:31:17 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-05-02 14:31:17 -0400 |
commit | 970665ceb98b969b040e9f5400705846d54f77ad (patch) | |
tree | 354c328a26448f8ebcfa29298a295bdcdc26be31 /kiki.hs | |
parent | a1e0ac16e1ab889fd4a015a0c6914f331f034799 (diff) |
Implemented kTransforms
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 93 |
1 files changed, 0 insertions, 93 deletions
@@ -126,99 +126,6 @@ decode_sshrsa bs = do | |||
126 | isCertificationSig (CertificationSignature {}) = True | 126 | isCertificationSig (CertificationSignature {}) = True |
127 | isCertificationSig _ = True | 127 | isCertificationSig _ = True |
128 | 128 | ||
129 | isSubkeySignature (SubkeySignature {}) = True | ||
130 | isSubkeySignature _ = False | ||
131 | |||
132 | verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs) | ||
133 | where | ||
134 | verified = do | ||
135 | sig <- signatures (Message nonkeys) | ||
136 | let v = verify (Message keys) sig | ||
137 | guard (not . null $ signatures_over v) | ||
138 | return v | ||
139 | (top,othersigs) = partition isSubkeySignature verified | ||
140 | embedded = do | ||
141 | sub <- top | ||
142 | let sigover = signatures_over sub | ||
143 | unhashed = sigover >>= unhashed_subpackets | ||
144 | subsigs = mapMaybe backsig unhashed | ||
145 | -- This should consist only of 0x19 values | ||
146 | -- subtypes = map signature_type subsigs | ||
147 | -- trace ("subtypes = "++show subtypes) (return ()) | ||
148 | -- trace ("issuers: "++show (map signature_issuer subsigs)) (return ()) | ||
149 | sig <- signatures (Message ([topkey sub,subkey sub]++subsigs)) | ||
150 | let v = verify (Message [subkey sub]) sig | ||
151 | guard (not . null $ signatures_over v) | ||
152 | return v | ||
153 | |||
154 | smallpr k = drop 24 $ fingerprint k | ||
155 | |||
156 | |||
157 | disjoint_fp ks = {- concatMap group2 $ -} transpose grouped | ||
158 | where | ||
159 | grouped = groupBy samepr . sortBy (comparing smallpr) $ ks | ||
160 | samepr a b = smallpr a == smallpr b | ||
161 | |||
162 | {- | ||
163 | -- useful for testing | ||
164 | group2 :: [a] -> [[a]] | ||
165 | group2 (x:y:ys) = [x,y]:group2 ys | ||
166 | group2 [x] = [[x]] | ||
167 | group2 [] = [] | ||
168 | -} | ||
169 | |||
170 | |||
171 | getBindings :: | ||
172 | [Packet] | ||
173 | -> | ||
174 | ( [([Packet],[SignatureOver])] -- ^ other signatures with key sets | ||
175 | -- that were used for the verifications | ||
176 | , [(Word8, | ||
177 | (Packet, Packet), -- (topkey,subkey) | ||
178 | [String], -- usage flags | ||
179 | [SignatureSubpacket], -- hashed data | ||
180 | [Packet])] -- ^ binding signatures | ||
181 | ) | ||
182 | getBindings pkts = (sigs,bindings) | ||
183 | where | ||
184 | (sigs,concat->bindings) = unzip $ do | ||
185 | let (keys,_) = partition isKey pkts | ||
186 | keys <- disjoint_fp keys | ||
187 | let (bs,sigs) = verifyBindings keys pkts | ||
188 | return . ((keys,sigs),) $ do | ||
189 | b <- bs -- trace ("sigs = "++show (map (map signature_issuer . signatures_over) sigs)) bs | ||
190 | i <- map signature_issuer (signatures_over b) | ||
191 | i <- maybeToList i | ||
192 | who <- maybeToList $ find_key fingerprint (Message keys) i | ||
193 | let (code,claimants) = | ||
194 | case () of | ||
195 | _ | who == topkey b -> (1,[]) | ||
196 | _ | who == subkey b -> (2,[]) | ||
197 | _ -> (0,[who]) | ||
198 | let hashed = signatures_over b >>= hashed_subpackets | ||
199 | kind = guard (code==1) >> hashed >>= maybeToList . usage | ||
200 | return (code,(topkey b,subkey b), kind, hashed,claimants) | ||
201 | |||
202 | -- Returned data is simmilar to getBindings but the Word8 codes | ||
203 | -- are ORed together. | ||
204 | accBindings :: | ||
205 | Bits t => | ||
206 | [(t, (Packet, Packet), [a], [a1], [a2])] | ||
207 | -> [(t, (Packet, Packet), [a], [a1], [a2])] | ||
208 | accBindings bs = as | ||
209 | where | ||
210 | gs = groupBy samePair . sortBy (comparing bindingPair) $ bs | ||
211 | as = map (foldl1 combine) gs | ||
212 | bindingPair (_,p,_,_,_) = pub2 p | ||
213 | where | ||
214 | pub2 (a,b) = (pub a, pub b) | ||
215 | pub a = fingerprint_material a | ||
216 | samePair a b = bindingPair a == bindingPair b | ||
217 | combine (ac,p,akind,ahashed,aclaimaints) | ||
218 | (bc,_,bkind,bhashed,bclaimaints) | ||
219 | = (ac .|. bc,p,akind++bkind,ahashed++bhashed,aclaimaints++bclaimaints) | ||
220 | |||
221 | |||
222 | fpmatch grip key = | 129 | fpmatch grip key = |
223 | (==) Nothing | 130 | (==) Nothing |
224 | (fmap (backend (fingerprint key)) grip >>= guard . not) | 131 | (fmap (backend (fingerprint key)) grip >>= guard . not) |