summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.hs2
-rw-r--r--lib/KeyDB.hs11
-rw-r--r--lib/KeyRing.hs2
-rw-r--r--lib/KeyRing/BuildKeyDB.hs14
-rw-r--r--lib/Transforms.hs16
5 files changed, 23 insertions, 22 deletions
diff --git a/kiki.hs b/kiki.hs
index b3cc880..7d825d3 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -259,7 +259,7 @@ show_whose_key input_key db =
259 case ks of 259 case ks of
260 [KeyData k _ uids _] -> do 260 [KeyData k _ uids _] -> do
261 putStrLn $ fingerprint (packet k) 261 putStrLn $ fingerprint (packet k)
262 mapM_ putStrLn $ Map.keys uids 262 mapM_ putStrLn $ unUidString <$> Map.keys uids
263 (_:_) -> error "ambiguous" 263 (_:_) -> error "ambiguous"
264 [] -> return () 264 [] -> return ()
265 265
diff --git a/lib/KeyDB.hs b/lib/KeyDB.hs
index 1f0849c..1aef747 100644
--- a/lib/KeyDB.hs
+++ b/lib/KeyDB.hs
@@ -21,6 +21,7 @@ module KeyDB
21 , sortByHint 21 , sortByHint
22 , flattenKeys 22 , flattenKeys
23 , flattenFiltered 23 , flattenFiltered
24 , UidString(..)
24 ) where 25 ) where
25 26
26import Control.Monad 27import Control.Monad
@@ -38,12 +39,14 @@ type SigAndTrust = ( MappedPacket
38 , TrustMap ) -- trust packets 39 , TrustMap ) -- trust packets
39data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show 40data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show
40 41
42data UidString = UidString { unUidString :: String } deriving (Show, Eq, Ord)
43
41-- | This is a GPG Identity which includes a master key and all its UIDs and 44-- | This is a GPG Identity which includes a master key and all its UIDs and
42-- subkeys and associated signatures. 45-- subkeys and associated signatures.
43data KeyData = KeyData 46data KeyData = KeyData
44 { keyMappedPacket :: MappedPacket -- main key 47 { keyMappedPacket :: MappedPacket -- main key
45 , keySigAndTrusts :: [SigAndTrust] -- sigs on main key 48 , keySigAndTrusts :: [SigAndTrust] -- sigs on main key
46 , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids 49 , keyUids :: (Map.Map UidString ([SigAndTrust],OriginMap)) -- uids
47 , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys 50 , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys
48 } deriving Show 51 } deriving Show
49 52
@@ -118,14 +121,14 @@ flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPubl
118 _)) = True 121 _)) = True
119 isSecret _ = False 122 isSecret _ = False
120 123
121flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedPacket] 124flattenUid :: FilePath -> Bool -> (UidString,([SigAndTrust],OriginMap)) -> [MappedPacket]
122flattenUid fname ispub (str,(sigs,om)) = 125flattenUid fname ispub (UidString str,(sigs,om)) =
123 (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs 126 (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
124 127
125flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket] 128flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
126flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs 129flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
127 130
128flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket] 131flattenAllUids :: FilePath -> Bool -> Map.Map UidString ([SigAndTrust],OriginMap) -> [MappedPacket]
129flattenAllUids fname ispub uids = 132flattenAllUids fname ispub uids =
130 concatSort fname head (flattenUid fname ispub) (Map.assocs uids) 133 concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
131 134
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index b946e54..70edb9e 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -667,7 +667,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
667 where wk = workingKey (rtGrip rt) (rtKeyDB rt) 667 where wk = workingKey (rtGrip rt) (rtKeyDB rt)
668 dont_have (KeyData p _ _ _) = not . Map.member (rtPubring rt) 668 dont_have (KeyData p _ _ _) = not . Map.member (rtPubring rt)
669 $ locations p 669 $ locations p
670 has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ Map.toList uids 670 has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ first unUidString <$> Map.toList uids
671 where 671 where
672 goodsig (uidstr,(sigs,_)) = not . null $ do 672 goodsig (uidstr,(sigs,_)) = not . null $ do
673 sig0 <- fmap (packet . fst) sigs 673 sig0 <- fmap (packet . fst) sigs
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index cd1bae9..0eddc51 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -30,7 +30,6 @@ import qualified Data.ByteString.Lazy as L (ByteString, concat, empty,
30 null, toChunks, 30 null, toChunks,
31 toStrict, head) 31 toStrict, head)
32import Data.Char 32import Data.Char
33import Data.Functor
34import Data.List 33import Data.List
35import qualified Data.Map as Map 34import qualified Data.Map as Map
36import Data.Maybe 35import Data.Maybe
@@ -55,7 +54,6 @@ import qualified System.Posix.Types as Posix
55import Data.Hourglass 54import Data.Hourglass
56import Foreign.C.Types (CTime (..)) 55import Foreign.C.Types (CTime (..))
57import Data.Traversable (sequenceA) 56import Data.Traversable (sequenceA)
58import qualified Data.Traversable as Traversable
59import System.IO (openFile, IOMode(ReadMode)) 57import System.IO (openFile, IOMode(ReadMode))
60 58
61import System.Posix.IO (fdToHandle) 59import System.Posix.IO (fdToHandle)
@@ -678,7 +676,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
678 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do 676 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do
679 let has_torid = do 677 let has_torid = do
680 -- TODO: check for omitted real name field 678 -- TODO: check for omitted real name field
681 (sigtrusts,om) <- Map.lookup idstr uids 679 (sigtrusts,om) <- Map.lookup (UidString idstr) uids
682 listToMaybe $ do 680 listToMaybe $ do
683 s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts)) 681 s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts))
684 signatures_over $ verify (Message [packet top]) s 682 signatures_over $ verify (Message [packet top]) s
@@ -700,7 +698,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
700 let om = Map.singleton fname (origin sig (-1)) 698 let om = Map.singleton fname (origin sig (-1))
701 trust = Map.empty 699 trust = Map.empty
702 return $ KikiSuccess 700 return $ KikiSuccess
703 ( Map.insert idstr ([( (mappedPacket fname sig) {locations=om} 701 ( Map.insert (UidString idstr) ([( (mappedPacket fname sig) {locations=om}
704 , trust)],om) uids 702 , trust)],om) uids
705 , [] ) 703 , [] )
706 704
@@ -801,7 +799,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
801 799
802matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us 800matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us
803 where 801 where
804 us = filter (isInfixOf pat) $ Map.keys uids 802 us = filter (isInfixOf pat) $ unUidString <$> Map.keys uids
805 803
806doImport 804doImport
807 :: PacketTranscoder 805 :: PacketTranscoder
@@ -946,7 +944,7 @@ setHostnames (IPsToWriteToHostsFile outgoing_names) hosts kd@(KeyData topmp tops
946 isName (NotationDataPacket True "hostname@" _) = True 944 isName (NotationDataPacket True "hostname@" _) = True
947 isName _ = False 945 isName _ = False
948 uids0 = fmap zapIfHasName uids 946 uids0 = fmap zapIfHasName uids
949 fstuid = head $ do 947 fstuid = UidString $ head $ do
950 p <- map packet $ flattenAllUids "" True uids 948 p <- map packet $ flattenAllUids "" True uids
951 maybeToList $ isUserID p 949 maybeToList $ isUserID p
952 uids1 = Map.adjust addnames fstuid uids0 950 uids1 = Map.adjust addnames fstuid uids0
@@ -1069,14 +1067,14 @@ dbInsertPacket kd filename (n,(top,sub,ptt@(p,trustmap))) = update (Just kd)
1069 update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p 1067 update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
1070 = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys) 1068 = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys)
1071 update (Just (KeyData key sigs uids subkeys)) | Just uid <- isUserID p 1069 update (Just (KeyData key sigs uids subkeys)) | Just uid <- isUserID p
1072 = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) uid uids) 1070 = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) (UidString uid) uids)
1073 subkeys 1071 subkeys
1074 update (Just (KeyData key sigs uids subkeys)) 1072 update (Just (KeyData key sigs uids subkeys))
1075 = case sub of 1073 = case sub of
1076 MarkerPacket -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys 1074 MarkerPacket -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys
1077 UserIDPacket uid-> Just $ KeyData key 1075 UserIDPacket uid-> Just $ KeyData key
1078 sigs 1076 sigs
1079 (Map.alter (mergeUidSig n ptt) uid uids) 1077 (Map.alter (mergeUidSig n ptt) (UidString uid) uids)
1080 subkeys 1078 subkeys
1081 _ | isKey sub -> Just $ KeyData key 1079 _ | isKey sub -> Just $ KeyData key
1082 sigs 1080 sigs
diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index edc18bb..7750ec5 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -664,7 +664,7 @@ performManipulations doDecrypt rt wk manip = do
664 , Packet ) -- key who signed 664 , Packet ) -- key who signed
665 ] 665 ]
666 vs = do 666 vs = do
667 x <- maybeToList $ Map.lookup uid (keyUids kd) 667 x <- maybeToList $ Map.lookup (UidString uid) (keyUids kd)
668 sig <- map (packet . fst) (fst x) 668 sig <- map (packet . fst) (fst x)
669 o <- overs sig 669 o <- overs sig
670 take 1 $ do -- Stop attempting to verify after the first success. 670 take 1 $ do -- Stop attempting to verify after the first success.
@@ -681,7 +681,7 @@ performManipulations doDecrypt rt wk manip = do
681 f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x 681 f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x
682 , om `Map.union` snd x ) 682 , om `Map.union` snd x )
683 -- XXX: Shouldn't this signature generation show up in the KikiReport ? 683 -- XXX: Shouldn't this signature generation show up in the KikiReport ?
684 return $ KikiSuccess $ ( kd { keyUids = Map.adjust f uid (keyUids kd) }, report ) 684 return $ KikiSuccess $ ( kd { keyUids = Map.adjust f (UidString uid) (keyUids kd) }, report )
685 685
686 perform (kd,report) (SubKeyDeletion topk subk) = do 686 perform (kd,report) (SubKeyDeletion topk subk) = do
687 let kk = keykey $ packet $ keyMappedPacket kd 687 let kk = keykey $ packet $ keyMappedPacket kd
@@ -755,13 +755,13 @@ parseUID str = UserIDRecord {
755resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate] 755resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
756resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops 756resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
757 where 757 where
758 ops = map (\u -> InducerSignature u []) us 758 ops = map (\(UidString u) -> InducerSignature u []) us
759 us = filter torStyle $ Map.keys umap 759 us = filter torStyle $ Map.keys umap
760 torStyle str = and [ uid_topdomain parsed == "onion" 760 torStyle (UidString str) = and [ uid_topdomain parsed == "onion"
761 , uid_realname parsed `elem` ["","Anonymous"] 761 , uid_realname parsed `elem` ["","Anonymous"]
762 , uid_user parsed == "root" 762 , uid_user parsed == "root"
763 , fmap (match . fst) (lookup (packet k) torbindings) 763 , fmap (match . fst) (lookup (packet k) torbindings)
764 == Just True ] 764 == Just True ]
765 where parsed = parseUID str 765 where parsed = parseUID str
766 match = (==subdom) . take (fromIntegral len) 766 match = (==subdom) . take (fromIntegral len)
767 subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] 767 subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]