Match v5 partial fingerprints from front rather than back.

9 files changed, 137 insertions, 79 deletions

diff --git a/kiki.hs b/kiki.hs
index 0bc7133..03ea635 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -188,7 +188,9 @@ listKeysFiltered style grips pkts0 = do
             let issuers = do
                     sig_over <- signatures_over sig
                     i <- maybeToList $ signature_issuer sig_over
-                    maybeToList $ find_key (matchpr i) (Message keys) (reverse (take 16 (reverse i)))
+                    let sigkeyid i | version top == 5 = take 16 i
+                                   | otherwise        = reverse . take 16 . reverse $ i
+                    maybeToList $ find_key (matchpr (auto_fp_version sig_over) i) (Message keys) (sigkeyid i)
                 (primary,secondary) = partition (==top) issuers
 
             -- trace ("PRIMARY: "++show (map fingerprint primary)) $ return ()
@@ -709,13 +711,13 @@ kiki_usage ((== Export) -> bExport) ((== Import) -> bImport) ((== Secret) -> bSe
                  ,"  position to indicate whether a SUBKEY or MASTER is intended."
                  ,""
                  ,"  MASTER may be any of"
-                 ,"     * The tail end of a fingerprint prefixed by 'fp:'"
+                 ,"     * The tail end (or, for v5, front end) of a fingerprint prefixed by 'fp:'"
                  ,"     * A sub-string of a user id (without slashes) prefixed by 'u:'"
                  ,"     * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)"
                  ,"     * A sub-string of a user id (without slashes, the prefix 'u:' is optional)"
                  ,""
                  ,"  SUBKEY may be any of"
-                 ,"     * The tail end of a fingerprint prefixed by 'fp:'"
+                 ,"     * The tail end (or, for v5, front end) of a fingerprint prefixed by 'fp:'"
                  ,"     * An exact match of a usage tag prefixed by 't:'"
                  ,"     * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)"
                  ,"     * An exact match of a usage tag (The prefix 't:' is optional)"
@@ -1642,7 +1644,8 @@ kiki "tar" args | "--help" `elem` args = do
         ,"           (current working identity)"
         ,""
         ,"          fp:4A39F"
-        ,"            (tail end of a fingerprint prefixed by 'fp:')"
+        ,"            (tail end of a v4 fingerprint or the front end of a v5"
+        ,"            fingerprint prefixed by 'fp:')"
         ,""
         ,"          u:joe"
         ,"            (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
 import Data.Maybe
 import Data.OpenPGP
 import qualified Data.OpenPGP.Util
-         ;import Data.OpenPGP.Util hiding (fingerprint)
 import Data.Word
 import Network.Socket
 import System.Directory
@@ -166,7 +165,7 @@ getPassphrase agent ask (Query key uid masterkey) = do
                                 -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e
                                 return Nothing
                             Right bs -> return $ Just $ S8.unpack bs
-        "ERR" -> return Nothing
+        _ {- "ERR" -} -> return Nothing
 
 quit :: GnuPGAgent -> IO ()
 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) =
     -- -- The above was removed because Int is encoded as 8 bytes even when we are
     -- -- using 32-bit GHC.
     -- Presumably, the extra 4 bytes will be truncated.
-    case decode $ L.fromStrict $ S.drop (S.length bs - 8) bs of
-        i -> KeyInt i
+    case S.length bs of
+        -- v5 from the front
+        32 -> case decode $ L.fromStrict bs of
+            i -> KeyInt i
+        -- v4 from the back
+        l -> case decode $ L.fromStrict $ S.drop (l - 8) bs of
+            i -> KeyInt i
 
 smallprGrip :: String -> Maybe KeyGrip
-smallprGrip pr = KeyInt <$> readMaybe ("0x" ++ drop (length pr - 2 * sizeOf (0::Int)) pr)
+smallprGrip pr = case length pr of
+    64 -> KeyInt <$> readMaybe ("0x" ++ take (2 * sizeOf (0::Int)) pr)
+    l  -> KeyInt <$> readMaybe ("0x" ++ drop (l - 2 * sizeOf (0::Int)) pr)
 
 data KeyDB = KeyDB
     { 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
 
 
 
+{-
 getStr :: SingleKeySpec -> String
 getStr (FingerprintMatch x) = x
 getStr (SubstringMatch _ x) = x
 getStr _ = ""
+-}
 
 -- | Spec
 --
@@ -235,6 +237,8 @@ data SpecError = SpecENone String
   --                          circ = Just GroupIDField
 
 -- | parseSpec3 - Parse a key specification.
+--
+-- TODO: This is currently unused.
 parseSpec3 :: Maybe MatchingField -> String -> Either SpecError Spec
 parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) =
   tooBigError maybeExpecting =<< applyContext maybeExpecting . fixUpSubstrMatch <$>
@@ -283,7 +287,7 @@ parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) =
 
               adjustPos (SubstringMatch (Just KeyTypeField) _) Nothing = 0
               adjustPos (SubstringMatch (Just UserIDField)  _) Nothing = 1
-              adjustPos (SubstringMatch (Just GroupIDField) _) Nothing = 2
+              -- adjustPos (SubstringMatch (Just GroupIDField) _) Nothing = 2
               adjustPos _ (Just i) = fromEnum i
 
               gotIndex :: Int -> SingleKeySpec -> Int
@@ -296,7 +300,7 @@ parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) =
               mismatch xs = case find (not . fst)  (reverse xs) of
                                     Just (_,(SubstringMatch mbF s,n)) -> SpecEMissMatch s mbF (toEnum n)
 
-              fixUpSubstrMatch (g,u,t) = (set GroupIDField g, set UserIDField u, set KeyTypeField t)
+              fixUpSubstrMatch (g,u,t) = ({- set GroupIDField -} g, set UserIDField u, set KeyTypeField t)
                 where
                     set field (SubstringMatch Nothing xs) = SubstringMatch (Just field) xs
                     set _ EmptyMatch = AnyMatch
@@ -313,16 +317,17 @@ parseSpec3 maybeExpecting spec@(wordsBy '/' -> fields) =
               applyContext (Just UserIDField) ((AnyMatch,u,x)) = (AnyMatch,u,x)
               applyContext (Just UserIDField) x = x
 
-              applyContext (Just GroupIDField) ((AnyMatch,AnyMatch,x)) = (x,AnyMatch,AnyMatch)
-              applyContext (Just GroupIDField) ((AnyMatch,u,x)) = (u,AnyMatch,x)
-              applyContext (Just GroupIDField) x = x
+              -- applyContext (Just GroupIDField) ((AnyMatch,AnyMatch,x)) = (x,AnyMatch,AnyMatch)
+              -- applyContext (Just GroupIDField) ((AnyMatch,u,x)) = (u,AnyMatch,x)
+              -- applyContext (Just GroupIDField) x = x
 
               --applyContext (Just UserIDField) (Right (g,u,x)) = Left $
               --  SpecEMissMatch (getStr g) (Just GroupIDField) UserIDField
-              tooBigError _ s@(_,_,SubstringMatch (Just GroupIDField) str) = Left $
-                SpecEMissMatch str (Just GroupIDField) KeyTypeField
-              tooBigError _ s@(_,SubstringMatch (Just GroupIDField) str,_) = Left $
-                SpecEMissMatch str (Just GroupIDField) UserIDField
+
+              -- tooBigError _ s@(_,_,SubstringMatch (Just GroupIDField) str) = Left $
+              --   SpecEMissMatch str (Just GroupIDField) KeyTypeField
+              -- tooBigError _ s@(_,SubstringMatch (Just GroupIDField) str,_) = Left $
+              --   SpecEMissMatch str (Just GroupIDField) UserIDField
 
               tooBigError Nothing             x = return x
               tooBigError (Just UserIDField) s@(g,u,t) | g /= AnyMatch = Left $
@@ -382,10 +387,13 @@ parseSpec grip spec = (topspec,subspec)
 filterNewSubs :: FilePath -> (KeySpec,Maybe String) -> KeyData -> KeyData
 filterNewSubs fname spec (KeyData p sigs uids subs) = KeyData p sigs uids subs'
  where
-    matchAll = KeyGrip ""
+    matchAll = KeyFP 0 ""
+
+    subkeySpec (KeyFP ver grip,Nothing) = (matchAll, KeyFP ver grip)
+    subkeySpec (topspec,Just mtag)      = (topspec , KeyTag (packet p) mtag)
+    subkeySpec (KeyTag p tag, Nothing)  = (matchAll, KeyTag p tag)
+    subkeySpec (KeyUidMatch u, Nothing) = (KeyUidMatch u, matchAll)
 
-    subkeySpec (KeyGrip grip,Nothing) = (matchAll, KeyGrip grip)
-    subkeySpec (topspec,Just mtag)    = (topspec , KeyTag (packet p) mtag)
 
     match spec mps
                = not . null
@@ -420,13 +428,13 @@ selectPublicKeyAndSigs (spec,mtag) db =
  where
     topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd)
 
-    findbyspec (KeyGrip g) kd = do
+    findbyspec (KeyFP ver g) kd = do
         filter ismatch $
             topresult kd
             : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs))
                   (Map.elems $ keySubKeys kd)
       where
-        ismatch (p,sigs) = matchpr g p ==g
+        ismatch (p,sigs) = matchpr ver g p ==g
     findbyspec spec kd = if matchSpec spec kd then [topresult kd] else []
 
     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
                 workingKey grip use_db = listToMaybe $ do
                             fp <- maybeToList grip
                             elm <- keyData use_db
-                            guard $ matchSpec (KeyGrip fp) elm
+                            guard $ matchSpec (KeyFP 0 fp) elm
                             return $ keyPacket elm
 
 mkarmor :: Access -> L.ByteString -> [Armor]
@@ -921,6 +929,9 @@ writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do
             return [(fname, ExportedSubkey)]
      algo -> return [(fname, UnableToExport algo $ show $ fingerprint packet)]
 
+writeKeyToFile strm _ _ = error $ "writeKeyToFile: Unsupported file type: " ++ show (typ strm)
+
+
 writePEMKeys :: (PacketDecrypter)
                 -> KeyDB
                 -> [(FilePath,Maybe String,[MappedPacket],StreamInfo)]
@@ -942,6 +953,9 @@ writePEMKeys doDecrypt db exports = do
         pun <- doDecrypt p
         try pun $ \pun -> do
         return $ KikiSuccess (fname,stream,pun)
+    decryptKeys (_, _, []     , _) = error "writePEMKeys: Key missing from keyring."
+    decryptKeys (_, _, (_:_:_), _) = error "writePEMKeys: Ambiguous key."
+
 
 initializeMissingPEMFiles ::
     KeyRingOperation
@@ -956,8 +970,6 @@ initializeMissingPEMFiles ::
                                      , StreamInfo )])
                            , [(FilePath,KikiReportAction)]))
 initializeMissingPEMFiles operation ctx grip mwk transcode db = do
-        let decrypt = transcode (Unencrypted,S2K 100 "")
-
         -- nonexistants - files missing from disk.
         nonexistents <-
            filterM (fmap not . doesFileExist . fst)
@@ -1197,5 +1209,6 @@ getHomeDir protohome = do
             \(forgive,fname) -> parseOptionFile fname
         let config = map (topair . words) args
                         where topair (x:xs) = (x,xs)
+                              topair _ = error "parseOptionFile yeilded an empty entry?"
         return $ lookup "default-key" config >>= listToMaybe
 
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
 import           Data.Maybe
 import           Data.OpenPGP
 import           Data.OpenPGP.Util          (GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify)
+import           GHC.Stack
 
 
 import           Data.Time.Clock            (UTCTime)
@@ -171,7 +172,7 @@ buildKeyDB ctx grip0 keyring = do
             trans f (info,ps) = do
                 let manip = combineTransforms (transforms info)
                     rt1 = rt0 { rtKeyDB = merge emptyKeyDB f ps }
-                    acc = Just Sec /= Map.lookup f accs
+                    -- acc = Just Sec /= Map.lookup f accs
                 r <- performManipulations doDecrypt rt1 mwk manip
                 try r $ \(rt2,report) -> do
                 return $ KikiSuccess (report,rtKeyDB rt2)
@@ -390,6 +391,7 @@ doImportG transcode db m0 tags fname key = do
                                                  , rrs )
     -}
     let go (Just kd@(KeyData top topsigs uids subs)) = insertSubkey transcode kk kd tags fname key
+        go Nothing = pure NoWorkingKey
     transmuteAt go kk db
 
 
@@ -413,27 +415,27 @@ parseSpec wkgrip spec =
     if not slashed
         then
             case prespec of
-                AnyMatch                               -> (KeyGrip "", Nothing)
+                AnyMatch                               -> (KeyFP 0 "", Nothing)
                 EmptyMatch                             -> error "Bad key spec."
-                WorkingKeyMatch                        -> (KeyGrip wkgrip, Nothing)
-                SubstringMatch (Just KeyTypeField) tag -> (KeyGrip wkgrip, Just tag)
-                SubstringMatch Nothing str             -> (KeyGrip wkgrip, Just str)
+                WorkingKeyMatch                        -> (KeyFP 0 wkgrip, Nothing)
+                SubstringMatch (Just KeyTypeField) tag -> (KeyFP 0 wkgrip, Just tag)
+                SubstringMatch Nothing str             -> (KeyFP 0 wkgrip, Just str)
                 SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing)
-                FingerprintMatch fp                    -> (KeyGrip fp, Nothing)
+                FingerprintMatch ver fp                -> (KeyFP ver fp, Nothing)
         else
             case (prespec,postspec) of
-                (FingerprintMatch fp, SubstringMatch st t)
-                    | st /= Just UserIDField                -> (KeyGrip fp, Just t)
+                (FingerprintMatch ver fp, SubstringMatch st t)
+                    | st /= Just UserIDField                -> (KeyFP ver fp, Just t)
                 (SubstringMatch mt u, _)
                     | postspec `elem` [AnyMatch,EmptyMatch]
                       && mt /= Just KeyTypeField            -> (KeyUidMatch u, Nothing)
                 (SubstringMatch mt u, SubstringMatch st t)
                     | mt /= Just KeyTypeField
                       && st /= Just UserIDField             -> (KeyUidMatch u, Just t)
-                (FingerprintMatch _,FingerprintMatch _) -> error "todo: support fp:/fp: spec"
-                (_,FingerprintMatch fp)                 -> error "todo: support /fp: spec"
-                (FingerprintMatch fp,_)                 -> error "todo: support fp:/ spec"
-                _                                       -> error "Bad key spec."
+                (FingerprintMatch _ _,FingerprintMatch _ _) -> error "todo: support fp:/fp: spec"
+                (_,FingerprintMatch _ fp)                   -> error "todo: support /fp: spec"
+                (FingerprintMatch _ fp,_)                   -> error "todo: support fp:/ spec"
+                _                                           -> error "Bad key spec."
  where
     (preslash,slashon) = break (=='/') spec
     slashed = not $ null $ take 1 slashon
@@ -522,6 +524,7 @@ generateInternals transcode mwk db gens = do
             transmuteAt (go kk) kk db
         where
          go kk (Just kd0) = foldM (generateSubkey transcode) (KikiSuccess (kd0,[])) gens
+         go kk Nothing    = error "generateInternals: Key not found."
 
 mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext
      -> IO
@@ -588,7 +591,7 @@ readInputFileL ctx inp = do
     hs <- mapM (`openFile` ReadMode) fname
     fmap L.concat $ mapM (hGetContentsN oneMeg) hs
 
-getInputFileTime :: InputFileContext -> InputFile -> IO CTime
+getInputFileTime :: HasCallStack => InputFileContext -> InputFile -> IO CTime
 getInputFileTime ctx (Pipe fdr fdw) = do
     mt <- handleIO_ (return Nothing) $ Just <$> modificationTime <$> getFdStatus fdr
     maybe tryw return mt
@@ -602,6 +605,8 @@ getInputFileTime ctx (FileDesc fd) = do
 getInputFileTime ctx (resolveInputFile ctx -> [fname]) = do
     handleIO_ (error $ fname++": modificaiton time?") $
                     modificationTime <$> getFileStatus fname
+getInputFileTime ctx arg = error $ "getInputFileTime: Invalid argument: " ++ show arg
+
 
 slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString])
 slurpWIPKeys stamp "" = ([],[])
@@ -763,14 +768,15 @@ parseSingleSpec "-"              = WorkingKeyMatch
 parseSingleSpec ""               = EmptyMatch
 parseSingleSpec ('t':':':tag)    = SubstringMatch (Just KeyTypeField) tag
 parseSingleSpec ('u':':':tag)    = SubstringMatch (Just UserIDField) tag
-parseSingleSpec ('c':':':tag)    = SubstringMatch (Just GroupIDField) tag
-parseSingleSpec ('f':'p':':':fp) = FingerprintMatch fp
+-- parseSingleSpec ('c':':':tag)    = SubstringMatch (Just GroupIDField) tag
+parseSingleSpec ('f':'p':':':fp) = FingerprintMatch 0 fp
 parseSingleSpec str
-    | is40digitHex str = FingerprintMatch str
-    | otherwise        = SubstringMatch Nothing str
+    | Just 40 <- isHexDigits str = FingerprintMatch 4 str
+    | Just 64 <- isHexDigits str = FingerprintMatch 5 str
+    | otherwise                  = SubstringMatch Nothing str
 
-is40digitHex :: [Char] -> Bool
-is40digitHex xs = ys == xs && length ys==40
+isHexDigits :: [Char] -> Maybe Int
+isHexDigits xs = guard (ys == xs) >> Just (length ys)
       where
         ys = filter ishex xs
         ishex c | '0' <= c && c <= '9' = True
@@ -779,9 +785,9 @@ is40digitHex xs = ys == xs && length ys==40
         ishex c = False
 
 matchSpec :: KeySpec -> KeyData -> Bool
-matchSpec (KeyGrip grip) (KeyData p _ _ _)
-    | matchpr grip (packet p)==grip = True
-    | otherwise                     = False
+matchSpec (KeyFP ver grip) (KeyData p _ _ _)
+    = let mg = matchpr ver grip (packet p)
+        in mg == grip
 
 matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
  where
@@ -791,7 +797,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
                 && has_issuer key p
     has_issuer key p = isJust $ do
         issuer <- signature_issuer p
-        guard $ matchpr issuer key == issuer
+        guard $ matchpr 0 issuer key == issuer
     has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
                     || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
 
@@ -907,7 +913,7 @@ getHostnames (KeyData topmp _ uids subs) = Hostnames addr onames othernames Noth
 
 hasFingerDress :: KeyDB -> SockAddr -> Bool
 hasFingerDress db addr | socketFamily addr/=AF_INET6 = False
-hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyGrip g',Nothing) db)
+hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyFP 0 g',Nothing) db)
  where
     (pre,g) = splitAt 2 $ filter (/=':') $ Hosts.inet_ntop addr
     g' = map toUpper g
@@ -1012,6 +1018,7 @@ decode_btc_key timestamp str = do
                     ]
             , s2k_useage = 0
             , s2k = S2K 100 ""
+            , aead_algorithm = Nothing
             , symmetric_algorithm = Unencrypted
             , encrypted_data = ""
             , is_subkey = True
@@ -1205,6 +1212,7 @@ readSecretDNSFile fname = do
                             _ -> RSA
     case alg of
         RSA -> return $ rsaToPGP stamp $ fromJust $ extractRSAKeyFields kvs
+        _ -> return $ error $ "readSecretDNSFile: " ++ show alg ++ " unimplemented."
 
 spemPacket :: SecretPEMData -> Maybe Packet
 spemPacket (PEMPacket p) = Just p
@@ -1310,6 +1318,7 @@ rsaToPGP stamp rsa = SecretKeyPacket
                 -- , ecc_curve = def
                 , s2k_useage = 0
                 , s2k = S2K 100 ""
+                , aead_algorithm = Nothing
                 , symmetric_algorithm = Unencrypted
                 , encrypted_data = ""
                 , 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)
 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)
 
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
                     , content = bs
                     }
             hash = SHA512
-            matchkey fp mp = matchpr fp (packet mp) == fp
         case smallprGrip keyid of
             Nothing -> hPutStrLn stderr "Bad keygrip."
             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 @@
 {-# LANGUAGE PatternGuards #-}
 module PacketTranscoder where
 
-import Debug.Trace
-import GHC.Stack
 import Control.Monad
 import Data.IORef
 import Data.List
@@ -16,12 +14,10 @@ import qualified Data.ByteString       as S
 import qualified Data.ByteString.Char8 as S8
 import           Data.Map as Map (Map)
 import qualified Data.Map as Map
-import qualified Data.Traversable      as Traversable
 import System.IO              ( stderr)
 import System.Posix.IO        ( fdToHandle )
 import Text.Show.Pretty as PP ( ppShow )
 import KeyRing.Types
-import ControlMaybe (handleIO_)
 
 -- | Merge two representations of the same key, prefering secret version
 -- because they have more information.
@@ -113,7 +109,7 @@ interpretPassSpec ctx _ PassphraseSpec { passSpecPassFile = fd
         cachedContents (Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n")
                        ctx
                        fd
-    let matchkey fp mp = matchpr fp (packet mp) == fp
+    let matchkey fp mp = matchKeySpec fp (packet mp)
         matchfile file mp = Map.member file (locations mp)
         specializers = [ fmap matchkey keyspec, fmap matchfile inputfile]
         specialize alg mp =
@@ -142,6 +138,11 @@ interpretPassSpec ctx keys PassphraseAgent = do
 
     return $ KikiSuccess (cacheSearch, quit agent)
 
+interpretPassSpec ctx keys (PassphraseMemoizer _) =
+    -- INVALID ARGUMENT: PassphraseMemoizer
+    return BadPassphrase
+
+
 sendQuery :: GnuPGAgent -> (QueryMode,PassphraseResponse) -> OriginMapped Query -> IO PassphraseResponse
 sendQuery agent (ask,failure) qry = do
     mbpw <- getPassphrase agent ask (packet qry)
@@ -291,8 +292,8 @@ keyQueries grip ringPackets = (mwk, fmap makeQuery keys)
     mwk = listToMaybe $ do
             fp <- maybeToList grip
             let matchfp mp
-                 | not (is_subkey p) && matchpr fp p == fp = Just mp
-                 | otherwise                               = Nothing
+                 | not (is_subkey p) && matchpr 0 fp p == fp = Just mp
+                 | otherwise                                 = Nothing
                     where p = packet mp
             Map.elems $ Map.mapMaybe matchfp $ fmap (\(_,p,_) -> p) $ keys
 
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
             creationTime (SignatureCreationTimePacket t) = [t]
             creationTime _                               = []
 
+matchingGrip :: Packet -> String -> Bool
+matchingGrip topk g = matchpr 0 g topk == g
 
 -- | Given list of subpackets, a master key, one of its subkeys and a
 -- list of signatures on that subkey, yields:
@@ -177,9 +179,8 @@ findTag tag topk subkey subsigs = (xs',minsig,ys')
                           (sig, do
                                 sig <- Just (packet . fst $ sig)
                                 guard (isSignaturePacket sig)
-                                guard $ flip isSuffixOf
-                                             (show $ fingerprint topk)
-                                        . fromMaybe "%bad%" 
+                                guard $ matchingGrip topk
+                                        . fromMaybe "%bad%"
                                         . signature_issuer
                                         $ sig
                                 listToMaybe $
@@ -483,9 +484,7 @@ keyFlags0 wkun uidsigs = concat
                               , BZip2
                               , ZIP
                               ]
-    features = filterOr isfeatures subs $
-               FeaturesPacket { supports_mdc = True
-                              }
+    features = filterOr isfeatures subs defaultFeatures
 
     filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs