summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-01 00:08:37 -0400
committerjoe <joe@jerkface.net>2014-05-01 00:08:37 -0400
commit3647b358ef1fe6c8bf5f88b4cfb89a3c1c5e9598 (patch)
tree01fd6acda6b976b929d8953391650c5d000cc11d
parent62f97e5be12c1526324c6e6342d054a8d0d32d58 (diff)
factored mergeKeyPacket out of merge routine.
-rw-r--r--KeyRing.hs49
1 files changed, 22 insertions, 27 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index c8a5bf9..a65ebc4 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -167,6 +167,7 @@ data InputFile = HomeSec
167 | ArgFile FilePath 167 | ArgFile FilePath
168 | FileDesc Posix.Fd 168 | FileDesc Posix.Fd
169 | Pipe Posix.Fd Posix.Fd 169 | Pipe Posix.Fd Posix.Fd
170 -- ^ Note: Don't use Pipe for wallet files. (TODO)
170 deriving (Eq,Ord) 171 deriving (Eq,Ord)
171 172
172-- type UsageTag = String 173-- type UsageTag = String
@@ -2358,21 +2359,29 @@ onionName kd = (addr,name)
2358 where 2359 where
2359 (addr,(name:_,_)) = getHostnames kd 2360 (addr,(name:_,_)) = getHostnames kd
2360-} 2361-}
2362keyCompare :: String -> Packet -> Packet -> Ordering
2363keyCompare what (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
2364keyCompare what (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
2365keyCompare what a b | keykey a==keykey b = EQ
2366keyCompare what a b = error $ unlines ["Unable to merge "++what++":"
2367 , fingerprint a
2368 , PP.ppShow a
2369 , fingerprint b
2370 , PP.ppShow b
2371 ]
2372
2373mergeKeyPacket :: String -> MappedPacket -> MappedPacket -> MappedPacket
2374mergeKeyPacket what key p =
2375 key { packet = minimumBy (keyCompare what) [packet key,packet p]
2376 , locations = Map.union (locations key) (locations p)
2377 , usage_tag = usage_tag key `mplus` usage_tag p
2378 }
2379
2361 2380
2362merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))] 2381merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
2363 -> KeyDB 2382 -> KeyDB
2364merge_ db filename qs = foldl mergeit db (zip [0..] qs) 2383merge_ db filename qs = foldl mergeit db (zip [0..] qs)
2365 where 2384 where
2366 keycomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
2367 keycomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
2368 keycomp a b | keykey a==keykey b = EQ
2369 keycomp a b = error $ unlines ["Unable to merge keys:"
2370 , fingerprint a
2371 , PP.ppShow a
2372 , fingerprint b
2373 , PP.ppShow b
2374 ]
2375
2376 asMapped n p = let m = mappedPacket filename p 2385 asMapped n p = let m = mappedPacket filename p
2377 in m { locations = fmap (\x->x {originalNum=n}) (locations m) } 2386 in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
2378 asSigAndTrust n (p,tm) = (asMapped n p,tm) 2387 asSigAndTrust n (p,tm) = (asMapped n p,tm)
@@ -2389,12 +2398,12 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
2389 -- This is due to the use of statements like 2398 -- This is due to the use of statements like
2390 -- (Map.insert filename (origin p n) (locations key)) 2399 -- (Map.insert filename (origin p n) (locations key))
2391 -- 2400 --
2401 update :: Maybe KeyData -> Maybe KeyData
2392 update v | isKey p && not (is_subkey p) 2402 update v | isKey p && not (is_subkey p)
2393 = case v of 2403 = case v of
2394 Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty 2404 Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty
2395 Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p 2405 Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p
2396 -> Just $ KeyData ( (asMapped n (minimumBy keycomp [packet key,p])) 2406 -> Just $ KeyData (mergeKeyPacket "master keys" key $ asMapped n p)
2397 { locations = Map.insert filename (origin p n) (locations key) } )
2398 sigs 2407 sigs
2399 uids 2408 uids
2400 subkeys 2409 subkeys
@@ -2424,22 +2433,8 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
2424 mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey 2433 mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey
2425 mergeSubkey n p Nothing = Just $ SubKey (asMapped n p) [] 2434 mergeSubkey n p Nothing = Just $ SubKey (asMapped n p) []
2426 mergeSubkey n p (Just (SubKey key sigs)) = Just $ 2435 mergeSubkey n p (Just (SubKey key sigs)) = Just $
2427 SubKey ((asMapped n (minimumBy subcomp [packet key,p])) 2436 SubKey (mergeKeyPacket "subs" key $ asMapped n p)
2428 { locations = Map.insert filename (origin p n) (locations key) })
2429 sigs 2437 sigs
2430 where
2431 -- Compare master keys, LT is prefered for merging
2432 -- Compare subkeys, LT is prefered for merging
2433 subcomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
2434 subcomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
2435 subcomp a b | keykey a==keykey b = EQ
2436 subcomp a b = error $ unlines ["Unable to merge subs:"
2437 , fingerprint a
2438 , PP.ppShow a
2439 , fingerprint b
2440 , PP.ppShow b
2441 ]
2442 -- subcomp_m a b = subcomp (packet a) (packet b)
2443 2438
2444 mergeUid :: Int ->(Packet,a) -> Maybe ([SigAndTrust],OriginMap) -> Maybe ([SigAndTrust],OriginMap) 2439 mergeUid :: Int ->(Packet,a) -> Maybe ([SigAndTrust],OriginMap) -> Maybe ([SigAndTrust],OriginMap)
2445 mergeUid n (UserIDPacket s,_) Nothing = Just ([],Map.singleton filename (origin MarkerPacket n)) 2440 mergeUid n (UserIDPacket s,_) Nothing = Just ([],Map.singleton filename (origin MarkerPacket n))