From 21cb0d8df64e4fca45abdd39007059451a9528e0 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 2 Dec 2013 17:12:23 -0500 Subject: Work in progress toward cross-merge interface. --- kiki.hs | 203 +++++++++++++++++----------------------------------------------- 1 file changed, 52 insertions(+), 151 deletions(-) diff --git a/kiki.hs b/kiki.hs index c1e6aea..1ea014d 100644 --- a/kiki.hs +++ b/kiki.hs @@ -53,6 +53,11 @@ import System.Posix.Files import Data.Monoid ((<>)) -- import Data.X509 import qualified Data.Map as Map +import DotLock +import System.IO (hPutStrLn,stderr) + + +warn str = hPutStrLn stderr str unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) where p = break (==c) spec @@ -556,7 +561,21 @@ readPacketsFromFile fname = do Right (_,_,msg ) -> msg Left (_,_,_) -> Message [] -readPacketsFromFile' n = fmap (n,) (readPacketsFromFile n) +lockFiles fs = do + let dolock f = do + lk <- dotlock_create f 0 + let fail = return Nothing + dotake lk = do + e <- dotlock_take lk (-1) + if e==0 then return (Just lk) + else fail + v <- maybe fail dotake lk + return (v,f) + ls <- mapM dolock fs + let (lks, fails) = partition (isJust . fst) ls + return (map (\(lk,f)->(fromJust lk,f)) lks, map snd fails) + +unlockFiles lks = forM_ lks $ \lk -> dotlock_release lk parseOptionFile fname = do xs <- fmap lines (readFile fname) @@ -765,41 +784,6 @@ readKeyFromFile False "PEM" fname = do } readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) -data Arguments = - List { homedir :: Maybe FilePath } - | WorkingKey { homedir :: Maybe FilePath } - | AutoSign { homedir :: Maybe FilePath - , passphrase_fd :: Maybe Int - , input :: FilePath - , output :: FilePath} - | Public { homedir :: Maybe FilePath - , output :: FilePath} - | Add { homedir :: Maybe FilePath - , passphrase_fd :: Maybe Int - , key_usage :: String - , seckey :: String - , output :: FilePath } - | PemFP { homedir :: Maybe FilePath - , seckey :: String } - | CatPub { homedir :: Maybe FilePath - , catpub_args :: [String] } - | MergeSecrets - { homedir :: Maybe FilePath - , files :: [FilePath] - } - | Merge { homedir :: Maybe FilePath - , files :: [FilePath] - } - | DumpPackets { homedir :: Maybe FilePath - , marshal_test :: String - , files :: [FilePath] } - {- - | Decrypt { homedir :: Maybe FilePath - , passphrase_fd :: Maybe Int - , output :: FilePath } - -} - deriving (Show, Data, Typeable) - getPassphrase cmd = case passphrase_fd cmd of Just fd -> do pwh <- fdToHandle (toEnum fd) @@ -972,96 +956,27 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs where isSecret (_,(KeyData (SecretKeyPacket {}) _ _ _)) = True isSecret _ = False -{- -merge db (Message ps) = scanl mergeit db qs - where - qs = scanPackets ps - mergeit db (top,sub,p) = todo - where - k = keykey top - v = maybe (merge1 (newrec top)) (merge2 sub p) $ Map.lookup k db - - keykey key = fingerprint_material key -- TODO: smaller key? +writeOutKeyrings db = return () -- TODO - newrec key | isKey key && not (is_subkey key) = - KeyData key [] Map.empty Map.empty - newrec _ = error "Unexpected packet." +data Arguments = + Cross_Merge { homedir :: Maybe FilePath + , passphrase_fd :: Maybe Int + , files :: [FilePath] + } + deriving (Show, Data, Typeable) - merge1 rec db = Map.insert k rec db - merge2 sub p (KeyData mk sigs uids subkeys) - | isKey sub = - maybe todo todo $ Map.lookup skey subkeys - where - skey = keykey sub --} main = do + dotlock_init args <- cmdArgs $ modes - [ List HOMEOPTION - &= help "List key pairs in the secret keyring." - &= auto - , WorkingKey HOMEOPTION - &= help "Shows the current working key set that will be used to make signatures." - , Public HOMEOPTION - (def &= argPos 1 &= typFile ) - &= help "Extract public keys into the given file." - , AutoSign HOMEOPTION - (def &= opt ("passphrase"::String) - &= typ "FD" - &= (help . concat) ["file descriptor from " - ,"which to read passphrase"]) - (def &= argPos 1 &= typFile ) - (def &=argPos 2 &= typFile) - &= (help . concat) - [ "Copies the first file to the second while adding" - , " signatures for tor-style uids that match" - , " cross-certified keys." ] - {- - , Decrypt HOMEOPTION + [ Cross_Merge HOMEOPTION (def &= opt ("passphrase"::String) - &= typ "FD" - &= (help . concat) ["file descriptor from " - ,"which to read passphrase"]) - (def &= argPos 1 &= typFile ) - -- (def &= argPos 3 &= typ "PUBLIC-KEY") - &= (help . concat) - [ "Remove password protection from the working keyring" - , " and save the result into the given file."] - -} - , CatPub HOMEOPTION - (def &= args &= typ "KEYSPEC FILES") - &= help "Extract a public subkey to stdout." - , MergeSecrets HOMEOPTION + &= typ "FD" + &= (help . concat) ["file descriptor from " + ,"which to read passphrase"]) (def &= args &= typFile) &= 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) - &= help "Output secret ring packets in ascii format for debugging." - , Add HOMEOPTION - (def &= opt ("passphrase"::String) - &= typ "FD" - &= (help . concat) ["file descriptor from " - ,"which to read passphrase"]) - (def &= argPos 1 &= typ "USAGE") - (def &= argPos 2 &= typ "PRIVATE-KEY") - (def &= argPos 3 &= typFile) - -- (def &= argPos 3 &= typ "PUBLIC-KEY") - &= (help . concat) - [ "Add a subkey." - , " USAGE is the usage@ annotation of the subkey." - , " Keys are specified as FMT:FILE where" - , " FMT may be one of following: PEM." - , " Results are written to the given file." ] - - , PemFP HOMEOPTION - (def &= argPos 1 &= typFile ) - &= (help . concat) - [ "Display the fingerprint of a PEM key pair."] ] &= program "kiki" &= summary "kiki - a pgp key editing utility" @@ -1086,9 +1001,10 @@ main = do homedir $ \homedir -> do -- putStrLn $ "homedir = " ++show homedir let secring = homedir ++ "/" ++ "secring.gpg" + pubring = homedir ++ "/" ++ "pubring.gpg" -- putStrLn $ "secring = " ++ show secring workingkey <- getWorkingKey homedir - return (homedir,secring,workingkey) + return (homedir,secring,pubring,workingkey) getWorkingKey homedir = do let o = Nothing @@ -1107,7 +1023,7 @@ main = do return $ lookup "default-key" config >>= listToMaybe getPGPEnviron cmd = do - (homedir,secring,grip) <- getHomeDir cmd + (homedir,secring,pubring,grip) <- getHomeDir cmd (Message sec) <- readPacketsFromFile secring let (keys,_) = partition (\k -> case k of { SecretKeyPacket {} -> True @@ -1192,6 +1108,7 @@ main = do ys = uid:sigs'++xs'' + {- doCmd cmd@(List {}) = do (homedir,secring,grip) <- getHomeDir cmd (Message sec) <- readPacketsFromFile secring @@ -1268,28 +1185,6 @@ main = do bs = encode (Message pub) L.writeFile (output cmd) bs - {- - doCmd cmd@(Decrypt {}) = do - ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome - , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg - , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" - ) <- getPGPEnviron cmd - pw <- getPassphrase cmd - - let sec' = map decrypt sec - decrypt k@(SecretKeyPacket {}) = k -- TODO - - L.writeFile (output cmd) (encode $ Message sec') - - {- - let wk = grip >>= find_key fingerprint (Message sec) - case wk of - Nothing -> error "No working key?" - Just wk -> do - putStrLn $ "wk = " ++ fingerprint wk - -} - -} - doCmd cmd@(DumpPackets {}) = do ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg @@ -1317,18 +1212,23 @@ main = do 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 "%secring" (Message sec) - ms <- mapM readPacketsFromFile' (files cmd) - let db' = foldl' (uncurry . merge) db ms - m = flattenKeys True db' - L.putStr (encode m) + -} + + doCmd cmd@(Cross_Merge {}) = do + (homedir,secring,pubring,grip0) <- getHomeDir 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 + let db = foldl' (uncurry . merge) Map.empty ms + writeOutKeyrings db + unlockFiles lks return () + {- doCmd cmd@(CatPub {}) = do let spec:files = catpub_args cmd let (topspec,subspec) = unprefix '/' spec @@ -1458,6 +1358,7 @@ main = do -- let torhash sub = maybe "" id $ derToBase32 <$> derRSA sub putStrLn $ fingerprint (head seckey) -- ++ " " ++ torhash (head seckey) + -} isSameKey a b = sort (key apub) == sort (key bpub) where -- cgit v1.2.3