Progress toward writting out keyring files.

1 files changed, 62 insertions, 21 deletions

diff --git a/kiki.hs b/kiki.hs
index 99ca2a6..dd487da 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -243,8 +243,8 @@ backsig _                           = Nothing
 isSubkeySignature (SubkeySignature {}) = True
 isSubkeySignature _                    = False
 
-isMasterKey k@(PublicKeyPacket {}) = not $ is_subkey k
-isMasterKey _ = False
+isPublicMaster k@(PublicKeyPacket {}) = not $ is_subkey k
+isPublicMaster _ = False
 
 now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
 
@@ -829,6 +829,7 @@ data OriginFlags = OriginFlags {
         originallyPublic :: Bool,
         originalNum :: Int
     }
+    deriving Show
 origin :: Packet -> Int -> OriginFlags
 origin p n = OriginFlags ispub n
  where
@@ -970,6 +971,8 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
         , tb `Map.union` ta )
 
      where
+        -- TODO: when merging items, we should delete invalidated origins
+        -- from the orgin map.
         mergeItem ys x = if x `elem` ys then ys else ys++[x]
 
     mergeSameSig n a b = trace ("discarding dup "++show a) b
@@ -982,22 +985,8 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
         "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
 
 flattenKeys :: Bool -> KeyDB -> Message
-flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db)
+flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop isPublic . snd) (prefilter . Map.assocs $ db)
  where
-    flattenTop (_,(KeyData key sigs uids subkeys)) =
-        unk key : ( concatMap flattenUid (Map.assocs (fst uids))
-                 ++ concatMap flattenSub (Map.assocs subkeys))
-
-    flattenUid (str,sigs) = UserIDPacket str : concatMap unsig sigs
-
-    flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs
-
-    unk = (if isPublic then secretToPublic else id) . packet
-    unsig (sig,trustmap) = [packet sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap)
-      where
-        f "%secring" _ = not isPublic
-        f _          _ = isPublic
-
     prefilter = if isPublic then id else filter isSecret
                  where
                   isSecret (_,(KeyData
@@ -1007,7 +996,58 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs
                                   _)) = True
                   isSecret _          = False
 
-writeOutKeyrings db = return () -- TODO
+
+flattenTop :: Bool -> KeyData -> [MappedPacket]
+flattenTop ispub (KeyData key sigs uids subkeys) =
+    unk ispub key : ( concatMap (flattenUid ispub (snd uids)) (Map.assocs (fst uids))
+             ++ concatMap (flattenSub ispub) (Map.elems subkeys))
+
+flattenUid :: Bool -> OriginMap -> (String,[SigAndTrust]) -> [MappedPacket]
+flattenUid ispub om (str,sigs) = MappedPacket (UserIDPacket str) om : concatMap (unsig ispub) sigs
+
+flattenSub :: Bool -> SubKey -> [MappedPacket]
+flattenSub ispub (SubKey key sigs) = unk ispub key: concatMap (unsig ispub) sigs
+
+unk :: Bool -> MappedPacket -> MappedPacket
+unk isPublic = if isPublic then toPacket secretToPublic else id
+                where toPacket f (MappedPacket p m) = MappedPacket (f p) m
+unsig :: Bool -> SigAndTrust -> [MappedPacket]
+unsig isPublic (sig,trustmap) = [sig]++ map (flip MappedPacket Map.empty) ( take 1 . Map.elems $ Map.filterWithKey f trustmap)
+  where
+    f "%secring" _ = not isPublic
+    f _          _ = isPublic
+
+ifSecret (SecretKeyPacket {}) t f = t
+ifSecret _                    t f = f
+
+showPacket :: Packet -> String
+showPacket p | isKey p   = (if is_subkey p 
+                              then showPacket0 p
+                              else ifSecret p "----Secret-----" "----Public-----")
+                           ++ " "++ fingerprint p
+             | isUserID p = showPacket0 p ++ " " ++ show (uidkey p)
+             | otherwise = showPacket0 p
+showPacket0 p = concat . take 1 $ words (show p)
+
+writeOutKeyrings db = do
+    let ks = Map.elems db
+        fs = Map.keys (foldr unionfiles Map.empty ks)
+                where unionfiles (KeyData p _ _ _) m =
+                        Map.union m (locations p)
+        fromfile f (KeyData p _ _ _) = Map.member f $ locations p
+    let s = do
+        f <- fs
+        let x = do
+                d@(KeyData p _ _ _) <- filter (fromfile f) ks
+                n <- maybeToList $ Map.lookup f (locations p)
+                flattenTop (originallyPublic n) d
+            changes = filter notnew x
+                where notnew p = isNothing (Map.lookup f $ locations p)
+        unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++
+                  ( "CHANGES: " : map (("  "++) . showPacket . packet) changes)
+    putStrLn s
+    -- putStrLn $ "fs = " ++ show fs 
+    return () -- TODO
 
 data Arguments =
         Cross_Merge { homedir :: Maybe FilePath
@@ -1091,7 +1131,7 @@ main = do
 
     uidScan pub = scanl (\(mkey,u) w ->
                              case () of
-                              _ | isMasterKey w -> (w,u)
+                              _ | isPublicMaster w -> (w,u)
                               _ | isUserID w -> (mkey,w)
                               _ | otherwise  -> (mkey,u)
                             )
@@ -1222,7 +1262,7 @@ main = do
             cleanup (_,(topkey,_,pkt)) = (topkey,pkt)
         putStrLn $ "-------- signed ------> " -- ++ show (length pub, length pub')
         putStrLn ""
-        putStrLn $ listKeysFiltered (map fingerprint (filter isMasterKey pub'))  (sec++pub')
+        putStrLn $ listKeysFiltered (map fingerprint (filter isPublicMaster pub'))  (sec++pub')
 
         let signed_bs = encode (Message pub')
         L.writeFile (output cmd) signed_bs
@@ -1435,7 +1475,8 @@ existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_
                     putStrLn "Adding valid signature to existing key..."
                     newKey wkun wk [pk] tag pre uids (trail++prepk++remainder) output_file grip
             (sig,ov):vs -> do
-                -- TODO: update sig to contain usage@ = tag
+                -- sig exists.
+                -- update sig to contain usage@ = tag
                 let hs = filter (\p->isNotation p && notation_name p=="usage@") (hashed_subpackets sig)
                     ks = map notation_value hs
                     isNotation (NotationDataPacket {}) = True