From 0319f5ac37d0d76ad7c0d7d37b9f66a46ee053c8 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 4 Dec 2013 17:24:04 -0500 Subject: Changed command line syntax. --- kiki.hs | 145 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file 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 -- cgit v1.2.3