support for --import-if-authentic and --import

2 files changed, 73 insertions, 26 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 6fa97d5..d500c26 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -117,6 +117,7 @@ data KeyRingRuntime = KeyRingRuntime
                         { rtPubring :: FilePath
                         , rtSecring :: FilePath
                         , rtGrip :: Maybe String
+                        , rtWorkingKey :: Maybe Packet
                         , rtKeyDB :: KeyDB
                         }
 
@@ -124,11 +125,15 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
 
 data KeyRingData = KeyRingData
     { kFiles :: Map.Map InputFile (RefType,FileType)
-    , kImports :: Map.Map FilePath (KeyData -> Maybe Bool)
-    -- ^ Indicates what pgp packets get written to which keyring files.
+    , kImports :: Map.Map InputFile (KeyRingRuntime -> KeyData -> Maybe Bool)
+    -- ^ 
+    -- Indicates what pgp master keys get written to which keyring files.
     --   Just True  = import public key
     --   Just False = import secret key
     --   Nothing    = do not import
+    -- Note that subkeys will always be imported if their owner key is
+    -- already in the ring.
+    --   TODO: Even if their signatures are bad?
     , homeSpec :: Maybe String
     }
 
@@ -966,28 +971,57 @@ showPacket p | isKey p   = (if is_subkey p
 showPacket0 p = concat . take 1 $ words (show p)
 
 
-writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet
+importPublic = Just True
+importSecret = Just False
+subkeysOnly  = Nothing
+
+guardAuthentic :: KeyRingRuntime -> KeyData -> Maybe ()
+guardAuthentic rt keydata = guard (isauth rt keydata)
+
+isauth :: KeyRingRuntime -> KeyData -> Bool
+isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
+          where wk = workingKey (rtGrip rt) (rtKeyDB rt)
+                dont_have (KeyData p _ _ _) = not . Map.member (rtPubring rt)
+                                                   $ locations p
+                has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ Map.toList uids
+                 where
+                    goodsig (uidstr,(sigs,_)) = not . null $ do
+                        sig0 <- fmap (packet . fst) sigs
+                        pre_ov <- signatures (Message [packet k, UserIDPacket uidstr, sig0])
+                        signatures_over $ verify (Message [wk]) pre_ov
+
+                workingKey grip use_db = listToMaybe $ do
+                            fp <- maybeToList grip
+                            elm <- Map.toList use_db
+                            guard $ matchSpec (KeyGrip fp) elm
+                            return $ keyPacket (snd elm)
+
+writeRingKeys :: KeyRingData -> KeyRingRuntime
+                {-
+                ->  KeyDB -> Maybe Packet
                 -> FilePath -> FilePath
+                -}
                 -> IO (KikiCondition [(FilePath,KikiReportAction)])
-writeRingKeys krd db wk secring pubring = do
-    let ks = Map.elems db
-        isring (KeyRingFile {}) = True
+writeRingKeys krd rt {- db wk secring pubring -} = do
+    let isring (KeyRingFile {}) = True
         isring _                = False
-        fs = do
-            (f,(rtyp,ftyp)) <- Map.toList (kFiles krd)
-            guard (isring ftyp)
-            n <- resolveInputFile secring pubring f
-            return (n,isMutable rtyp)
-        fromfile f kd@(KeyData p _ _ _) =
-                   Map.member f $ locations p 
+        db = rtKeyDB rt
+        wk = rtWorkingKey rt
+        secring = rtSecring rt
+        pubring = rtPubring rt
     let s = do
-        (f,mutable) <- fs
+        (f,f0,mutable) <- do
+            (f0,(rtyp,ftyp)) <- Map.toList (kFiles krd)
+            guard (isring ftyp)
+            f <- resolveInputFile secring pubring f0
+            return (f,f0,isMutable rtyp)
         let x = do
                 let wanted kd@(KeyData p _ _ _)
-                        = maybe (fmap originallyPublic $ Map.lookup f $ locations p)
-                                (\pred -> pred kd)
-                                (Map.lookup f $ kImports krd)
-                d <- sortByHint f keyMappedPacket ks
+                        = mplus (fmap originallyPublic $ Map.lookup f $ locations p)
+                            $ do
+                                pred <- Map.lookup f0 $ kImports krd
+                                pred rt kd
+                d <- sortByHint f keyMappedPacket (Map.elems db)
                 only_public <- maybeToList $ wanted d
                 flattenTop f only_public d
             new_packets = filter isnew x
@@ -1244,23 +1278,25 @@ runKeyRing keyring = do
            return $ KikiSuccess (db, map (\((f,_,_,_),r)->(f,r)) rs
                                      ++ import_rs)
 
+        let rt = KeyRingRuntime
+                       { rtPubring = pubring
+                       , rtSecring = secring
+                       , rtGrip = grip
+                       , rtWorkingKey = wk
+                       , rtKeyDB = db
+                       }
+
         try' externals_ret $ \(db,report_externals) -> do
 
         r <- writeWalletKeys keyring db wk
         try' r $ \report_wallets -> do
 
-        r <- writeRingKeys keyring db wk secring pubring
+        r <- writeRingKeys keyring rt -- db wk secring pubring
         try' r $ \report_rings -> do
 
         r <- writePEMKeys (doDecrypt unkeysRef pws) db exports
         try' r $ \report_pems -> do
 
-        let rt = KeyRingRuntime
-                       { rtPubring = pubring
-                       , rtSecring = secring
-                       , rtGrip = grip
-                       , rtKeyDB = db
-                       }
         return $ KikiResult (KikiSuccess rt)
                    $ concat [ report_imports
                             , report_externals
@@ -2071,8 +2107,10 @@ syncWallet = todo
 usePassphraseFD :: Int -> Kiki ()
 usePassphraseFD = todo
 
+{-
 importAll :: Kiki ()
 importAll = todo
+-}
 
 importAllAuthentic :: Kiki ()
 importAllAuthentic = todo
diff --git a/kiki.hs b/kiki.hs
index b5509f8..7c89882 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1334,6 +1334,14 @@ main = do
                     wallets
         rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd)))
                     keyrings_
+        importStyle = maybe (\_ _ -> subkeysOnly)
+                            (\f rt kd -> f rt kd >> importPublic)
+                        $ mplus import_f importifauth_f
+            where
+                import_f = do Map.lookup "--import" margs
+                              return $ \rt kd -> Just ()
+                importifauth_f = do Map.lookup "--import-if-authentic" margs
+                                    return guardAuthentic
         kikiOp = KeyRingData
             { kFiles = Map.fromList $
                 [ ( HomeSec, (MutableRef Nothing, KeyRingFile passfd)  )
@@ -1342,7 +1350,8 @@ main = do
                 ++ rings
                 ++ pems
                 ++ walts
-            , kImports = Map.empty
+            , kImports = Map.fromList $
+                [ ( HomePub, importStyle ) ]
             , homeSpec = homespec
             }