1 files changed, 58 insertions, 32 deletions

diff --git a/kiki.hs b/kiki.hs
index dab3d2c..f265add 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1270,7 +1270,8 @@ sortByHint fname f = sortBy (comparing gethint)
     gethint = maybe defnum originalNum . Map.lookup fname . locations . f
     defnum = -1
 
-keyPacket (KeyData k _ _ _) = k
+keyMappedPacket (KeyData k _ _ _) = k
+keyPacket (KeyData k _ _ _) = packet k
 
 writeOutKeyrings :: Map.Map FilePath DotLock -> KeyDB -> IO ()
 writeOutKeyrings lkmap db = do
@@ -1282,7 +1283,7 @@ writeOutKeyrings lkmap db = do
     let s = do
         f <- fs
         let x = do
-                d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyPacket ks)
+                d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyMappedPacket ks)
                 n <- maybeToList $ Map.lookup f (locations p)
                 flattenTop f (originallyPublic n) d
             changes = filter isnew x
@@ -1333,8 +1334,7 @@ cross_merge doDecrypt grip0 keyrings wallets f = do
                             fp <- maybeToList grip
                             elm <- Map.toList db0
                             guard $ matchSpec (KeyGrip fp) elm
-                            let undata (KeyData p _ _ _) = packet p
-                            return $ undata (snd elm)
+                            return $ keyPacket (snd elm)
                 wms <- mapM (readw wk) (map snd wsns++failed_wlocks)
                 let -- db1= foldl' (uncurry . merge_) db0 wms
                     ts = do
@@ -2156,6 +2156,45 @@ whoseKey rsakey db = filter matchkey (Map.elems db)
         s2 <- signatures . Message $ [k,sub,subsig]
         signatures_over $ verify (Message [sub]) s2
 
+workingKey grip use_db = listToMaybe $ do
+                            fp <- maybeToList grip
+                            elm <- Map.toList use_db
+                            guard $ matchSpec (KeyGrip fp) elm
+                            return $ keyPacket (snd elm)
+
+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
+
+markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport
+ where wantToImport = mplus import_f importifauth_f
+             where
+                import_f = do Map.lookup "--import" margs 
+                              return dont_have
+                importifauth_f = do Map.lookup "--import-if-authentic" margs
+                                    return isauth
+                dont_have (KeyData p _ _ _) = not . Map.member pubring
+                                                   $ locations p
+                isauth keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
+                                  where wk = workingKey grip db
+       import_db dont_have = do
+                  forM_ to_alters $ \(_,KeyData c _ _ _) ->
+                    warn $ pubring ++ ": new "++showPacket (packet c)
+                  let db' = Map.union (Map.fromList altered)
+                                      db
+                  return db'
+              where
+                to_alters = filter (dont_have . snd) $ Map.toList db
+                altered = map (second append_loc) to_alters
+                append_loc (KeyData p a b c) = KeyData p' a b c
+                 where p' = p { locations = Map.insert pubring
+                                                       (origin (secretToPublic (packet p)) (-1))
+                                                       (locations p) 
+                              }
+
 kiki_usage = do
     putStr . unlines $
         ["kiki - a pgp key editing utility"
@@ -2188,6 +2227,11 @@ kiki_usage = do
         ,"     --import   Add master keys to pubring.gpg.  Without this option, only UID"
         ,"                and subkey data is updated. "
         ,""
+        ,"     --import-if-authentic"
+        ,"                Add signed master keys to pubring.gpg.  Like --import except that"
+        ,"                only keys with signatures from the working key (--show-wk) are"
+        ,"                imported."
+        ,""
         ,"     --autosign Sign all cross-certified tor-style UIDs."
         ,"                A tor-style UID is of the form:"
         ,"                        Anonymous <root@HOSTNAME.onion>"
@@ -2218,7 +2262,8 @@ kiki_usage = do
         ,"     --show-wk  Show fingerprints for the working key (which will be used to"
         ,"                make signatures) and all its subkeys and UID."
         ,""
-        ,"     --show-key Show fingerprints for the specified key and all its subkeys"
+        ,"     --show-key SPEC"
+        ,"                Show fingerprints for the specified key and all its subkeys"
         ,"                and UID."
         ,""
         ,"     --show-all Show fingerprints and UIDs and usage tags for all known keys."
@@ -2267,6 +2312,7 @@ main = do
                                      , ("--passphrase-fd",1)
                                      , ("--import",0)
                                      , ("--autosign",0)
+                                     , ("--import-if-authentic",0)
                                      , ("--show-wk",0)
                                      , ("--show-all",0)
                                      , ("--show-whose-key",0)
@@ -2377,25 +2423,8 @@ main = do
     -}
 
     cross_merge decrypt grip0 keyrings wallets $ \(secfile,grip) db -> do
-        let get_use_db = maybe (return db) import_db 
-                            $ Map.lookup "--import" margs
-            import_db _ = do
-                  forM_ to_alters $ \(_,KeyData c _ _ _) ->
-                    warn $ pubring ++ ": new "++showPacket (packet c)
-                  let db' = Map.union (Map.fromList altered)
-                                      db
-                  return db'
-              where
-                to_alters = filter (dont_have . snd) $ Map.toList db
-                altered = map (second append_loc) to_alters
-                append_loc (KeyData p a b c) = KeyData p' a b c
-                 where p' = p { locations = Map.insert pubring
-                                                       (origin (secretToPublic (packet p)) (-1))
-                                                       (locations p) 
-                              }
-                dont_have (KeyData p _ _ _) = not . Map.member pubring
-                                                   $ locations p
-        use_db0 <- get_use_db
+
+        use_db0 <- return db
 
         let pkeypairs = maybe [] id $ do
                             keygrip <- grip
@@ -2433,14 +2462,8 @@ main = do
             flip (maybe $ return use_db) 
                  (lookup "--autosign" $ map (\(x:xs)->(x,xs)) sargs)
                  $ \_ -> do
-                let keys = map undata $ Map.elems use_db
-                    wk = listToMaybe $ do
-                            fp <- maybeToList grip
-                            elm <- Map.toList use_db
-                            guard $ matchSpec (KeyGrip fp) elm
-                            return $ undata (snd elm)
-                            
-                    undata (KeyData p _ _ _) = packet p
+                let keys = map keyPacket $ Map.elems use_db
+                    wk = workingKey grip use_db
                 -- g <- newGenIO
                 -- stamp <- now
                 wkun <- flip (maybe $ return Nothing) wk $ \wk -> do
@@ -2448,6 +2471,9 @@ main = do
                             maybe (error $ "Bad passphrase?") (return . Just) wkun
                 -- return . snd $ Map.mapAccum (signTorIds stamp wkun keys) g use_db
                 Traversable.mapM (signTorIds wkun keys) use_db
+
+        use_db <- markForImport margs grip pubring use_db
+
         ret_db <- return $ fmap (const use_db) ret_db
             
         ret_db <- flip (maybe $ return ret_db) ret_db $ \db -> do