1 files changed, 30 insertions, 17 deletions

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