diff options
-rw-r--r-- | kiki.hs | 11 | ||||
-rw-r--r-- | lib/GnuPGAgent.hs | 3 | ||||
-rw-r--r-- | lib/KeyDB.hs | 13 | ||||
-rw-r--r-- | lib/KeyRing.hs | 47 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 57 | ||||
-rw-r--r-- | lib/KeyRing/Types.hs | 58 | ||||
-rw-r--r-- | lib/Kiki.hs | 1 | ||||
-rw-r--r-- | lib/PacketTranscoder.hs | 15 | ||||
-rw-r--r-- | lib/Transforms.hs | 11 |
9 files changed, 137 insertions, 79 deletions
@@ -188,7 +188,9 @@ listKeysFiltered style grips pkts0 = do | |||
188 | let issuers = do | 188 | let issuers = do |
189 | sig_over <- signatures_over sig | 189 | sig_over <- signatures_over sig |
190 | i <- maybeToList $ signature_issuer sig_over | 190 | i <- maybeToList $ signature_issuer sig_over |
191 | maybeToList $ find_key (matchpr i) (Message keys) (reverse (take 16 (reverse i))) | 191 | let sigkeyid i | version top == 5 = take 16 i |
192 | | otherwise = reverse . take 16 . reverse $ i | ||
193 | maybeToList $ find_key (matchpr (auto_fp_version sig_over) i) (Message keys) (sigkeyid i) | ||
192 | (primary,secondary) = partition (==top) issuers | 194 | (primary,secondary) = partition (==top) issuers |
193 | 195 | ||
194 | -- trace ("PRIMARY: "++show (map fingerprint primary)) $ return () | 196 | -- trace ("PRIMARY: "++show (map fingerprint primary)) $ return () |
@@ -709,13 +711,13 @@ kiki_usage ((== Export) -> bExport) ((== Import) -> bImport) ((== Secret) -> bSe | |||
709 | ," position to indicate whether a SUBKEY or MASTER is intended." | 711 | ," position to indicate whether a SUBKEY or MASTER is intended." |
710 | ,"" | 712 | ,"" |
711 | ," MASTER may be any of" | 713 | ," MASTER may be any of" |
712 | ," * The tail end of a fingerprint prefixed by 'fp:'" | 714 | ," * The tail end (or, for v5, front end) of a fingerprint prefixed by 'fp:'" |
713 | ," * A sub-string of a user id (without slashes) prefixed by 'u:'" | 715 | ," * A sub-string of a user id (without slashes) prefixed by 'u:'" |
714 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" | 716 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" |
715 | ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" | 717 | ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" |
716 | ,"" | 718 | ,"" |
717 | ," SUBKEY may be any of" | 719 | ," SUBKEY may be any of" |
718 | ," * The tail end of a fingerprint prefixed by 'fp:'" | 720 | ," * The tail end (or, for v5, front end) of a fingerprint prefixed by 'fp:'" |
719 | ," * An exact match of a usage tag prefixed by 't:'" | 721 | ," * An exact match of a usage tag prefixed by 't:'" |
720 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" | 722 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" |
721 | ," * An exact match of a usage tag (The prefix 't:' is optional)" | 723 | ," * An exact match of a usage tag (The prefix 't:' is optional)" |
@@ -1642,7 +1644,8 @@ kiki "tar" args | "--help" `elem` args = do | |||
1642 | ," (current working identity)" | 1644 | ," (current working identity)" |
1643 | ,"" | 1645 | ,"" |
1644 | ," fp:4A39F" | 1646 | ," fp:4A39F" |
1645 | ," (tail end of a fingerprint prefixed by 'fp:')" | 1647 | ," (tail end of a v4 fingerprint or the front end of a v5" |
1648 | ," fingerprint prefixed by 'fp:')" | ||
1646 | ,"" | 1649 | ,"" |
1647 | ," u:joe" | 1650 | ," u:joe" |
1648 | ," (sub-string of a user id prefixed by 'u:')" | 1651 | ," (sub-string of a user id prefixed by 'u:')" |
diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs index f1d1552..b3919dd 100644 --- a/lib/GnuPGAgent.hs +++ b/lib/GnuPGAgent.hs | |||
@@ -19,7 +19,6 @@ import Data.Char | |||
19 | import Data.Maybe | 19 | import Data.Maybe |
20 | import Data.OpenPGP | 20 | import Data.OpenPGP |
21 | import qualified Data.OpenPGP.Util | 21 | import qualified Data.OpenPGP.Util |
22 | ;import Data.OpenPGP.Util hiding (fingerprint) | ||
23 | import Data.Word | 22 | import Data.Word |
24 | import Network.Socket | 23 | import Network.Socket |
25 | import System.Directory | 24 | import System.Directory |
@@ -166,7 +165,7 @@ getPassphrase agent ask (Query key uid masterkey) = do | |||
166 | -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e | 165 | -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e |
167 | return Nothing | 166 | return Nothing |
168 | Right bs -> return $ Just $ S8.unpack bs | 167 | Right bs -> return $ Just $ S8.unpack bs |
169 | "ERR" -> return Nothing | 168 | _ {- "ERR" -} -> return Nothing |
170 | 169 | ||
171 | quit :: GnuPGAgent -> IO () | 170 | quit :: GnuPGAgent -> IO () |
172 | quit (GnuPGAgent h) = hClose h | 171 | quit (GnuPGAgent h) = hClose h |
diff --git a/lib/KeyDB.hs b/lib/KeyDB.hs index fc20b91..f785f8e 100644 --- a/lib/KeyDB.hs +++ b/lib/KeyDB.hs | |||
@@ -76,11 +76,18 @@ fingerprintGrip (Fingerprint bs) = | |||
76 | -- -- The above was removed because Int is encoded as 8 bytes even when we are | 76 | -- -- The above was removed because Int is encoded as 8 bytes even when we are |
77 | -- -- using 32-bit GHC. | 77 | -- -- using 32-bit GHC. |
78 | -- Presumably, the extra 4 bytes will be truncated. | 78 | -- Presumably, the extra 4 bytes will be truncated. |
79 | case decode $ L.fromStrict $ S.drop (S.length bs - 8) bs of | 79 | case S.length bs of |
80 | i -> KeyInt i | 80 | -- v5 from the front |
81 | 32 -> case decode $ L.fromStrict bs of | ||
82 | i -> KeyInt i | ||
83 | -- v4 from the back | ||
84 | l -> case decode $ L.fromStrict $ S.drop (l - 8) bs of | ||
85 | i -> KeyInt i | ||
81 | 86 | ||
82 | smallprGrip :: String -> Maybe KeyGrip | 87 | smallprGrip :: String -> Maybe KeyGrip |
83 | smallprGrip pr = KeyInt <$> readMaybe ("0x" ++ drop (length pr - 2 * sizeOf (0::Int)) pr) | 88 | smallprGrip pr = case length pr of |
89 | 64 -> KeyInt <$> readMaybe ("0x" ++ take (2 * sizeOf (0::Int)) pr) | ||
90 | l -> KeyInt <$> readMaybe ("0x" ++ drop (l - 2 * sizeOf (0::Int)) pr) | ||
84 | 91 | ||
85 | data KeyDB = KeyDB | 92 | data KeyDB = KeyDB |
86 | { byKeyKey :: Map.Map KeyKey KeyData | 93 | { byKeyKey :: Map.Map KeyKey KeyData |
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 07badb6..554c4ad 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -188,10 +188,12 @@ x509cert _ = Nothing | |||
188 | 188 | ||
189 | 189 | ||
190 | 190 | ||
191 | {- | ||
191 | getStr :: SingleKeySpec -> String | 192 | getStr :: SingleKeySpec -> String |
192 | getStr (FingerprintMatch x) = x | 193 | getStr (FingerprintMatch x) = x |
193 | getStr (SubstringMatch _ x) = x | 194 | getStr (SubstringMatch _ x) = x |
194 | getStr _ = "" | 195 | getStr _ = "" |
196 | -} | ||
195 | 197 | ||
196 | -- | Spec | 198 | -- | Spec |
197 | -- | 199 | -- |
@@ -235,6 +237,8 @@ data SpecError = SpecENone String | |||
235 | -- circ = Just GroupIDField | 237 | -- circ = Just GroupIDField |
236 | 238 | ||
237 | -- | parseSpec3 - Parse a key specification. | 239 | -- | parseSpec3 - Parse a key specification. |
240 | -- | ||
241 | -- TODO: This is currently unused. | ||
238 | parseSpec3 :: Maybe MatchingField -> String -> Either SpecError Spec | 242 | parseSpec3 :: Maybe MatchingField -> String -> Either SpecError Spec |
239 | parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) = | 243 | parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) = |
240 | tooBigError maybeExpecting =<< applyContext maybeExpecting . fixUpSubstrMatch <$> | 244 | tooBigError maybeExpecting =<< applyContext maybeExpecting . fixUpSubstrMatch <$> |
@@ -283,7 +287,7 @@ parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) = | |||
283 | 287 | ||
284 | adjustPos (SubstringMatch (Just KeyTypeField) _) Nothing = 0 | 288 | adjustPos (SubstringMatch (Just KeyTypeField) _) Nothing = 0 |
285 | adjustPos (SubstringMatch (Just UserIDField) _) Nothing = 1 | 289 | adjustPos (SubstringMatch (Just UserIDField) _) Nothing = 1 |
286 | adjustPos (SubstringMatch (Just GroupIDField) _) Nothing = 2 | 290 | -- adjustPos (SubstringMatch (Just GroupIDField) _) Nothing = 2 |
287 | adjustPos _ (Just i) = fromEnum i | 291 | adjustPos _ (Just i) = fromEnum i |
288 | 292 | ||
289 | gotIndex :: Int -> SingleKeySpec -> Int | 293 | gotIndex :: Int -> SingleKeySpec -> Int |
@@ -296,7 +300,7 @@ parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) = | |||
296 | mismatch xs = case find (not . fst) (reverse xs) of | 300 | mismatch xs = case find (not . fst) (reverse xs) of |
297 | Just (_,(SubstringMatch mbF s,n)) -> SpecEMissMatch s mbF (toEnum n) | 301 | Just (_,(SubstringMatch mbF s,n)) -> SpecEMissMatch s mbF (toEnum n) |
298 | 302 | ||
299 | fixUpSubstrMatch (g,u,t) = (set GroupIDField g, set UserIDField u, set KeyTypeField t) | 303 | fixUpSubstrMatch (g,u,t) = ({- set GroupIDField -} g, set UserIDField u, set KeyTypeField t) |
300 | where | 304 | where |
301 | set field (SubstringMatch Nothing xs) = SubstringMatch (Just field) xs | 305 | set field (SubstringMatch Nothing xs) = SubstringMatch (Just field) xs |
302 | set _ EmptyMatch = AnyMatch | 306 | set _ EmptyMatch = AnyMatch |
@@ -313,16 +317,17 @@ parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) = | |||
313 | applyContext (Just UserIDField) ((AnyMatch,u,x)) = (AnyMatch,u,x) | 317 | applyContext (Just UserIDField) ((AnyMatch,u,x)) = (AnyMatch,u,x) |
314 | applyContext (Just UserIDField) x = x | 318 | applyContext (Just UserIDField) x = x |
315 | 319 | ||
316 | applyContext (Just GroupIDField) ((AnyMatch,AnyMatch,x)) = (x,AnyMatch,AnyMatch) | 320 | -- applyContext (Just GroupIDField) ((AnyMatch,AnyMatch,x)) = (x,AnyMatch,AnyMatch) |
317 | applyContext (Just GroupIDField) ((AnyMatch,u,x)) = (u,AnyMatch,x) | 321 | -- applyContext (Just GroupIDField) ((AnyMatch,u,x)) = (u,AnyMatch,x) |
318 | applyContext (Just GroupIDField) x = x | 322 | -- applyContext (Just GroupIDField) x = x |
319 | 323 | ||
320 | --applyContext (Just UserIDField) (Right (g,u,x)) = Left $ | 324 | --applyContext (Just UserIDField) (Right (g,u,x)) = Left $ |
321 | -- SpecEMissMatch (getStr g) (Just GroupIDField) UserIDField | 325 | -- SpecEMissMatch (getStr g) (Just GroupIDField) UserIDField |
322 | tooBigError _ s@(_,_,SubstringMatch (Just GroupIDField) str) = Left $ | 326 | |
323 | SpecEMissMatch str (Just GroupIDField) KeyTypeField | 327 | -- tooBigError _ s@(_,_,SubstringMatch (Just GroupIDField) str) = Left $ |
324 | tooBigError _ s@(_,SubstringMatch (Just GroupIDField) str,_) = Left $ | 328 | -- SpecEMissMatch str (Just GroupIDField) KeyTypeField |
325 | SpecEMissMatch str (Just GroupIDField) UserIDField | 329 | -- tooBigError _ s@(_,SubstringMatch (Just GroupIDField) str,_) = Left $ |
330 | -- SpecEMissMatch str (Just GroupIDField) UserIDField | ||
326 | 331 | ||
327 | tooBigError Nothing x = return x | 332 | tooBigError Nothing x = return x |
328 | tooBigError (Just UserIDField) s@(g,u,t) | g /= AnyMatch = Left $ | 333 | tooBigError (Just UserIDField) s@(g,u,t) | g /= AnyMatch = Left $ |
@@ -382,10 +387,13 @@ parseSpec grip spec = (topspec,subspec) | |||
382 | filterNewSubs :: FilePath -> (KeySpec,Maybe String) -> KeyData -> KeyData | 387 | filterNewSubs :: FilePath -> (KeySpec,Maybe String) -> KeyData -> KeyData |
383 | filterNewSubs fname spec (KeyData p sigs uids subs) = KeyData p sigs uids subs' | 388 | filterNewSubs fname spec (KeyData p sigs uids subs) = KeyData p sigs uids subs' |
384 | where | 389 | where |
385 | matchAll = KeyGrip "" | 390 | matchAll = KeyFP 0 "" |
391 | |||
392 | subkeySpec (KeyFP ver grip,Nothing) = (matchAll, KeyFP ver grip) | ||
393 | subkeySpec (topspec,Just mtag) = (topspec , KeyTag (packet p) mtag) | ||
394 | subkeySpec (KeyTag p tag, Nothing) = (matchAll, KeyTag p tag) | ||
395 | subkeySpec (KeyUidMatch u, Nothing) = (KeyUidMatch u, matchAll) | ||
386 | 396 | ||
387 | subkeySpec (KeyGrip grip,Nothing) = (matchAll, KeyGrip grip) | ||
388 | subkeySpec (topspec,Just mtag) = (topspec , KeyTag (packet p) mtag) | ||
389 | 397 | ||
390 | match spec mps | 398 | match spec mps |
391 | = not . null | 399 | = not . null |
@@ -420,13 +428,13 @@ selectPublicKeyAndSigs (spec,mtag) db = | |||
420 | where | 428 | where |
421 | topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd) | 429 | topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd) |
422 | 430 | ||
423 | findbyspec (KeyGrip g) kd = do | 431 | findbyspec (KeyFP ver g) kd = do |
424 | filter ismatch $ | 432 | filter ismatch $ |
425 | topresult kd | 433 | topresult kd |
426 | : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs)) | 434 | : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs)) |
427 | (Map.elems $ keySubKeys kd) | 435 | (Map.elems $ keySubKeys kd) |
428 | where | 436 | where |
429 | ismatch (p,sigs) = matchpr g p ==g | 437 | ismatch (p,sigs) = matchpr ver g p ==g |
430 | findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] | 438 | findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] |
431 | 439 | ||
432 | findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag | 440 | findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag |
@@ -674,7 +682,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk | |||
674 | workingKey grip use_db = listToMaybe $ do | 682 | workingKey grip use_db = listToMaybe $ do |
675 | fp <- maybeToList grip | 683 | fp <- maybeToList grip |
676 | elm <- keyData use_db | 684 | elm <- keyData use_db |
677 | guard $ matchSpec (KeyGrip fp) elm | 685 | guard $ matchSpec (KeyFP 0 fp) elm |
678 | return $ keyPacket elm | 686 | return $ keyPacket elm |
679 | 687 | ||
680 | mkarmor :: Access -> L.ByteString -> [Armor] | 688 | mkarmor :: Access -> L.ByteString -> [Armor] |
@@ -921,6 +929,9 @@ writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do | |||
921 | return [(fname, ExportedSubkey)] | 929 | return [(fname, ExportedSubkey)] |
922 | algo -> return [(fname, UnableToExport algo $ show $ fingerprint packet)] | 930 | algo -> return [(fname, UnableToExport algo $ show $ fingerprint packet)] |
923 | 931 | ||
932 | writeKeyToFile strm _ _ = error $ "writeKeyToFile: Unsupported file type: " ++ show (typ strm) | ||
933 | |||
934 | |||
924 | writePEMKeys :: (PacketDecrypter) | 935 | writePEMKeys :: (PacketDecrypter) |
925 | -> KeyDB | 936 | -> KeyDB |
926 | -> [(FilePath,Maybe String,[MappedPacket],StreamInfo)] | 937 | -> [(FilePath,Maybe String,[MappedPacket],StreamInfo)] |
@@ -942,6 +953,9 @@ writePEMKeys doDecrypt db exports = do | |||
942 | pun <- doDecrypt p | 953 | pun <- doDecrypt p |
943 | try pun $ \pun -> do | 954 | try pun $ \pun -> do |
944 | return $ KikiSuccess (fname,stream,pun) | 955 | return $ KikiSuccess (fname,stream,pun) |
956 | decryptKeys (_, _, [] , _) = error "writePEMKeys: Key missing from keyring." | ||
957 | decryptKeys (_, _, (_:_:_), _) = error "writePEMKeys: Ambiguous key." | ||
958 | |||
945 | 959 | ||
946 | initializeMissingPEMFiles :: | 960 | initializeMissingPEMFiles :: |
947 | KeyRingOperation | 961 | KeyRingOperation |
@@ -956,8 +970,6 @@ initializeMissingPEMFiles :: | |||
956 | , StreamInfo )]) | 970 | , StreamInfo )]) |
957 | , [(FilePath,KikiReportAction)])) | 971 | , [(FilePath,KikiReportAction)])) |
958 | initializeMissingPEMFiles operation ctx grip mwk transcode db = do | 972 | initializeMissingPEMFiles operation ctx grip mwk transcode db = do |
959 | let decrypt = transcode (Unencrypted,S2K 100 "") | ||
960 | |||
961 | -- nonexistants - files missing from disk. | 973 | -- nonexistants - files missing from disk. |
962 | nonexistents <- | 974 | nonexistents <- |
963 | filterM (fmap not . doesFileExist . fst) | 975 | filterM (fmap not . doesFileExist . fst) |
@@ -1197,5 +1209,6 @@ getHomeDir protohome = do | |||
1197 | \(forgive,fname) -> parseOptionFile fname | 1209 | \(forgive,fname) -> parseOptionFile fname |
1198 | let config = map (topair . words) args | 1210 | let config = map (topair . words) args |
1199 | where topair (x:xs) = (x,xs) | 1211 | where topair (x:xs) = (x,xs) |
1212 | topair _ = error "parseOptionFile yeilded an empty entry?" | ||
1200 | return $ lookup "default-key" config >>= listToMaybe | 1213 | return $ lookup "default-key" config >>= listToMaybe |
1201 | 1214 | ||
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index 44952de..57647b0 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs | |||
@@ -36,6 +36,7 @@ import qualified Data.Map as Map | |||
36 | import Data.Maybe | 36 | import Data.Maybe |
37 | import Data.OpenPGP | 37 | import Data.OpenPGP |
38 | import Data.OpenPGP.Util (GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify) | 38 | import Data.OpenPGP.Util (GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify) |
39 | import GHC.Stack | ||
39 | 40 | ||
40 | 41 | ||
41 | import Data.Time.Clock (UTCTime) | 42 | import Data.Time.Clock (UTCTime) |
@@ -171,7 +172,7 @@ buildKeyDB ctx grip0 keyring = do | |||
171 | trans f (info,ps) = do | 172 | trans f (info,ps) = do |
172 | let manip = combineTransforms (transforms info) | 173 | let manip = combineTransforms (transforms info) |
173 | rt1 = rt0 { rtKeyDB = merge emptyKeyDB f ps } | 174 | rt1 = rt0 { rtKeyDB = merge emptyKeyDB f ps } |
174 | acc = Just Sec /= Map.lookup f accs | 175 | -- acc = Just Sec /= Map.lookup f accs |
175 | r <- performManipulations doDecrypt rt1 mwk manip | 176 | r <- performManipulations doDecrypt rt1 mwk manip |
176 | try r $ \(rt2,report) -> do | 177 | try r $ \(rt2,report) -> do |
177 | return $ KikiSuccess (report,rtKeyDB rt2) | 178 | return $ KikiSuccess (report,rtKeyDB rt2) |
@@ -390,6 +391,7 @@ doImportG transcode db m0 tags fname key = do | |||
390 | , rrs ) | 391 | , rrs ) |
391 | -} | 392 | -} |
392 | let go (Just kd@(KeyData top topsigs uids subs)) = insertSubkey transcode kk kd tags fname key | 393 | let go (Just kd@(KeyData top topsigs uids subs)) = insertSubkey transcode kk kd tags fname key |
394 | go Nothing = pure NoWorkingKey | ||
393 | transmuteAt go kk db | 395 | transmuteAt go kk db |
394 | 396 | ||
395 | 397 | ||
@@ -413,27 +415,27 @@ parseSpec wkgrip spec = | |||
413 | if not slashed | 415 | if not slashed |
414 | then | 416 | then |
415 | case prespec of | 417 | case prespec of |
416 | AnyMatch -> (KeyGrip "", Nothing) | 418 | AnyMatch -> (KeyFP 0 "", Nothing) |
417 | EmptyMatch -> error "Bad key spec." | 419 | EmptyMatch -> error "Bad key spec." |
418 | WorkingKeyMatch -> (KeyGrip wkgrip, Nothing) | 420 | WorkingKeyMatch -> (KeyFP 0 wkgrip, Nothing) |
419 | SubstringMatch (Just KeyTypeField) tag -> (KeyGrip wkgrip, Just tag) | 421 | SubstringMatch (Just KeyTypeField) tag -> (KeyFP 0 wkgrip, Just tag) |
420 | SubstringMatch Nothing str -> (KeyGrip wkgrip, Just str) | 422 | SubstringMatch Nothing str -> (KeyFP 0 wkgrip, Just str) |
421 | SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing) | 423 | SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing) |
422 | FingerprintMatch fp -> (KeyGrip fp, Nothing) | 424 | FingerprintMatch ver fp -> (KeyFP ver fp, Nothing) |
423 | else | 425 | else |
424 | case (prespec,postspec) of | 426 | case (prespec,postspec) of |
425 | (FingerprintMatch fp, SubstringMatch st t) | 427 | (FingerprintMatch ver fp, SubstringMatch st t) |
426 | | st /= Just UserIDField -> (KeyGrip fp, Just t) | 428 | | st /= Just UserIDField -> (KeyFP ver fp, Just t) |
427 | (SubstringMatch mt u, _) | 429 | (SubstringMatch mt u, _) |
428 | | postspec `elem` [AnyMatch,EmptyMatch] | 430 | | postspec `elem` [AnyMatch,EmptyMatch] |
429 | && mt /= Just KeyTypeField -> (KeyUidMatch u, Nothing) | 431 | && mt /= Just KeyTypeField -> (KeyUidMatch u, Nothing) |
430 | (SubstringMatch mt u, SubstringMatch st t) | 432 | (SubstringMatch mt u, SubstringMatch st t) |
431 | | mt /= Just KeyTypeField | 433 | | mt /= Just KeyTypeField |
432 | && st /= Just UserIDField -> (KeyUidMatch u, Just t) | 434 | && st /= Just UserIDField -> (KeyUidMatch u, Just t) |
433 | (FingerprintMatch _,FingerprintMatch _) -> error "todo: support fp:/fp: spec" | 435 | (FingerprintMatch _ _,FingerprintMatch _ _) -> error "todo: support fp:/fp: spec" |
434 | (_,FingerprintMatch fp) -> error "todo: support /fp: spec" | 436 | (_,FingerprintMatch _ fp) -> error "todo: support /fp: spec" |
435 | (FingerprintMatch fp,_) -> error "todo: support fp:/ spec" | 437 | (FingerprintMatch _ fp,_) -> error "todo: support fp:/ spec" |
436 | _ -> error "Bad key spec." | 438 | _ -> error "Bad key spec." |
437 | where | 439 | where |
438 | (preslash,slashon) = break (=='/') spec | 440 | (preslash,slashon) = break (=='/') spec |
439 | slashed = not $ null $ take 1 slashon | 441 | slashed = not $ null $ take 1 slashon |
@@ -522,6 +524,7 @@ generateInternals transcode mwk db gens = do | |||
522 | transmuteAt (go kk) kk db | 524 | transmuteAt (go kk) kk db |
523 | where | 525 | where |
524 | go kk (Just kd0) = foldM (generateSubkey transcode) (KikiSuccess (kd0,[])) gens | 526 | go kk (Just kd0) = foldM (generateSubkey transcode) (KikiSuccess (kd0,[])) gens |
527 | go kk Nothing = error "generateInternals: Key not found." | ||
525 | 528 | ||
526 | mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext | 529 | mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext |
527 | -> IO | 530 | -> IO |
@@ -588,7 +591,7 @@ readInputFileL ctx inp = do | |||
588 | hs <- mapM (`openFile` ReadMode) fname | 591 | hs <- mapM (`openFile` ReadMode) fname |
589 | fmap L.concat $ mapM (hGetContentsN oneMeg) hs | 592 | fmap L.concat $ mapM (hGetContentsN oneMeg) hs |
590 | 593 | ||
591 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime | 594 | getInputFileTime :: HasCallStack => InputFileContext -> InputFile -> IO CTime |
592 | getInputFileTime ctx (Pipe fdr fdw) = do | 595 | getInputFileTime ctx (Pipe fdr fdw) = do |
593 | mt <- handleIO_ (return Nothing) $ Just <$> modificationTime <$> getFdStatus fdr | 596 | mt <- handleIO_ (return Nothing) $ Just <$> modificationTime <$> getFdStatus fdr |
594 | maybe tryw return mt | 597 | maybe tryw return mt |
@@ -602,6 +605,8 @@ getInputFileTime ctx (FileDesc fd) = do | |||
602 | getInputFileTime ctx (resolveInputFile ctx -> [fname]) = do | 605 | getInputFileTime ctx (resolveInputFile ctx -> [fname]) = do |
603 | handleIO_ (error $ fname++": modificaiton time?") $ | 606 | handleIO_ (error $ fname++": modificaiton time?") $ |
604 | modificationTime <$> getFileStatus fname | 607 | modificationTime <$> getFileStatus fname |
608 | getInputFileTime ctx arg = error $ "getInputFileTime: Invalid argument: " ++ show arg | ||
609 | |||
605 | 610 | ||
606 | slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) | 611 | slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) |
607 | slurpWIPKeys stamp "" = ([],[]) | 612 | slurpWIPKeys stamp "" = ([],[]) |
@@ -763,14 +768,15 @@ parseSingleSpec "-" = WorkingKeyMatch | |||
763 | parseSingleSpec "" = EmptyMatch | 768 | parseSingleSpec "" = EmptyMatch |
764 | parseSingleSpec ('t':':':tag) = SubstringMatch (Just KeyTypeField) tag | 769 | parseSingleSpec ('t':':':tag) = SubstringMatch (Just KeyTypeField) tag |
765 | parseSingleSpec ('u':':':tag) = SubstringMatch (Just UserIDField) tag | 770 | parseSingleSpec ('u':':':tag) = SubstringMatch (Just UserIDField) tag |
766 | parseSingleSpec ('c':':':tag) = SubstringMatch (Just GroupIDField) tag | 771 | -- parseSingleSpec ('c':':':tag) = SubstringMatch (Just GroupIDField) tag |
767 | parseSingleSpec ('f':'p':':':fp) = FingerprintMatch fp | 772 | parseSingleSpec ('f':'p':':':fp) = FingerprintMatch 0 fp |
768 | parseSingleSpec str | 773 | parseSingleSpec str |
769 | | is40digitHex str = FingerprintMatch str | 774 | | Just 40 <- isHexDigits str = FingerprintMatch 4 str |
770 | | otherwise = SubstringMatch Nothing str | 775 | | Just 64 <- isHexDigits str = FingerprintMatch 5 str |
776 | | otherwise = SubstringMatch Nothing str | ||
771 | 777 | ||
772 | is40digitHex :: [Char] -> Bool | 778 | isHexDigits :: [Char] -> Maybe Int |
773 | is40digitHex xs = ys == xs && length ys==40 | 779 | isHexDigits xs = guard (ys == xs) >> Just (length ys) |
774 | where | 780 | where |
775 | ys = filter ishex xs | 781 | ys = filter ishex xs |
776 | ishex c | '0' <= c && c <= '9' = True | 782 | ishex c | '0' <= c && c <= '9' = True |
@@ -779,9 +785,9 @@ is40digitHex xs = ys == xs && length ys==40 | |||
779 | ishex c = False | 785 | ishex c = False |
780 | 786 | ||
781 | matchSpec :: KeySpec -> KeyData -> Bool | 787 | matchSpec :: KeySpec -> KeyData -> Bool |
782 | matchSpec (KeyGrip grip) (KeyData p _ _ _) | 788 | matchSpec (KeyFP ver grip) (KeyData p _ _ _) |
783 | | matchpr grip (packet p)==grip = True | 789 | = let mg = matchpr ver grip (packet p) |
784 | | otherwise = False | 790 | in mg == grip |
785 | 791 | ||
786 | matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps | 792 | matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps |
787 | where | 793 | where |
@@ -791,7 +797,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps | |||
791 | && has_issuer key p | 797 | && has_issuer key p |
792 | has_issuer key p = isJust $ do | 798 | has_issuer key p = isJust $ do |
793 | issuer <- signature_issuer p | 799 | issuer <- signature_issuer p |
794 | guard $ matchpr issuer key == issuer | 800 | guard $ matchpr 0 issuer key == issuer |
795 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) | 801 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) |
796 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) | 802 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) |
797 | 803 | ||
@@ -907,7 +913,7 @@ getHostnames (KeyData topmp _ uids subs) = Hostnames addr onames othernames Noth | |||
907 | 913 | ||
908 | hasFingerDress :: KeyDB -> SockAddr -> Bool | 914 | hasFingerDress :: KeyDB -> SockAddr -> Bool |
909 | hasFingerDress db addr | socketFamily addr/=AF_INET6 = False | 915 | hasFingerDress db addr | socketFamily addr/=AF_INET6 = False |
910 | hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyGrip g',Nothing) db) | 916 | hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyFP 0 g',Nothing) db) |
911 | where | 917 | where |
912 | (pre,g) = splitAt 2 $ filter (/=':') $ Hosts.inet_ntop addr | 918 | (pre,g) = splitAt 2 $ filter (/=':') $ Hosts.inet_ntop addr |
913 | g' = map toUpper g | 919 | g' = map toUpper g |
@@ -1012,6 +1018,7 @@ decode_btc_key timestamp str = do | |||
1012 | ] | 1018 | ] |
1013 | , s2k_useage = 0 | 1019 | , s2k_useage = 0 |
1014 | , s2k = S2K 100 "" | 1020 | , s2k = S2K 100 "" |
1021 | , aead_algorithm = Nothing | ||
1015 | , symmetric_algorithm = Unencrypted | 1022 | , symmetric_algorithm = Unencrypted |
1016 | , encrypted_data = "" | 1023 | , encrypted_data = "" |
1017 | , is_subkey = True | 1024 | , is_subkey = True |
@@ -1205,6 +1212,7 @@ readSecretDNSFile fname = do | |||
1205 | _ -> RSA | 1212 | _ -> RSA |
1206 | case alg of | 1213 | case alg of |
1207 | RSA -> return $ rsaToPGP stamp $ fromJust $ extractRSAKeyFields kvs | 1214 | RSA -> return $ rsaToPGP stamp $ fromJust $ extractRSAKeyFields kvs |
1215 | _ -> return $ error $ "readSecretDNSFile: " ++ show alg ++ " unimplemented." | ||
1208 | 1216 | ||
1209 | spemPacket :: SecretPEMData -> Maybe Packet | 1217 | spemPacket :: SecretPEMData -> Maybe Packet |
1210 | spemPacket (PEMPacket p) = Just p | 1218 | spemPacket (PEMPacket p) = Just p |
@@ -1310,6 +1318,7 @@ rsaToPGP stamp rsa = SecretKeyPacket | |||
1310 | -- , ecc_curve = def | 1318 | -- , ecc_curve = def |
1311 | , s2k_useage = 0 | 1319 | , s2k_useage = 0 |
1312 | , s2k = S2K 100 "" | 1320 | , s2k = S2K 100 "" |
1321 | , aead_algorithm = Nothing | ||
1313 | , symmetric_algorithm = Unencrypted | 1322 | , symmetric_algorithm = Unencrypted |
1314 | , encrypted_data = "" | 1323 | , encrypted_data = "" |
1315 | , is_subkey = True | 1324 | , is_subkey = True |
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs index af213ce..dbcc22c 100644 --- a/lib/KeyRing/Types.hs +++ b/lib/KeyRing/Types.hs | |||
@@ -13,6 +13,7 @@ import Data.Maybe (maybeToList,isJust,fromJust,mapMaybe) | |||
13 | import Data.OpenPGP | 13 | import Data.OpenPGP |
14 | import Data.OpenPGP.Util | 14 | import Data.OpenPGP.Util |
15 | import Data.Time.Clock | 15 | import Data.Time.Clock |
16 | import Data.Word | ||
16 | import FunctorToMaybe | 17 | import FunctorToMaybe |
17 | import qualified Data.ByteString.Lazy as L | 18 | import qualified Data.ByteString.Lazy as L |
18 | import qualified System.Posix.Types as Posix | 19 | import qualified System.Posix.Types as Posix |
@@ -119,7 +120,7 @@ data PassphraseSpec = PassphraseSpec | |||
119 | { passSpecRingFile :: Maybe FilePath | 120 | { passSpecRingFile :: Maybe FilePath |
120 | -- ^ If not Nothing, the passphrase is to be used for packets | 121 | -- ^ If not Nothing, the passphrase is to be used for packets |
121 | -- from this file. | 122 | -- from this file. |
122 | , passSpecKeySpec :: Maybe String | 123 | , passSpecKeySpec :: Maybe KeySpec |
123 | -- ^ Non-Nothing value reserved for future use. | 124 | -- ^ Non-Nothing value reserved for future use. |
124 | -- (TODO: Use this to implement per-key passphrase associations). | 125 | -- (TODO: Use this to implement per-key passphrase associations). |
125 | , passSpecPassFile :: InputFile | 126 | , passSpecPassFile :: InputFile |
@@ -132,9 +133,12 @@ data PassphraseSpec = PassphraseSpec | |||
132 | instance Show PassphraseSpec where | 133 | instance Show PassphraseSpec where |
133 | show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c) | 134 | show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c) |
134 | show (PassphraseMemoizer _) = "PassphraseMemoizer" | 135 | show (PassphraseMemoizer _) = "PassphraseMemoizer" |
136 | show PassphraseAgent = "PassphraseAgent" | ||
135 | instance Eq PassphraseSpec where | 137 | instance Eq PassphraseSpec where |
136 | PassphraseSpec a b c == PassphraseSpec d e f | 138 | PassphraseSpec a b c == PassphraseSpec d e f |
137 | = and [a==d,b==e,c==f] | 139 | = and [a==d,b==e,c==f] |
140 | PassphraseAgent == PassphraseAgent | ||
141 | = True | ||
138 | _ == _ | 142 | _ == _ |
139 | = False | 143 | = False |
140 | 144 | ||
@@ -152,10 +156,13 @@ instance Ord PassphraseSpec where | |||
152 | compare (PassphraseSpec a b c) (PassphraseSpec d e f) | 156 | compare (PassphraseSpec a b c) (PassphraseSpec d e f) |
153 | | fmap (const ()) a == fmap (const ()) d | 157 | | fmap (const ()) a == fmap (const ()) d |
154 | && fmap (const ()) b == fmap (const ()) e = compare (a,b,c) (d,e,f) | 158 | && fmap (const ()) b == fmap (const ()) e = compare (a,b,c) (d,e,f) |
155 | compare (PassphraseSpec (Just _) (Just _) _) _ = LT | 159 | compare (PassphraseSpec (Just _) (Just _) _) _ = LT |
156 | compare (PassphraseSpec Nothing (Just _) _) _ = LT | 160 | compare (PassphraseSpec Nothing (Just _) _) _ = LT |
157 | compare (PassphraseSpec (Just _) _ _) _ = LT | 161 | compare (PassphraseSpec (Just _) _ _) _ = LT |
158 | compare PassphraseAgent _ = GT | 162 | compare PassphraseAgent _ = GT |
163 | compare (PassphraseSpec Nothing Nothing _) (PassphraseSpec _ _ _) = GT | ||
164 | compare (PassphraseSpec Nothing Nothing _) (PassphraseMemoizer _) = GT | ||
165 | compare (PassphraseSpec Nothing Nothing _) PassphraseAgent = LT | ||
159 | 166 | ||
160 | data Transform = | 167 | data Transform = |
161 | Autosign | 168 | Autosign |
@@ -349,17 +356,35 @@ isTrust _ = False | |||
349 | -- | 356 | -- |
350 | -- matchpr fp = Data.List.Extra.takeEnd (length fp) | 357 | -- matchpr fp = Data.List.Extra.takeEnd (length fp) |
351 | -- | 358 | -- |
352 | matchpr :: String -> Packet -> String | 359 | matchpr :: Word8 -> String -> Packet -> String |
353 | matchpr fp k = reverse $ zipWith const (reverse (show $ fingerprint k)) fp | 360 | matchpr ver fp k = |
361 | let (rev,v) = case ver of | ||
362 | 4 -> (reverse, 4) | ||
363 | 5 -> (id, 5) | ||
364 | _ -> case auto_fp_version k of | ||
365 | 5 -> (id, 5) | ||
366 | v -> (reverse, v) | ||
367 | in rev $ zipWith const (rev (show $ fingerprintv v k)) fp | ||
354 | 368 | ||
355 | 369 | ||
356 | 370 | ||
357 | 371 | ||
358 | data KeySpec = | 372 | data KeySpec = |
359 | KeyGrip String -- fp: | 373 | KeyFP { fpVer :: Word8 -- 5 or 4 to select fingerprint style, 0 to match either. |
374 | , fpPartial :: String -- partial fingerprint, matches trailing for 4, or leading for 5 | ||
375 | } -- fp: | ||
360 | | KeyTag Packet String -- fp:????/t: | 376 | | KeyTag Packet String -- fp:????/t: |
361 | | KeyUidMatch String -- u: | 377 | | KeyUidMatch String -- u: |
362 | deriving Show | 378 | deriving (Show,Eq) |
379 | |||
380 | instance Ord KeySpec where | ||
381 | compare (KeyFP av af) (KeyFP bv bf) = compare (av,af) (bv,bf) | ||
382 | compare (KeyTag ap a) (KeyTag bp b) = compare (fingerprint ap,a) (fingerprint bp,b) | ||
383 | compare (KeyUidMatch a) (KeyUidMatch b) = compare a b | ||
384 | compare (KeyFP {}) _ = LT | ||
385 | compare (KeyTag {}) _ = LT | ||
386 | compare _ _ = GT | ||
387 | |||
363 | 388 | ||
364 | {- | 389 | {- |
365 | RSAPrivateKey ::= SEQUENCE { | 390 | RSAPrivateKey ::= SEQUENCE { |
@@ -400,9 +425,9 @@ data SubkeyStatus = Unsigned | OwnerSigned | CrossSigned | |||
400 | data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert | 425 | data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert |
401 | deriving (Show,Eq) | 426 | deriving (Show,Eq) |
402 | 427 | ||
403 | data MatchingField = KeyTypeField | UserIDField | GroupIDField deriving (Show,Eq,Ord,Enum) | 428 | data MatchingField = KeyTypeField | UserIDField deriving (Show,Eq,Ord,Enum) |
404 | 429 | ||
405 | data SingleKeySpec = FingerprintMatch String | 430 | data SingleKeySpec = FingerprintMatch Word8 String |
406 | | SubstringMatch (Maybe MatchingField) String | 431 | | SubstringMatch (Maybe MatchingField) String |
407 | | EmptyMatch | 432 | | EmptyMatch |
408 | | AnyMatch | 433 | | AnyMatch |
@@ -423,12 +448,15 @@ secretToPublic pkt@(SecretKeyPacket {}) = | |||
423 | } | 448 | } |
424 | secretToPublic pkt = pkt | 449 | secretToPublic pkt = pkt |
425 | 450 | ||
451 | matchKeySpec :: KeySpec -> Packet -> Bool | ||
452 | matchKeySpec spec pkt = not $ null $ snd $ seek_key spec [pkt] | ||
453 | |||
426 | seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) | 454 | seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) |
427 | seek_key (KeyGrip grip) sec = (pre, subs) | 455 | seek_key (KeyFP ver grip) sec = (pre, subs) |
428 | where | 456 | where |
429 | (pre,subs) = break pred sec | 457 | (pre,subs) = break pred sec |
430 | pred p@(SecretKeyPacket {}) = matchpr grip p == grip | 458 | pred p@(SecretKeyPacket {}) = matchpr ver grip p == grip |
431 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip | 459 | pred p@(PublicKeyPacket {}) = matchpr ver grip p == grip |
432 | pred _ = False | 460 | pred _ = False |
433 | 461 | ||
434 | seek_key (KeyTag key tag) ps | 462 | seek_key (KeyTag key tag) ps |
@@ -441,7 +469,7 @@ seek_key (KeyTag key tag) ps | |||
441 | (as,bs) = break (\p -> isSignaturePacket p | 469 | (as,bs) = break (\p -> isSignaturePacket p |
442 | && has_tag tag p | 470 | && has_tag tag p |
443 | && isJust (signature_issuer p) | 471 | && isJust (signature_issuer p) |
444 | && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) | 472 | && matchpr (version p) (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) |
445 | ps | 473 | ps |
446 | (rs,qs) = break isKey (reverse as) | 474 | (rs,qs) = break isKey (reverse as) |
447 | 475 | ||
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 96ad9ff..f4c4a2b 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -808,7 +808,6 @@ signFile isHomeless cap keyrings keyid filename = do | |||
808 | , content = bs | 808 | , content = bs |
809 | } | 809 | } |
810 | hash = SHA512 | 810 | hash = SHA512 |
811 | matchkey fp mp = matchpr fp (packet mp) == fp | ||
812 | case smallprGrip keyid of | 811 | case smallprGrip keyid of |
813 | Nothing -> hPutStrLn stderr "Bad keygrip." | 812 | Nothing -> hPutStrLn stderr "Bad keygrip." |
814 | Just grip -> do | 813 | Just grip -> do |
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs index 759d83f..71a2202 100644 --- a/lib/PacketTranscoder.hs +++ b/lib/PacketTranscoder.hs | |||
@@ -3,8 +3,6 @@ | |||
3 | {-# LANGUAGE PatternGuards #-} | 3 | {-# LANGUAGE PatternGuards #-} |
4 | module PacketTranscoder where | 4 | module PacketTranscoder where |
5 | 5 | ||
6 | import Debug.Trace | ||
7 | import GHC.Stack | ||
8 | import Control.Monad | 6 | import Control.Monad |
9 | import Data.IORef | 7 | import Data.IORef |
10 | import Data.List | 8 | import Data.List |
@@ -16,12 +14,10 @@ import qualified Data.ByteString as S | |||
16 | import qualified Data.ByteString.Char8 as S8 | 14 | import qualified Data.ByteString.Char8 as S8 |
17 | import Data.Map as Map (Map) | 15 | import Data.Map as Map (Map) |
18 | import qualified Data.Map as Map | 16 | import qualified Data.Map as Map |
19 | import qualified Data.Traversable as Traversable | ||
20 | import System.IO ( stderr) | 17 | import System.IO ( stderr) |
21 | import System.Posix.IO ( fdToHandle ) | 18 | import System.Posix.IO ( fdToHandle ) |
22 | import Text.Show.Pretty as PP ( ppShow ) | 19 | import Text.Show.Pretty as PP ( ppShow ) |
23 | import KeyRing.Types | 20 | import KeyRing.Types |
24 | import ControlMaybe (handleIO_) | ||
25 | 21 | ||
26 | -- | Merge two representations of the same key, prefering secret version | 22 | -- | Merge two representations of the same key, prefering secret version |
27 | -- because they have more information. | 23 | -- because they have more information. |
@@ -113,7 +109,7 @@ interpretPassSpec ctx _ PassphraseSpec { passSpecPassFile = fd | |||
113 | cachedContents (Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n") | 109 | cachedContents (Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n") |
114 | ctx | 110 | ctx |
115 | fd | 111 | fd |
116 | let matchkey fp mp = matchpr fp (packet mp) == fp | 112 | let matchkey fp mp = matchKeySpec fp (packet mp) |
117 | matchfile file mp = Map.member file (locations mp) | 113 | matchfile file mp = Map.member file (locations mp) |
118 | specializers = [ fmap matchkey keyspec, fmap matchfile inputfile] | 114 | specializers = [ fmap matchkey keyspec, fmap matchfile inputfile] |
119 | specialize alg mp = | 115 | specialize alg mp = |
@@ -142,6 +138,11 @@ interpretPassSpec ctx keys PassphraseAgent = do | |||
142 | 138 | ||
143 | return $ KikiSuccess (cacheSearch, quit agent) | 139 | return $ KikiSuccess (cacheSearch, quit agent) |
144 | 140 | ||
141 | interpretPassSpec ctx keys (PassphraseMemoizer _) = | ||
142 | -- INVALID ARGUMENT: PassphraseMemoizer | ||
143 | return BadPassphrase | ||
144 | |||
145 | |||
145 | sendQuery :: GnuPGAgent -> (QueryMode,PassphraseResponse) -> OriginMapped Query -> IO PassphraseResponse | 146 | sendQuery :: GnuPGAgent -> (QueryMode,PassphraseResponse) -> OriginMapped Query -> IO PassphraseResponse |
146 | sendQuery agent (ask,failure) qry = do | 147 | sendQuery agent (ask,failure) qry = do |
147 | mbpw <- getPassphrase agent ask (packet qry) | 148 | mbpw <- getPassphrase agent ask (packet qry) |
@@ -291,8 +292,8 @@ keyQueries grip ringPackets = (mwk, fmap makeQuery keys) | |||
291 | mwk = listToMaybe $ do | 292 | mwk = listToMaybe $ do |
292 | fp <- maybeToList grip | 293 | fp <- maybeToList grip |
293 | let matchfp mp | 294 | let matchfp mp |
294 | | not (is_subkey p) && matchpr fp p == fp = Just mp | 295 | | not (is_subkey p) && matchpr 0 fp p == fp = Just mp |
295 | | otherwise = Nothing | 296 | | otherwise = Nothing |
296 | where p = packet mp | 297 | where p = packet mp |
297 | Map.elems $ Map.mapMaybe matchfp $ fmap (\(_,p,_) -> p) $ keys | 298 | Map.elems $ Map.mapMaybe matchfp $ fmap (\(_,p,_) -> p) $ keys |
298 | 299 | ||
diff --git a/lib/Transforms.hs b/lib/Transforms.hs index 118b494..473ecbc 100644 --- a/lib/Transforms.hs +++ b/lib/Transforms.hs | |||
@@ -151,6 +151,8 @@ signature_time ov = case (if null cs then ds else cs) of | |||
151 | creationTime (SignatureCreationTimePacket t) = [t] | 151 | creationTime (SignatureCreationTimePacket t) = [t] |
152 | creationTime _ = [] | 152 | creationTime _ = [] |
153 | 153 | ||
154 | matchingGrip :: Packet -> String -> Bool | ||
155 | matchingGrip topk g = matchpr 0 g topk == g | ||
154 | 156 | ||
155 | -- | Given list of subpackets, a master key, one of its subkeys and a | 157 | -- | Given list of subpackets, a master key, one of its subkeys and a |
156 | -- list of signatures on that subkey, yields: | 158 | -- list of signatures on that subkey, yields: |
@@ -177,9 +179,8 @@ findTag tag topk subkey subsigs = (xs',minsig,ys') | |||
177 | (sig, do | 179 | (sig, do |
178 | sig <- Just (packet . fst $ sig) | 180 | sig <- Just (packet . fst $ sig) |
179 | guard (isSignaturePacket sig) | 181 | guard (isSignaturePacket sig) |
180 | guard $ flip isSuffixOf | 182 | guard $ matchingGrip topk |
181 | (show $ fingerprint topk) | 183 | . fromMaybe "%bad%" |
182 | . fromMaybe "%bad%" | ||
183 | . signature_issuer | 184 | . signature_issuer |
184 | $ sig | 185 | $ sig |
185 | listToMaybe $ | 186 | listToMaybe $ |
@@ -483,9 +484,7 @@ keyFlags0 wkun uidsigs = concat | |||
483 | , BZip2 | 484 | , BZip2 |
484 | , ZIP | 485 | , ZIP |
485 | ] | 486 | ] |
486 | features = filterOr isfeatures subs $ | 487 | features = filterOr isfeatures subs defaultFeatures |
487 | FeaturesPacket { supports_mdc = True | ||
488 | } | ||
489 | 488 | ||
490 | filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs | 489 | filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs |
491 | 490 | ||