From 99ff0f49d3f668acf4a7d9e7f4da275a1cb327c2 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sat, 16 May 2020 10:04:13 -0400
Subject: Match v5 partial fingerprints from front rather than back.

---
 lib/KeyRing/Types.hs | 58 ++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 43 insertions(+), 15 deletions(-)

(limited to 'lib/KeyRing/Types.hs')

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)
 import           Data.OpenPGP
 import           Data.OpenPGP.Util
 import           Data.Time.Clock
+import           Data.Word
 import           FunctorToMaybe
 import qualified Data.ByteString.Lazy as L
 import qualified System.Posix.Types as Posix
@@ -119,7 +120,7 @@ data PassphraseSpec = PassphraseSpec
     { passSpecRingFile :: Maybe FilePath
     -- ^ If not Nothing, the passphrase is to be used for packets
     -- from this file.
-    , passSpecKeySpec :: Maybe String
+    , passSpecKeySpec :: Maybe KeySpec
     -- ^ Non-Nothing value reserved for future use.
     -- (TODO: Use this to implement per-key passphrase associations).
     , passSpecPassFile :: InputFile
@@ -132,9 +133,12 @@ data PassphraseSpec = PassphraseSpec
 instance Show PassphraseSpec where
     show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
     show (PassphraseMemoizer _) = "PassphraseMemoizer"
+    show PassphraseAgent        = "PassphraseAgent"
 instance Eq PassphraseSpec where
     PassphraseSpec a b c == PassphraseSpec d e f
         = and [a==d,b==e,c==f]
+    PassphraseAgent == PassphraseAgent
+        = True
     _ == _
         = False
 
@@ -152,10 +156,13 @@ instance Ord PassphraseSpec where
     compare (PassphraseSpec a b c) (PassphraseSpec d e f)
         | fmap (const ()) a == fmap (const ()) d
           && fmap (const ()) b == fmap (const ()) e       = compare (a,b,c) (d,e,f)
-    compare (PassphraseSpec (Just _) (Just _) _)  _       = LT
-    compare (PassphraseSpec Nothing (Just _) _) _         = LT
-    compare (PassphraseSpec (Just _) _  _) _              = LT
-    compare PassphraseAgent _                             = GT
+    compare (PassphraseSpec (Just _) (Just _) _) _        = LT
+    compare (PassphraseSpec Nothing  (Just _) _) _        = LT
+    compare (PassphraseSpec (Just _) _        _) _        = LT
+    compare PassphraseAgent                      _        = GT
+    compare (PassphraseSpec Nothing Nothing _) (PassphraseSpec _ _ _) = GT
+    compare (PassphraseSpec Nothing Nothing _) (PassphraseMemoizer _) = GT
+    compare (PassphraseSpec Nothing Nothing _) PassphraseAgent        = LT
 
 data Transform =
         Autosign
@@ -349,17 +356,35 @@ isTrust _                = False
 --
 -- matchpr fp = Data.List.Extra.takeEnd (length fp)
 --
-matchpr :: String -> Packet -> String
-matchpr fp k = reverse $ zipWith const (reverse (show $ fingerprint k)) fp
+matchpr :: Word8 -> String -> Packet -> String
+matchpr ver fp k =
+    let (rev,v) = case ver of
+                    4 -> (reverse, 4)
+                    5 -> (id, 5)
+                    _ -> case auto_fp_version k of
+                            5 -> (id, 5)
+                            v -> (reverse, v)
+    in rev $ zipWith const (rev (show $ fingerprintv v k)) fp
 
 
 
 
 data KeySpec =
-      KeyGrip String       -- fp:
+      KeyFP { fpVer     :: Word8  -- 5 or 4 to select fingerprint style, 0 to match either.
+            , fpPartial :: String -- partial fingerprint, matches trailing for 4, or leading for 5
+            }              -- fp:
     | KeyTag Packet String -- fp:????/t:
     | KeyUidMatch String   -- u:
- deriving Show
+ deriving (Show,Eq)
+
+instance Ord KeySpec where
+    compare (KeyFP av af) (KeyFP bv bf) = compare (av,af) (bv,bf)
+    compare (KeyTag ap a) (KeyTag bp b) = compare (fingerprint ap,a) (fingerprint bp,b)
+    compare (KeyUidMatch a) (KeyUidMatch b) = compare a b
+    compare (KeyFP {})  _ = LT
+    compare (KeyTag {}) _ = LT
+    compare _           _ = GT
+
 
 {-
 RSAPrivateKey ::= SEQUENCE {
@@ -400,9 +425,9 @@ data SubkeyStatus = Unsigned | OwnerSigned | CrossSigned
 data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert
  deriving (Show,Eq)
 
-data MatchingField = KeyTypeField | UserIDField | GroupIDField deriving (Show,Eq,Ord,Enum)
+data MatchingField = KeyTypeField | UserIDField deriving (Show,Eq,Ord,Enum)
 
-data SingleKeySpec = FingerprintMatch String
+data SingleKeySpec = FingerprintMatch Word8 String
                    | SubstringMatch (Maybe MatchingField) String
                    | EmptyMatch
                    | AnyMatch
@@ -423,12 +448,15 @@ secretToPublic pkt@(SecretKeyPacket {}) =
                     }
 secretToPublic pkt = pkt
 
+matchKeySpec :: KeySpec -> Packet -> Bool
+matchKeySpec spec pkt = not $ null $ snd $ seek_key spec [pkt]
+
 seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
-seek_key (KeyGrip grip) sec = (pre, subs)
+seek_key (KeyFP ver grip) sec = (pre, subs)
   where
     (pre,subs) = break pred sec
-    pred p@(SecretKeyPacket {}) = matchpr grip p == grip
-    pred p@(PublicKeyPacket {}) = matchpr grip p == grip
+    pred p@(SecretKeyPacket {}) = matchpr ver grip p == grip
+    pred p@(PublicKeyPacket {}) = matchpr ver grip p == grip
     pred _                      = False
 
 seek_key (KeyTag key tag) ps
@@ -441,7 +469,7 @@ seek_key (KeyTag key tag) ps
     (as,bs) = break (\p -> isSignaturePacket p
                         && has_tag tag p
                         && isJust (signature_issuer p)
-                        && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) )
+                        && matchpr (version p) (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) )
                     ps
     (rs,qs) = break isKey (reverse as)
 
-- 
cgit v1.2.3