Preserve TrustPackets accross merges.

1 files changed, 72 insertions, 33 deletions

diff --git a/kiki.hs b/kiki.hs
index 034f58d..059fc50 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -227,6 +227,9 @@ isEmbeddedSignature _                            = False
 isCertificationSig (CertificationSignature {}) = True
 isCertificationSig _                           = True
 
+isTrust (TrustPacket {}) = True
+isTrust _                = False
+
 issuer (IssuerPacket issuer) = Just issuer
 issuer _                     = Nothing
 backsig (EmbeddedSignaturePacket s) = Just s
@@ -783,6 +786,9 @@ data Arguments =
                  { homedir :: Maybe FilePath
                  , files :: [FilePath]
                  }
+        | Merge { homedir :: Maybe FilePath
+                 , files :: [FilePath]
+                 }
         | DumpPackets { homedir :: Maybe FilePath
                       , marshal_test :: String
                       , files :: [FilePath] }
@@ -817,22 +823,31 @@ is40digitHex xs = ys == xs && length ys==40
     ishex c = False
 
 scanPackets [] = []
-scanPackets (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,MarkerPacket) p) ps
+scanPackets (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacket) p) ps
  where
-    doit (top,sub,_) p =
+    ret p = (p,Nothing,Nothing)
+    doit (top,sub,prev) p =
         case p of
-            _ | isKey p && not (is_subkey p) -> (p,MarkerPacket,p)
-            _ | isKey p && is_subkey p       -> (top,p,p)
-            _ | isUserID p                   -> (top,p,p)
-            _ | otherwise                    -> (top,sub,p)
+            _ | isKey p && not (is_subkey p) -> (p,MarkerPacket,ret p)
+            _ | isKey p && is_subkey p       -> (top,p,ret p)
+            _ | isUserID p                   -> (top,p,ret p)
+            _ | isTrust p                    -> (top,sub,updateTrust top sub prev p)
+            _ | otherwise                    -> (top,sub,ret p)
 
+    updateTrust top (PublicKeyPacket {}) (pre,a,b) p = (pre,a,Just p)
+    updateTrust (PublicKeyPacket {}) _   (pre,a,b) p = (pre,a,Just p)
+    updateTrust _                    _   (pre,a,b) p = (pre,Just p,b)
 
 
+type SigAndTrust = ( Packet
+                   , Maybe Packet  -- secret trust packet
+                   , Maybe Packet) -- public trust packet
+
 type KeyKey = [Char8.ByteString]
-data SubKey = SubKey Packet [Packet]
+data SubKey = SubKey Packet [SigAndTrust]
 data KeyData = KeyData Packet    -- main key
-                       [Packet]  -- sigs on main key
-                       (Map.Map String [Packet])  -- uids
+                       [SigAndTrust]  -- sigs on main key
+                       (Map.Map String [SigAndTrust])  -- uids
                        (Map.Map KeyKey SubKey)    -- subkeys
 
 type KeyDB = Map.Map KeyKey KeyData
@@ -866,8 +881,8 @@ merge :: Map.Map KeyKey KeyData -> Message -> Map.Map KeyKey KeyData
 merge db (Message ps) = foldl mergeit db qs
  where
     qs = scanPackets ps
-    mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets
-    mergeit db (top,sub,p) | isKey top = Map.alter update (keykey top) db
+    -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets
+    mergeit db (top,sub,ptt@(p,sectrust,pubtrust)) | isKey top = Map.alter update (keykey top) db
      where
         update v | isKey p && not (is_subkey p) 
           = case v of
@@ -879,18 +894,18 @@ merge db (Message ps) = foldl mergeit db qs
         update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
           = Just $ KeyData key sigs uids (Map.alter (mergeSubkey p) (keykey p) subkeys)
         update (Just (KeyData key sigs uids subkeys)) | isUserID p
-          = Just $ KeyData key sigs (Map.alter (mergeUid p) (uidkey p) uids) subkeys
+          = Just $ KeyData key sigs (Map.alter (mergeUid ptt) (uidkey p) uids) subkeys
         update (Just (KeyData key sigs uids subkeys))
           = case sub of
-             MarkerPacket    -> Just $ KeyData key (mergeSig p sigs) uids subkeys
+             MarkerPacket    -> Just $ KeyData key (mergeSig ptt sigs) uids subkeys
              UserIDPacket {} -> Just $ KeyData key 
                                                sigs 
-                                               (Map.alter (mergeUidSig p) (uidkey sub) uids)
+                                               (Map.alter (mergeUidSig ptt) (uidkey sub) uids)
                                                subkeys
              _  | isKey sub  -> Just $ KeyData key
                                                sigs
                                                uids
-                                               (Map.alter (mergeSubSig p) (keykey sub) subkeys)
+                                               (Map.alter (mergeSubSig ptt) (keykey sub) subkeys)
              _ -> error $ "Unexpected PGP packet 1: "++(words (show p) >>= take 1)
         update _ = error $ "Unexpected PGP packet 2: "++(words (show p) >>= take 1)
 
@@ -900,11 +915,11 @@ merge db (Message ps) = foldl mergeit db qs
     mergeSubkey p (Just (SubKey key sigs)) = Just $
         SubKey (minimumBy subcomp [key,p]) sigs
 
-    mergeUid (UserIDPacket s) Nothing     = Just []
-    mergeUid (UserIDPacket s) (Just sigs) = Just sigs
+    mergeUid (UserIDPacket s,_,_) Nothing     = Just []
+    mergeUid (UserIDPacket s,_,_) (Just sigs) = Just sigs
     mergeUid p _ = error $ "Unable to merge into UID record: " ++whatP p
 
-    whatP = concat . take 1 . words . show
+    whatP (a,_,_)  = concat . take 1 . words . show $ a
     
 
     mergeSig sig sigs = 
@@ -915,14 +930,16 @@ merge db (Message ps) = foldl mergeit db qs
                in xs ++ (mergeSameSig sig y : ys')
         
 
-    isSameSig a b | isSignaturePacket a && isSignaturePacket b = 
+    isSameSig (a,_,_) (b,_,_) | isSignaturePacket a && isSignaturePacket b = 
         a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] }
-    isSameSig a b = a==b
+    isSameSig (a,_,_) (b,_,_) = a==b
 
-    mergeSameSig a b | isSignaturePacket a && isSignaturePacket b = 
-        b { unhashed_subpackets =
-                foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a)
-          }
+    mergeSameSig (a,sa,pa) (b,sb,pb) | isSignaturePacket a && isSignaturePacket b = 
+       ( b { unhashed_subpackets =
+                foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) }
+        , sb `mplus` sa
+        , pb `mplus` pa )
+    
      where
         mergeItem ys x = if x `elem` ys then ys else ys++[x]
 
@@ -935,16 +952,23 @@ merge db (Message ps) = foldl mergeit db qs
     mergeSubSig sig Nothing = error $ 
         "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
 
-flattenKeys :: Map.Map KeyKey KeyData -> Message
-flattenKeys db = Message $ concatMap flattenTop (Map.assocs db)
+flattenKeys :: Bool -> Map.Map KeyKey KeyData -> Message
+flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db)
  where
     flattenTop (_,(KeyData key sigs uids subkeys)) =
-        key : ( concatMap flattenUid (Map.assocs uids) 
-                ++ concatMap flattenSub (Map.assocs subkeys))
+        unk key : ( concatMap flattenUid (Map.assocs uids) 
+                 ++ concatMap flattenSub (Map.assocs subkeys))
 
-    flattenUid (str,sigs) = UserIDPacket str : sigs
+    flattenUid (str,sigs) = UserIDPacket str : concatMap unsig sigs
 
-    flattenSub (_,SubKey key sigs) = key:sigs
+    flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs
+
+    unk k = if isPublic then secretToPublic k else k
+    unsig (sig,sectrust,pubtrust) = [sig]++maybeToList (if isPublic then pubtrust else sectrust)
+
+    prefilter = if isPublic then id else filter isSecret
+                 where isSecret (_,(KeyData (SecretKeyPacket {}) _ _ _)) = True
+                       isSecret _                                        = False
 
 {-
 merge db (Message ps) = scanl mergeit db qs
@@ -1008,7 +1032,10 @@ main = do
             &= help "Extract a public subkey to stdout."
         , MergeSecrets HOMEOPTION
               (def &= args &= typFile)
-            &= help "Merge multiple keyrings to stdout."
+            &= help "Merge multiple secret keyrings to stdout."
+        , Merge HOMEOPTION
+              (def &= args &= typFile)
+            &= help "Merge multiple keyrings to stdout.  Secrets are filtered."
         , DumpPackets HOMEOPTION
               (def &= opt ("n" ::String))
               (def &= args &= typFile)
@@ -1284,7 +1311,19 @@ main = do
         let db = merge Map.empty (Message sec)
         ms <- mapM readPacketsFromFile (files cmd)
         let db' = foldl' merge db ms
-            m = flattenKeys db'
+            m = flattenKeys False db'
+        L.putStr (encode m)
+        return ()
+
+    doCmd cmd@(Merge {}) = do
+        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
+          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
+          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
+          ) <- getPGPEnviron cmd
+        let db = merge Map.empty (Message sec)
+        ms <- mapM readPacketsFromFile (files cmd)
+        let db' = foldl' merge db ms
+            m = flattenKeys True db'
         L.putStr (encode m)
         return ()
 
@@ -1309,7 +1348,7 @@ main = do
         ms <- mapM readPacketsFromFile files
         let db = merge Map.empty (Message sec)
             db' = foldl' merge db ms
-            m = flattenKeys db'
+            m = flattenKeys True db'
             Message allpkts = m
 
         let topspec = case () of