Changed command line syntax.

1 files changed, 127 insertions, 18 deletions

diff --git a/kiki.hs b/kiki.hs
index d7a802b..7b35ec4 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -43,8 +43,8 @@ import System.Directory
 import System.Exit
 import ControlMaybe
 import Data.Char
-import Control.Arrow (second)
-import Data.Traversable hiding (mapM)
+import Control.Arrow (first,second)
+import Data.Traversable hiding (mapM,forM)
 import System.Console.CmdArgs
 -- import System.Posix.Time
 import Data.Time.Clock.POSIX
@@ -953,7 +953,6 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
     mergeSig :: Int -> (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust]
     mergeSig n sig sigs =
       let (xs,ys) = break (isSameSig sig) sigs
-          first f (x,y) = (f x,y)
       in if null ys
           then sigs++[first (asMapped n) sig]
           else let y:ys'=ys
@@ -1080,6 +1079,36 @@ writeOutKeyrings lkmap db = do
         -- warn $ "writing "++f
         L.writeFile f (encode m)
 
+cross_merge keyrings f = do
+        let relock = do
+                (fsns,failed_locks) <- lockFiles keyrings
+                forM_ failed_locks $ \f -> warn $ "Failed to lock: " ++ f
+                return (fsns,failed_locks)
+            sec_n:_ = keyrings
+        (fsns,failed_locks) <- relock
+        -- let (lks,fs) = unzip fsns
+        -- forM_ fs $ \f -> warn $ "locked: " ++ f
+        let readp n = fmap (n,) (readPacketsFromFile n)
+        let pass n (fsns,failed_locks) = do
+                ms <- mapM readp (map snd fsns++failed_locks)
+                let db = foldl' (uncurry . merge) Map.empty ms
+                    fstkey = listToMaybe $ mapMaybe isSecringKey ms 
+                              where isSecringKey (fn,Message ps)
+                                        | fn==sec_n = listToMaybe ps
+                                    isSecringKey _  = Nothing
+                unlockFiles fsns
+                db' <- f (sec_n,fstkey) db
+                lk <- relock
+                maybe (if n==0 then pass 1 lk else return (lk,db))
+                      (return . (lk,))
+                      db'
+        ((fsns,failed_locks),db) <- pass 0 (fsns,failed_locks)
+        let lkmap = Map.fromList (map swap fsns)
+        writeOutKeyrings lkmap db
+        unlockFiles fsns
+        return ()
+
+
 data Arguments =
         Cross_Merge { homedir :: Maybe FilePath
                     , passphrase_fd :: Maybe Int
@@ -1087,10 +1116,33 @@ data Arguments =
                     }
   deriving (Show, Data, Typeable)
 
+toLast f []  = []
+toLast f [x] = [f x]
+toLast f (x:xs) = x : toLast f xs
 
+partitionStaticArguments specs args = psa args
+ where
+    smap = Map.fromList specs
+    psa [] = ([],[])
+    psa (a:as) = 
+      case Map.lookup a smap of
+        Nothing -> second (a:) $ psa as
+        Just n  -> first ((a:take n as):) $ psa (drop n as)
+
+show_wk secring_file grip db = do
+    let sec_db = Map.filter gripmatch db
+        gripmatch (KeyData p _ _ _) = 
+            Map.member secring_file (locations p)
+        Message sec = flattenKeys False sec_db
+    putStrLn $ listKeysFiltered (maybeToList grip) sec
+
+show_all db = do
+    let Message packets = flattenKeys True db
+    putStrLn $ listKeys packets
 
 main = do
     dotlock_init
+    {-
     args <- cmdArgs $ modes
         [ Cross_Merge HOMEOPTION
               (def &= opt ("passphrase"::String)
@@ -1103,6 +1155,72 @@ main = do
         &= program "kiki"
         &= summary "kiki - a pgp key editing utility"
     doCmd args
+    -}
+    args_raw <- getArgs
+    let (args,trail1) = break (=="--") args_raw
+        trail = drop 1 trail1
+        (sargs,margs) = 
+                (sargs, foldl' (\m (k:xs)->Map.alter (appendArgs xs) k m)
+                               Map.empty
+                               gargs)
+                    where (sargs,vargs) = partitionStaticArguments
+                                            [ ("--homedir",1)
+                                            , ("--passphrase-fd",1)
+                                            , ("--import",0)
+                                            , ("--autosign",0)
+                                            , ("--show-wk",0)
+                                            , ("--show-all",0)
+                                            ]
+                                            args
+                          args' = if map (take 1) (take 1 vargs) == ["-"]
+                                    then vargs
+                                    else "--keyrings":vargs
+                          gargs = (sargs ++)
+                                  . toLast (++trail) 
+                                  . groupBy (\_ s-> take 1 s /= "-")
+                                  $ args'
+                          appendArgs xs = Just . maybe xs (++xs)
+    -- putStrLn $ "margs = " ++ show (Map.assocs margs)
+    let keypairs =
+            flip map (maybe [] id $ Map.lookup "--keypairs" margs) $ \specfile -> do
+                let (spec,efilecmd) = break (=='=') specfile
+                guard $ take 1 efilecmd=="="
+                let filecmd = drop 1 efilecmd
+                let (file,bcmdb0) = break (=='{') filecmd
+                    bcmdb = if null bcmdb0 then "{}" else bcmdb0
+                guard $ take 1 bcmdb=="{"
+                let bdmcb = (dropWhile isSpace . reverse) bcmdb
+                guard $ take 1 bdmcb == "}"
+                let cmd = (drop 1 . reverse . drop 1) bdmcb
+                Just (spec,file,cmd)
+        publics =
+            flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do
+                let (spec,efile) = break (=='=') specfile
+                guard $ take 1 efile=="="
+                let file= drop 1 efile
+                Just (spec,file)
+        keyrings_ = maybe [] id $ Map.lookup "--keyrings" margs
+        passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs
+
+    (homedir,secring,pubring,grip0) <- getHomeDir ( concat <$> Map.lookup "--homedir" margs)
+
+    let keyrings = secring:pubring:keyrings_
+
+    {-
+    putStrLn $ "keypairs = "++show keypairs
+    putStrLn $ "publics  = "++show publics
+    putStrLn $ "keyrings = "++show keyrings
+    -}
+
+    cross_merge keyrings $ \(secfile,fstkey) db -> do
+        let grip = grip0 `mplus` (fingerprint <$> fstkey)
+        let shspec = Map.fromList [("--show-wk", show_wk secfile grip)
+                                  ,("--show-all",show_all    )]
+            shargs = mapMaybe (\x -> listToMaybe x >>= \x ->Map.lookup x shspec) sargs
+        forM_ shargs $ \cmd -> cmd db
+        return . Just $ db
+
+    return()
  where
     envhomedir opt = do
         gnupghome <- lookupEnv homevar >>=
@@ -1117,8 +1235,8 @@ main = do
     appdir  = ".gnupg"
     optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
 
-    getHomeDir cmd = do
-        homedir <- envhomedir (homedir cmd)
+    getHomeDir protohome = do
+        homedir <- envhomedir protohome
         flip (maybe (error "Could not determine home directory."))
              homedir $ \homedir -> do
         -- putStrLn $ "homedir = " ++show homedir
@@ -1128,6 +1246,7 @@ main = do
         workingkey <- getWorkingKey homedir
         return (homedir,secring,pubring,workingkey)
 
+    -- TODO: rename this to getGrip
     getWorkingKey homedir = do
         let o = Nothing
             h = Just homedir
@@ -1145,7 +1264,7 @@ main = do
         return $ lookup "default-key" config >>= listToMaybe
 
     getPGPEnviron cmd = do
-        (homedir,secring,pubring,grip) <- getHomeDir cmd
+        (homedir,secring,pubring,grip) <- getHomeDir (homedir cmd)
         (Message sec) <- readPacketsFromFile secring
         let (keys,_) = partition (\k -> case k of
                                    { SecretKeyPacket {} -> True
@@ -1337,19 +1456,9 @@ main = do
     -}
 
     doCmd cmd@(Cross_Merge {}) = do
-        (homedir,secring,pubring,grip0) <- getHomeDir cmd
+        (homedir,secring,pubring,grip0) <- getHomeDir (homedir cmd)
         -- grip0 may be empty, in which case we should use the first key
-        (fsns,failed_locks) <- lockFiles (secring:pubring:files cmd)
-        forM_ failed_locks $ \f -> warn $ "Failed to lock: " ++ f
-        let (lks,fs) = unzip fsns
-        -- forM_ fs $ \f -> warn $ "locked: " ++ f
-        let readp n = fmap (n,) (readPacketsFromFile n)
-        ms <- mapM readp (fs++failed_locks)
-        let db = foldl' (uncurry . merge) Map.empty ms
-        let lkmap = Map.fromList (map swap fsns)
-        writeOutKeyrings lkmap db
-        unlockFiles fsns
-        return ()
+        cross_merge (secring:pubring:files cmd) $ \_ db -> return $ Just db
 
     {-
     doCmd cmd@(CatPub {}) = do