Merge branch 'master' of ssh://localhost/~joe/repo/kiki

3 files changed, 49 insertions, 10 deletions

diff --git a/HACKING b/HACKING
new file mode 100644
index 0000000..b61c9f5
--- /dev/null
+++ b/HACKING
@@ -0,0 +1,27 @@
+
+This file is used to document items of interest to developers wishing to become
+contributers to the kiki project.
+
+=== Dependencies Policy ===
+* The current approach in terms of library dependencies is as follows:
+
+        1) It should work with libraries bundled with Debian on both
+        Debian Wheezy and Debian Jessie.
+
+        2) Development occurs on Jessie first, and then the build is
+        backported to Wheezy.
+
+        3) When backporting, it is preferred to use libraries available
+        in Wheezy unless the effort would be too great and then it is
+        prefered to use dependency versions that are already packaged for
+        Jessie.
+
+        4) Exceptions can be made for must-have features in libraries
+        not packaged for Jessie.  In which case, it is prefered to use
+        a version packaged for Sid, and if not available in Sid,
+        Experimental, and if not Experimental, then whatever is currently
+        available through cabal/hackage.  And finally as a last resort,
+        whatever is available via git.
+
+* This approach keeps the code base fresh without limiting it's ease of install
+  and utility on existing systems.
diff --git a/KeyRing.hs b/KeyRing.hs
index c2e209c..c7ea5fb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -134,7 +134,7 @@ import System.FilePath ( takeDirectory )
 import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr)
 import Data.IORef
 import System.Posix.IO ( fdToHandle )
-import qualified Data.Traversable as Traversable ( mapM )
+import qualified Data.Traversable as Traversable
 import Data.Traversable ( sequenceA )
 #if ! MIN_VERSION_base(4,6,0)
 import GHC.Exts ( Down(..) )
@@ -204,7 +204,7 @@ data InputFile = HomeSec
                -- ^ Contents will be read from the first descriptor and updated
                -- content will be writen to the second. Note: Don't use Pipe
                -- for 'Wallet' files. (TODO: Wallet support)
- deriving (Eq,Ord)
+ deriving (Eq,Ord,Show)
 
 -- type UsageTag = String
 type Initializer = String
@@ -1199,6 +1199,9 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do
         return $ map (first $ resolveForReport $ Just ctx) rs
     return $ concat rss
 
+isSecretKey :: Packet -> Bool
+isSecretKey (SecretKeyPacket {}) = True
+isSecretKey _                    = False
 
 buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation
               -> IO (KikiCondition ((KeyDB
@@ -1238,7 +1241,11 @@ buildKeyDB ctx grip0 keyring = do
 
     -- KeyRings (todo: KikiCondition reporting?)
     (spilled,mwk,grip,accs,keys,unspilled) <- do
+#if MIN_VERSION_containers(0,5,0)
         ringPackets <- Map.traverseWithKey readp ringMap
+#else
+        ringPackets <- Traversable.traverse (uncurry readp) $ Map.mapWithKey (,) ringMap
+#endif
         let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
 
         let grip = grip0 `mplus` (fingerprint <$> fstkey)
@@ -1250,8 +1257,7 @@ buildKeyDB ctx grip0 keyring = do
             keys :: Map.Map KeyKey MappedPacket
             keys = Map.foldl slurpkeys Map.empty
                         $ Map.mapWithKey filterSecrets ringPackets
-                    where isSecretKey (SecretKeyPacket {}) = True
-                          isSecretKey _                    = False
+                    where
                           filterSecrets f (_,Message ps) =
                             filter (isSecretKey . packet)
                                 $ zipWith (mappedPacketWithHint fname) ps [1..]
@@ -1284,7 +1290,11 @@ buildKeyDB ctx grip0 keyring = do
                 r <- performManipulations doDecrypt rt1 mwk manip
                 try r $ \(rt2,report) -> do
                 return $ KikiSuccess (report,(info,flattenKeys acc $ rtKeyDB rt2))
+#if MIN_VERSION_containers(0,5,0)
         in fmap sequenceA $ Map.traverseWithKey trans spilled
+#else
+        in fmap sequenceA $ Traversable.traverse (uncurry trans) $ Map.mapWithKey (,) spilled
+#endif
     try transformed0 $ \transformed -> do
     let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
                     where
@@ -1670,13 +1680,14 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do
                 d <- sortByHint f keyMappedPacket (Map.elems db')
                 acc <- maybeToList $ Map.lookup f0 (rtRingAccess rt)
                 only_public <- maybeToList $ wantedForFill acc (fill stream) d
+                guard $ only_public || isSecretKey (keyPacket d)
                 case fill stream of
                     KF_Match usage -> do grip <- maybeToList $ rtGrip rt
                                          flattenTop f only_public
                                             $ filterNewSubs f (parseSpec grip usage) d
                     _              -> flattenTop f only_public d
             new_packets = filter isnew x
-                where isnew p = isNothing (Map.lookup f $ locations p)
+                where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p)
         guard (not $ null new_packets)
         return ((f0,isMutable stream),(new_packets,x))
     let (towrites,report) = (\f -> foldl f ([],[]) s) $
@@ -2404,7 +2415,8 @@ readPacketsFromFile ctx fname = do
       case decodeOrFail input of
         Right (_,_,msg ) -> msg
         Left  (_,_,_)    ->
-        --trace (fname++": read fail") $
+          -- FIXME
+          -- trace (fname++": read fail") $
           Message []
 #else
     return $ decode input
diff --git a/kiki.hs b/kiki.hs
index 3bc291f..00e458f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -84,7 +84,7 @@ import Data.OpenPGP.Util (verify,fingerprint)
                                 [(a, Int)] -> [a] -> ([[a]], [a])
     readPublicKey :: Char8.ByteString -> RSAPublicKey
     show_all :: KeyDB -> IO ()
-    show_key :: forall t.
+    show_id :: forall t.
                 String -> t -> Map.Map KeyRing.KeyKey KeyData -> IO ()
     show_pem :: String -> String -> KeyDB -> IO ()
     show_ssh :: String -> String -> KeyDB -> IO ()
@@ -299,7 +299,7 @@ show_ssh keyspec wkgrip db = do
         blob = Base64.encode (L.unpack bs)
     putStrLn $ "ssh-rsa " ++ blob
 
-show_key keyspec wkgrip db = do
+show_id keyspec wkgrip db = do
     let s = parseSpec "" keyspec
     let ps = do
             (_,k) <- filterMatches (fst s) (Map.toList db)
@@ -750,7 +750,7 @@ sync bExport bImport bSecret cmdarg args_raw = do
             let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip)
                                       {-,("--show-all",const show_all)
                                       ,("--show-whose-key", const $ show_whose_key input_key)
-                                      ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip)
+                                      ,("--show-key",\[x] -> show_id x $ fromMaybe "" grip)
                                       ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip)
                                       ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip)
                                       ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)-}
@@ -859,7 +859,7 @@ kiki "show" args = do
             let shspec = Map.fromList [("--working", const $ show_wk (rtSecring rt) grip)
                                       ,("--all",const show_all)
                                       ,("--whose-key", const $ show_whose_key input_key)
-                                      ,("--key",\[x] -> show_key x $ fromMaybe "" grip)
+                                      ,("--key",\[x] -> show_id x $ fromMaybe "" grip)
                                       ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip)
                                       ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip)
                                       ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip)