diff options
-rw-r--r-- | kiki.hs | 19 | ||||
-rw-r--r-- | lib/CommandLine.hs | 38 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 12 | ||||
-rw-r--r-- | lib/Kiki.hs | 69 | ||||
-rw-r--r-- | lib/Transforms.hs | 71 |
5 files changed, 146 insertions, 63 deletions
@@ -1647,6 +1647,20 @@ kiki "tar" args = do | |||
1647 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? | 1647 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? |
1648 | _ -> kiki "tar" ["--help"] | 1648 | _ -> kiki "tar" ["--help"] |
1649 | 1649 | ||
1650 | kiki "verify" args | "--help" `elem` args = do | ||
1651 | putStr . unlines $ | ||
1652 | [ "kiki verify [--homedir HOMEDIR | --homeless] [[--keyring FILE] ...] FILE" | ||
1653 | ] | ||
1654 | kiki "verify" argvals = | ||
1655 | let opts = [("--homedir",1),("--keyring",1),("--homeless",0)] | ||
1656 | in case runArgs (parseInvocation (fancy opts [] "") argvals) | ||
1657 | (verifyFile <$> flag "--homeless" | ||
1658 | <*> dashdashHomedir | ||
1659 | <*> args "--keyring" | ||
1660 | <*> param 0) of | ||
1661 | Left er -> hPutStrLn stderr $ usageErrorMessage er | ||
1662 | Right io -> io | ||
1663 | |||
1650 | kiki cmd args = hPutStrLn stderr $ "I don't know how to "++cmd++"." | 1664 | kiki cmd args = hPutStrLn stderr $ "I don't know how to "++cmd++"." |
1651 | 1665 | ||
1652 | sshkeyname :: Packet -> [FilePath] | 1666 | sshkeyname :: Packet -> [FilePath] |
@@ -1709,7 +1723,7 @@ ipsecKeyNames (Hostnames _ onames _ _) = do | |||
1709 | 1723 | ||
1710 | tarT :: ([[String]],Map.Map String [String]) -> IO () | 1724 | tarT :: ([[String]],Map.Map String [String]) -> IO () |
1711 | tarT (sargs,margs) = do | 1725 | tarT (sargs,margs) = do |
1712 | KikiResult rt report <- runKeyRing $ minimalOp $ parseCommonArgs margs | 1726 | KikiResult rt report <- runKeyRing $ minimalOp False $ parseCommonArgs margs |
1713 | case rt of | 1727 | case rt of |
1714 | KikiSuccess rt -> do | 1728 | KikiSuccess rt -> do |
1715 | let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs | 1729 | let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs |
@@ -1720,7 +1734,7 @@ tarT (sargs,margs) = do | |||
1720 | 1734 | ||
1721 | tarC :: ([[String]],Map.Map String [String]) -> IO () | 1735 | tarC :: ([[String]],Map.Map String [String]) -> IO () |
1722 | tarC (sargs,margs) = do | 1736 | tarC (sargs,margs) = do |
1723 | KikiResult rt report <- runKeyRing $ minimalOp $ parseCommonArgs margs | 1737 | KikiResult rt report <- runKeyRing $ minimalOp False $ parseCommonArgs margs |
1724 | case rt of | 1738 | case rt of |
1725 | KikiSuccess rt -> do | 1739 | KikiSuccess rt -> do |
1726 | CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt) | 1740 | CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt) |
@@ -1813,6 +1827,7 @@ commands = | |||
1813 | , ( "rename", "Change the usage tag on a specified subkey" ) | 1827 | , ( "rename", "Change the usage tag on a specified subkey" ) |
1814 | -- also repairs signature and adds missing cross-certification. | 1828 | -- also repairs signature and adds missing cross-certification. |
1815 | , ( "tar", "import or export system key files in tar format" ) | 1829 | , ( "tar", "import or export system key files in tar format" ) |
1830 | , ( "verify", "Check a clear-sign pgp signature." ) | ||
1816 | ] | 1831 | ] |
1817 | 1832 | ||
1818 | main :: IO () | 1833 | main :: IO () |
diff --git a/lib/CommandLine.hs b/lib/CommandLine.hs index ea5d6b8..2676260 100644 --- a/lib/CommandLine.hs +++ b/lib/CommandLine.hs | |||
@@ -14,6 +14,8 @@ module CommandLine | |||
14 | , fancy | 14 | , fancy |
15 | , runArgs | 15 | , runArgs |
16 | , arg | 16 | , arg |
17 | , args | ||
18 | , flag | ||
17 | , param | 19 | , param |
18 | , params | 20 | , params |
19 | , label | 21 | , label |
@@ -50,11 +52,11 @@ type MergeData = [(Int,Ordering)] | |||
50 | data Expr a where | 52 | data Expr a where |
51 | -- Prim | 53 | -- Prim |
52 | -- | 54 | -- |
53 | -- Takes a function from the option arguments and unamed arguments repsectively to | 55 | -- Takes a function from the option arguments and unnamed arguments |
54 | -- a value of type a, usually IO (), and gives you an expression tree. As one | 56 | -- respectively to a value of type a, usually IO (), and gives you an |
55 | -- traverses down the tree only the 'interesting' option arguments are passed | 57 | -- expression tree. As one traverses down the tree only the 'interesting' |
56 | -- to this function, but all of the unnamed arguments are passed regardless of | 58 | -- option arguments are passed to this function, but all of the unnamed |
57 | -- where we are in the tree. | 59 | -- arguments are passed regardless of where we are in the tree. |
58 | -- | 60 | -- |
59 | Prim :: ([[String]] -> [String] -> a) -> Interval (SuperOrd Int) -> Expr a | 61 | Prim :: ([[String]] -> [String] -> a) -> Interval (SuperOrd Int) -> Expr a |
60 | -- Star | 62 | -- Star |
@@ -233,17 +235,31 @@ mergeBy comp xs ys = trace (unlines ["xs="++show xs,"ys="++show ys,"mergeData="+ | |||
233 | -} | 235 | -} |
234 | 236 | ||
235 | 237 | ||
238 | -- | The nth unnamed argument. | ||
236 | param :: Int -> Args String | 239 | param :: Int -> Args String |
237 | param n = Args (Prim (\_ us -> us!!n) (singleton $ exactly (n+1))) [] | 240 | param n = Args (Prim (\_ us -> us!!n) (singleton $ exactly (n+1))) [] |
238 | 241 | ||
242 | -- | All unnamed arguments as a list. | ||
243 | params :: Args [String] | ||
244 | params = Args (Prim (\_ args -> args) (exactly 0 ... PositiveInfinity)) [] | ||
245 | |||
246 | |||
247 | -- | The value of named by the given option name. | ||
239 | arg :: String -> Args String | 248 | arg :: String -> Args String |
240 | arg optname = Args (Prim (\opts _ -> concat $ take 1 $ concat $ take 1 opts) | 249 | arg optname = Args (Prim (\opts _ -> concat $ take 1 $ concat $ take 1 opts) |
241 | (singleton $ exactly 0)) | 250 | (singleton $ exactly 0)) |
242 | [optname] | 251 | [optname] |
243 | 252 | ||
244 | params :: Args [String] | 253 | -- | All values named by the given option name. |
245 | params = Args (Prim (\_ args -> args) (exactly 0 ... PositiveInfinity)) [] | 254 | args :: String -> Args [String] |
255 | args optname = fromMaybe [] <$> optional | ||
256 | (Args (Prim (\opts _ -> concat $ take 1 opts) | ||
257 | (singleton $ exactly 0)) -- no unnamed arguments | ||
258 | [optname]) -- one named argument | ||
246 | 259 | ||
260 | -- | True if the given named option is present. | ||
261 | flag :: String -> Args Bool | ||
262 | flag optname = maybe False (const True) <$> optional (arg optname) | ||
247 | 263 | ||
248 | label :: String -> Args a -> Args a | 264 | label :: String -> Args a -> Args a |
249 | label _ = id | 265 | label _ = id |
@@ -286,7 +302,7 @@ vanilla flags = ArgsStyle { parseInvocation = parse flags } | |||
286 | -- | 302 | -- |
287 | -- * default polyvariadic - Implicit polyvariadic option if no other option is specified. | 303 | -- * default polyvariadic - Implicit polyvariadic option if no other option is specified. |
288 | -- | 304 | -- |
289 | fancy :: [([Char], Int)] -> [[Char]] -> [Char] -> ArgsStyle | 305 | fancy :: [(String, Int)] -> [String] -> String -> ArgsStyle |
290 | fancy sargspsec polyVariadicArgs defaultPoly = ArgsStyle | 306 | fancy sargspsec polyVariadicArgs defaultPoly = ArgsStyle |
291 | { parseInvocation = parse sargspsec polyVariadicArgs defaultPoly } | 307 | { parseInvocation = parse sargspsec polyVariadicArgs defaultPoly } |
292 | where | 308 | where |
@@ -470,8 +486,8 @@ runArgs (os,us) c | |||
470 | where | 486 | where |
471 | os' = sortOn fst os | 487 | os' = sortOn fst os |
472 | dups = mapMaybe notSingle $ groupBy ((==) `on` fst) (os' :: [(String,[String])]) | 488 | dups = mapMaybe notSingle $ groupBy ((==) `on` fst) (os' :: [(String,[String])]) |
473 | where notSingle [x] = Nothing | 489 | where notSingle [x] = Nothing |
474 | notSingle ((k,v):xs) = Just (k,v : map snd xs) | 490 | notSingle ((k,v):xs) = Just (k,v : map snd xs) |
475 | getbit = Map.fromList $ zip (accepts c) [0..] | 491 | getbit = Map.fromList $ zip (accepts c) [0..] |
476 | goods :: [(Int,[String])] | 492 | goods :: [(Int,[String])] |
477 | (bads,goods) = partitionEithers $ map f os' | 493 | (bads,goods) = partitionEithers $ map f os' |
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index afee71a..a3df62d 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs | |||
@@ -186,12 +186,12 @@ buildKeyDB ctx grip0 keyring = do | |||
186 | let doDecrypt = transcode (Unencrypted,S2K 100 "") | 186 | let doDecrypt = transcode (Unencrypted,S2K 100 "") |
187 | 187 | ||
188 | let wk = fmap packet mwk | 188 | let wk = fmap packet mwk |
189 | rt0 = KeyRingRuntime { rtPubring = homepubPath ctx | 189 | rt0 = KeyRingRuntime { rtPubring = homepubPath ctx |
190 | , rtSecring = homesecPath ctx | 190 | , rtSecring = homesecPath ctx |
191 | , rtGrip = grip | 191 | , rtGrip = grip |
192 | , rtWorkingKey = wk | 192 | , rtWorkingKey = wk |
193 | , rtRingAccess = accs | 193 | , rtRingAccess = accs |
194 | , rtKeyDB = Map.empty | 194 | , rtKeyDB = Map.empty |
195 | , rtPassphrases = transcode | 195 | , rtPassphrases = transcode |
196 | } | 196 | } |
197 | -- autosigns and deletes | 197 | -- autosigns and deletes |
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index d6a8b3a..20ab1f2 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -6,6 +6,8 @@ module Kiki | |||
6 | , setVerifyFlag | 6 | , setVerifyFlag |
7 | ) where | 7 | ) where |
8 | 8 | ||
9 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor | ||
10 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | ||
9 | import Control.Applicative | 11 | import Control.Applicative |
10 | import Control.Exception | 12 | import Control.Exception |
11 | import Control.Monad | 13 | import Control.Monad |
@@ -95,7 +97,7 @@ ciphers = takeWhile notFallback $ map toEnum $ [0..4]++[7..] | |||
95 | refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () | 97 | refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () |
96 | refresh root homepass = do | 98 | refresh root homepass = do |
97 | let homepass' = homepass { cap_homespec = fmap root (cap_homespec homepass) } | 99 | let homepass' = homepass { cap_homespec = fmap root (cap_homespec homepass) } |
98 | KikiResult r report <- runKeyRing $ minimalOp homepass' | 100 | KikiResult r report <- runKeyRing $ minimalOp False homepass' |
99 | let mroot = case root "" of | 101 | let mroot = case root "" of |
100 | "/" -> Nothing | 102 | "/" -> Nothing |
101 | "" -> Nothing | 103 | "" -> Nothing |
@@ -116,8 +118,8 @@ streaminfo = StreamInfo | |||
116 | , transforms = [] | 118 | , transforms = [] |
117 | } | 119 | } |
118 | 120 | ||
119 | minimalOp :: CommonArgsParsed -> KeyRingOperation | 121 | minimalOp :: Bool -> CommonArgsParsed -> KeyRingOperation |
120 | minimalOp cap = op | 122 | minimalOp isHomeless cap = op |
121 | where | 123 | where |
122 | streaminfo = StreamInfo { fill = KF_None | 124 | streaminfo = StreamInfo { fill = KF_None |
123 | , typ = KeyRingFile | 125 | , typ = KeyRingFile |
@@ -127,10 +129,12 @@ minimalOp cap = op | |||
127 | , transforms = [] | 129 | , transforms = [] |
128 | } | 130 | } |
129 | op = KeyRingOperation | 131 | op = KeyRingOperation |
130 | { opFiles = Map.fromList $ | 132 | { opFiles = if isHomeless |
131 | [ ( HomeSec, streaminfo { access = Sec }) | 133 | then Map.empty |
132 | , ( HomePub, streaminfo { access = Pub }) | 134 | else Map.fromList $ |
133 | ] | 135 | [ ( HomeSec, streaminfo { access = Sec }) |
136 | , ( HomePub, streaminfo { access = Pub }) | ||
137 | ] | ||
134 | , opPassphrases = withAgent $ do pfile <- maybeToList (cap_passfd cap) | 138 | , opPassphrases = withAgent $ do pfile <- maybeToList (cap_passfd cap) |
135 | return $ PassphraseSpec Nothing Nothing pfile | 139 | return $ PassphraseSpec Nothing Nothing pfile |
136 | , opTransforms = [] | 140 | , opTransforms = [] |
@@ -501,7 +505,10 @@ refreshCache rt rootdir = do | |||
501 | flip (maybe $ warn "missing working key?") (rtWorkingKey rt) $ \wk -> do | 505 | flip (maybe $ warn "missing working key?") (rtWorkingKey rt) $ \wk -> do |
502 | 506 | ||
503 | let grip = fingerprint wk | 507 | let grip = fingerprint wk |
504 | exportOp = passphrases <> pemSecrets <> minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) Nothing) | 508 | exportOp = passphrases <> pemSecrets |
509 | <> minimalOp False | ||
510 | (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) | ||
511 | Nothing) | ||
505 | where | 512 | where |
506 | passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } | 513 | passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } |
507 | pemSecrets = mempty { opFiles = Map.fromList | 514 | pemSecrets = mempty { opFiles = Map.fromList |
@@ -663,7 +670,7 @@ replaceSshServerKeys root cmn = do | |||
663 | strm = streaminfo { typ = PEMFile, spill = KF_Match "ssh-server", access = Sec } | 670 | strm = streaminfo { typ = PEMFile, spill = KF_Match "ssh-server", access = Sec } |
664 | delssh strm = strm { transforms = DeleteSubkeyByUsage "ssh-server" : transforms strm | 671 | delssh strm = strm { transforms = DeleteSubkeyByUsage "ssh-server" : transforms strm |
665 | , fill = KF_All } | 672 | , fill = KF_All } |
666 | KikiResult r report <- runKeyRing $ minimalOp homepass' | 673 | KikiResult r report <- runKeyRing $ minimalOp False homepass' |
667 | case r of | 674 | case r of |
668 | KikiSuccess rt -> Kiki.refreshCache rt $ case root "" of | 675 | KikiSuccess rt -> Kiki.refreshCache rt $ case root "" of |
669 | "/" -> Nothing | 676 | "/" -> Nothing |
@@ -694,3 +701,47 @@ kikiOptions = ( ss, ps ) | |||
694 | where | 701 | where |
695 | ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1),("--cipher",1)] | 702 | ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1),("--cipher",1)] |
696 | ps = [] | 703 | ps = [] |
704 | |||
705 | verifyFile :: Bool -> CommonArgsParsed -> [FilePath] -> FilePath -> IO () | ||
706 | verifyFile isHomeless cap keyrings filename = do | ||
707 | let mop = minimalOp isHomeless cap | ||
708 | KikiResult r report <- runKeyRing mop | ||
709 | { opFiles = opFiles mop | ||
710 | `Map.union` Map.fromList | ||
711 | [ (ArgFile f, strm { access = Pub }) | f <- keyrings ] | ||
712 | } | ||
713 | case r of | ||
714 | KikiSuccess rt -> go rt | ||
715 | err -> hPutStrLn stderr $ errorString err | ||
716 | where | ||
717 | go :: KeyRingRuntime -> IO () | ||
718 | go rt = do | ||
719 | bs <- L.readFile filename | ||
720 | case ASCIIArmor.decodeLazy bs of | ||
721 | Right (ClearSigned hashes txt (Armor ArmorSignature _ sig):_) -> | ||
722 | case parsePackets sig of | ||
723 | Right sigs -> do | ||
724 | let over = DataSignature lit sigs | ||
725 | lit = LiteralDataPacket | ||
726 | { format = error "format" :: Char | ||
727 | , filename = filename | ||
728 | , timestamp = error "timestamp" :: Word32 | ||
729 | , content = bs | ||
730 | } | ||
731 | -- TODO: Remove this take 1 after optimizing 'candidateSignerKeys' | ||
732 | tentativeTake1 xs = take 1 xs | ||
733 | keys = concatMap (candidateSignerKeys (rtKeyDB rt)) $ tentativeTake1 sigs | ||
734 | good = verify (Message keys) over | ||
735 | putStrLn $ "verifyFile: " ++ show (length $ signatures_over good) | ||
736 | rs -> do | ||
737 | hPutStrLn stderr $ show rs | ||
738 | _ -> do | ||
739 | hPutStrLn stderr "Unsupported file format." | ||
740 | |||
741 | |||
742 | parsePackets :: L.ByteString -> Either String [Packet] | ||
743 | parsePackets bs = case decodeOrFail bs of | ||
744 | Left (more,off,er) -> Left er | ||
745 | Right (more,off,pkt) -> do | ||
746 | if (more/=L.empty) then parsePackets more >>= \pkts -> Right (pkt : pkts) | ||
747 | else Right [pkt] | ||
diff --git a/lib/Transforms.hs b/lib/Transforms.hs index adb7830..8eaa482 100644 --- a/lib/Transforms.hs +++ b/lib/Transforms.hs | |||
@@ -56,37 +56,34 @@ data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show | |||
56 | 56 | ||
57 | -- | This is a GPG Identity which includes a master key and all its UIDs and | 57 | -- | This is a GPG Identity which includes a master key and all its UIDs and |
58 | -- subkeys and associated signatures. | 58 | -- subkeys and associated signatures. |
59 | data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key | 59 | data KeyData = KeyData |
60 | , keySigAndTrusts :: [SigAndTrust] -- sigs on main key | 60 | { keyMappedPacket :: MappedPacket -- main key |
61 | , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids | 61 | , keySigAndTrusts :: [SigAndTrust] -- sigs on main key |
62 | , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys | 62 | , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids |
63 | } deriving Show | 63 | , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys |
64 | } deriving Show | ||
64 | type KeyDB = Map.Map KeyKey KeyData | 65 | type KeyDB = Map.Map KeyKey KeyData |
65 | 66 | ||
66 | 67 | ||
67 | 68 | ||
68 | data KeyRingRuntime = KeyRingRuntime | 69 | data KeyRingRuntime = KeyRingRuntime |
69 | { rtPubring :: FilePath | 70 | { rtPubring :: FilePath -- ^ Path to the file represented by 'HomePub' |
70 | -- ^ Path to the file represented by 'HomePub' | 71 | , rtSecring :: FilePath -- ^ Path to the file represented by 'HomeSec' |
71 | , rtSecring :: FilePath | 72 | , rtGrip :: Maybe String |
72 | -- ^ Path to the file represented by 'HomeSec' | 73 | -- ^ Fingerprint or portion of a fingerprint used |
73 | , rtGrip :: Maybe String | 74 | -- to identify the working GnuPG identity used to |
74 | -- ^ Fingerprint or portion of a fingerprint used | 75 | -- make signatures. |
75 | -- to identify the working GnuPG identity used to | 76 | , rtWorkingKey :: Maybe Packet -- ^ The master key of the working GnuPG identity. |
76 | -- make signatures. | 77 | , rtKeyDB :: KeyDB -- ^ The common information pool where files spilled |
77 | , rtWorkingKey :: Maybe Packet | 78 | -- their content and from which they received new |
78 | -- ^ The master key of the working GnuPG identity. | 79 | -- content. |
79 | , rtKeyDB :: KeyDB | 80 | , rtRingAccess :: Map.Map InputFile Access |
80 | -- ^ The common information pool where files spilled | 81 | -- ^ The 'Access' values used for files of type |
81 | -- their content and from which they received new | 82 | -- 'KeyRingFile'. If 'AutoAccess' was specified |
82 | -- content. | 83 | -- for a file, this 'Map.Map' will indicate the |
83 | , rtRingAccess :: Map.Map InputFile Access | 84 | -- detected value that was used by the algorithm. |
84 | -- ^ The 'Access' values used for files of type | 85 | , rtPassphrases :: PacketTranscoder |
85 | -- 'KeyRingFile'. If 'AutoAccess' was specified | 86 | } |
86 | -- for a file, this 'Map.Map' will indicate the | ||
87 | -- detected value that was used by the algorithm. | ||
88 | , rtPassphrases :: PacketTranscoder | ||
89 | } | ||
90 | 87 | ||
91 | 88 | ||
92 | -- | Roster-entry level actions | 89 | -- | Roster-entry level actions |
@@ -140,9 +137,9 @@ data KikiReportAction = | |||
140 | type KikiReport = [ (FilePath, KikiReportAction) ] | 137 | type KikiReport = [ (FilePath, KikiReportAction) ] |
141 | 138 | ||
142 | data UserIDRecord = UserIDRecord { | 139 | data UserIDRecord = UserIDRecord { |
143 | uid_full :: String, | 140 | uid_full :: String, |
144 | uid_realname :: T.Text, | 141 | uid_realname :: T.Text, |
145 | uid_user :: T.Text, | 142 | uid_user :: T.Text, |
146 | uid_subdomain :: T.Text, | 143 | uid_subdomain :: T.Text, |
147 | uid_topdomain :: T.Text | 144 | uid_topdomain :: T.Text |
148 | } | 145 | } |
@@ -780,6 +777,9 @@ makeSig doDecrypt top fname subkey_p tags mbsig = do | |||
780 | 777 | ||
781 | 778 | ||
782 | 779 | ||
780 | -- TODO: Use fingerprint to narrow candidates. | ||
781 | candidateSignerKeys :: KeyDB -> Packet -> [Packet] | ||
782 | candidateSignerKeys db sig = map keyPacket $ Map.elems db | ||
783 | 783 | ||
784 | performManipulations :: | 784 | performManipulations :: |
785 | (PacketDecrypter) | 785 | (PacketDecrypter) |
@@ -812,8 +812,8 @@ performManipulations doDecrypt rt wk manip = do | |||
812 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard | 812 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard |
813 | . (== keykey whosign) | 813 | . (== keykey whosign) |
814 | . keykey)) vs | 814 | . keykey)) vs |
815 | keys = map keyPacket $ Map.elems (rtKeyDB rt) | 815 | keys = map keyPacket $ Map.elems (rtKeyDB rt) -- TODO candidateSignerKeys (rtKeyDB rt) sig |
816 | overs sig = signatures $ Message (keys++[keyPacket kd,UserIDPacket uid,sig]) | 816 | overs sig = signatures $ Message (keys ++ [keyPacket kd,UserIDPacket uid,sig]) |
817 | vs :: [ ( Packet -- signature | 817 | vs :: [ ( Packet -- signature |
818 | , Maybe SignatureOver -- Nothing means non-verified | 818 | , Maybe SignatureOver -- Nothing means non-verified |
819 | , Packet ) -- key who signed | 819 | , Packet ) -- key who signed |
@@ -822,10 +822,11 @@ performManipulations doDecrypt rt wk manip = do | |||
822 | x <- maybeToList $ Map.lookup uid (keyUids kd) | 822 | x <- maybeToList $ Map.lookup uid (keyUids kd) |
823 | sig <- map (packet . fst) (fst x) | 823 | sig <- map (packet . fst) (fst x) |
824 | o <- overs sig | 824 | o <- overs sig |
825 | k <- keys | 825 | take 1 $ do -- Stop attempting to verify after the first success. |
826 | let ov = verify (Message [k]) $ o | 826 | k <- keys |
827 | signatures_over ov | 827 | let ov = verify (Message [k]) $ o |
828 | return (sig,Just ov,k) | 828 | signatures_over ov |
829 | return (sig,Just ov,k) | ||
829 | additional new_sig = do | 830 | additional new_sig = do |
830 | new_sig <- maybeToList new_sig | 831 | new_sig <- maybeToList new_sig |
831 | guard (null $ selfsigs) | 832 | guard (null $ selfsigs) |