diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-16 21:14:32 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-16 21:14:32 -0400 |
commit | d5b38fc2736ae75c872a6eb51d80cc90e97d1fc4 (patch) | |
tree | 58a08a2ea7c3feae3928f98fadd0e4ec462b9dc0 | |
parent | 8af08303e56fc109135e2ade91299338d03b57b0 (diff) |
KeyExactwip
-rw-r--r-- | lib/KeyRing.hs | 2 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 11 | ||||
-rw-r--r-- | lib/KeyRing/Types.hs | 1 |
3 files changed, 10 insertions, 4 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 8c92a81..4260eeb 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -673,7 +673,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk | |||
673 | workingKey grip use_db = listToMaybe $ do | 673 | workingKey grip use_db = listToMaybe $ do |
674 | fp <- maybeToList grip | 674 | fp <- maybeToList grip |
675 | elm <- keyData use_db | 675 | elm <- keyData use_db |
676 | guard $ matchSpec (KeyGrip $ show fp) elm | 676 | guard $ matchSpec (KeyExact $ Just fp) elm |
677 | return $ keyPacket elm | 677 | return $ keyPacket elm |
678 | 678 | ||
679 | mkarmor :: Access -> L.ByteString -> [Armor] | 679 | mkarmor :: Access -> L.ByteString -> [Armor] |
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index 510c820..ef4edba 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs | |||
@@ -416,9 +416,9 @@ parseSpec wkgrip spec = | |||
416 | case prespec of | 416 | case prespec of |
417 | AnyMatch -> (KeyGrip "", Nothing) | 417 | AnyMatch -> (KeyGrip "", Nothing) |
418 | EmptyMatch -> error "Bad key spec." | 418 | EmptyMatch -> error "Bad key spec." |
419 | WorkingKeyMatch -> (KeyGrip $ show wkgrip, Nothing) | 419 | WorkingKeyMatch -> (KeyExact wkgrip, Nothing) |
420 | SubstringMatch (Just KeyTypeField) tag -> (KeyGrip $ show wkgrip, Just tag) | 420 | SubstringMatch (Just KeyTypeField) tag -> (KeyExact wkgrip, Just tag) |
421 | SubstringMatch Nothing str -> (KeyGrip $ show wkgrip, Just str) | 421 | SubstringMatch Nothing str -> (KeyExact wkgrip, Just str) |
422 | SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing) | 422 | SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing) |
423 | FingerprintMatch fp -> (KeyGrip fp, Nothing) | 423 | FingerprintMatch fp -> (KeyGrip fp, Nothing) |
424 | else | 424 | else |
@@ -780,6 +780,11 @@ is40digitHex xs = ys == xs && length ys==40 | |||
780 | ishex c = False | 780 | ishex c = False |
781 | 781 | ||
782 | matchSpec :: KeySpec -> KeyData -> Bool | 782 | matchSpec :: KeySpec -> KeyData -> Bool |
783 | matchSpec (KeyExact Nothing) _ = False | ||
784 | matchSpec (KeyExact (Just grip)) (KeyData p _ _ _) | ||
785 | | matchpr grip (packet p) = True | ||
786 | | otherwise = False | ||
787 | |||
783 | matchSpec (KeyGrip grip) (KeyData p _ _ _) | 788 | matchSpec (KeyGrip grip) (KeyData p _ _ _) |
784 | | matchpr' grip (packet p) = True | 789 | | matchpr' grip (packet p) = True |
785 | | otherwise = False | 790 | | otherwise = False |
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs index 1a12a61..99986e1 100644 --- a/lib/KeyRing/Types.hs +++ b/lib/KeyRing/Types.hs | |||
@@ -367,6 +367,7 @@ matchpr'' fp k | otherwise = "" | |||
367 | 367 | ||
368 | data KeySpec = | 368 | data KeySpec = |
369 | KeyGrip String -- fp: | 369 | KeyGrip String -- fp: |
370 | | KeyExact (Maybe Fingerprint) | ||
370 | | KeyTag Packet String -- fp:????/t: | 371 | | KeyTag Packet String -- fp:????/t: |
371 | | KeyUidMatch String -- u: | 372 | | KeyUidMatch String -- u: |
372 | deriving Show | 373 | deriving Show |