From c29cc59e12c88b3d1b820091c1d124e17dc537e1 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Sat, 26 Apr 2014 15:58:28 -0400 Subject: refactoring parseSpec, and common args, ... --- kiki.hs | 210 +++++++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 147 insertions(+), 63 deletions(-) diff --git a/kiki.hs b/kiki.hs index 610dd5b..211b0a4 100644 --- a/kiki.hs +++ b/kiki.hs @@ -41,12 +41,69 @@ import DotLock import LengthPrefixedBE import KeyRing import Base58 -import qualified CryptoCoins +import qualified CryptoCoins import Data.OpenPGP.Util (verify,fingerprint) -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} +{- + - + - + accBindings :: forall t a a1 a2. + Bits t => + [(t, (Packet, Packet), [a], [a1], [a2])] + -> [(t, (Packet, Packet), [a], [a1], [a2])] + bitcoinAddress :: Word8 -> Packet -> String + cannonical_eckey :: forall b b1. + (Integral b1, Integral b) => + b -> b1 -> [Word8] + commands :: [(String, String)] + decode_sshrsa :: Char8.ByteString -> Maybe RSAPublicKey + disjoint_fp :: [Packet] -> [[Packet]] + doAutosign :: forall t. t -> KeyData -> [PacketUpdate] + fpmatch :: Maybe [Char] -> Packet -> Bool + getBindings :: [Packet] + -> ([([Packet], [SignatureOver])], + [(Word8, + (Packet, Packet), + [String], + [SignatureSubpacket], + [Packet])]) + isCertificationSig :: SignatureOver -> Bool + isSubkeySignature :: SignatureOver -> Bool + kiki :: forall a. + (Eq a, Data.String.IsString a) => + a -> [[Char]] -> IO () + kiki_sync_help :: IO () + listKeys :: [Packet] -> [Char] + listKeysFiltered :: [[Char]] -> [Packet] -> [Char] + :Main.main :: IO () + main :: IO () + partitionStaticArguments :: forall a. + Ord a => + [(a, Int)] -> [a] -> ([[a]], [a]) + readPublicKey :: Char8.ByteString -> RSAPublicKey + show_all :: KeyDB -> IO () + show_key :: forall t. + String -> t -> Map.Map KeyRing.KeyKey KeyData -> IO () + show_pem :: String -> String -> KeyDB -> IO () + show_ssh :: String -> String -> KeyDB -> IO () + show_whose_key :: Maybe RSAPublicKey -> KeyDB -> IO () + show_wip :: String -> String -> KeyDB -> IO () + show_wk :: FilePath + -> Maybe [Char] -> Map.Map KeyRing.KeyKey KeyData -> IO () + smallpr :: Packet -> [Char] + sshrsa :: Integer -> Integer -> Char8.ByteString + toLast :: forall x. (x -> x) -> [x] -> [x] + verifyBindings :: [Packet] + -> [Packet] -> ([SignatureOver], [SignatureOver]) + warn :: String -> IO () + whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] + - + - + -} + warn str = hPutStrLn stderr str sshrsa :: Integer -> Integer -> Char8.ByteString @@ -65,7 +122,7 @@ decode_sshrsa bs = do LengthPrefixedBE n <- get return $ RSAKey (MPI n) (MPI e) return rsakey - + isCertificationSig (CertificationSignature {}) = True isCertificationSig _ = True @@ -284,18 +341,19 @@ toLast f [] = [] toLast f [x] = [f x] toLast f (x:xs) = x : toLast f xs +-- partitionStaticArguments :: Ord a => [(a, Int)] -> [a] -> ([[a]], [a]) partitionStaticArguments specs args = psa args where smap = Map.fromList specs psa [] = ([],[]) - psa (a:as) = + 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 _ _ _) = + gripmatch (KeyData p _ _ _) = Map.member secring_file (locations p) Message sec = flattenKeys False sec_db putStrLn $ listKeysFiltered (maybeToList grip) sec @@ -304,7 +362,7 @@ show_all db = do let Message packets = flattenKeys True db putStrLn $ listKeys packets -show_whose_key input_key db = +show_whose_key input_key db = flip (maybe $ return ()) input_key $ \input_key -> do let ks = whoseKey input_key db case ks of @@ -327,7 +385,7 @@ show_pem keyspec wkgrip db = do show_ssh keyspec wkgrip db = do let s = parseSpec wkgrip keyspec - flip (maybe . void $ warn (keyspec ++ ": not found")) + flip (maybe . void $ warn (keyspec ++ ": not found")) (selectPublicKey s db) $ \k -> do let Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k @@ -337,7 +395,7 @@ show_ssh keyspec wkgrip db = do show_key keyspec wkgrip db = do let s = parseSpec "" keyspec - let ps = do + let ps = do (_,k) <- filterMatches (fst s) (Map.toList db) mp <- flattenTop "" True k return $ packet mp @@ -363,7 +421,7 @@ cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] pad32 xs = replicate zlen 0 ++ xs where zlen = 32 - length xs - + bitcoinAddress network_id k = address where @@ -379,7 +437,7 @@ whoseKey rsakey db = filter matchkey (Map.elems db) matchkey (KeyData k _ _ subs) = any (ismatch k) $ Map.elems subs - ismatch k (SubKey mp sigs) = + ismatch k (SubKey mp sigs) = Just rsakey == rsaKeyFromPacket (packet mp) && any (check (packet k) (packet mp)) sigs @@ -401,7 +459,7 @@ whoseKey rsakey db = filter matchkey (Map.elems db) -kiki_usage = putStr . unlines $ +kiki_sync_help = putStr . unlines $ {- ["kiki - a pgp key editing utility" ,"" @@ -463,14 +521,15 @@ kiki_usage = putStr . unlines $ ," format. Users incognisant of the fact that the public key (which" ," is also stored separately) is in this file, often think of it as" ," their secret key file." - ,"" + ,"" ," Each KEYSPEC specifies that a key should match the content and" ," timestamp of an external PKCS #1 private RSA key file." ," " ," KEYSPEC ::= SPEC=FILE{CMD} " ,"" ," The form of SPEC is documented below. If there is only one master" - ," key in your keyring and only one key is used for each purpose, then" ," it is possible for SPEC in this case to merely be a tag which offers" + ," key in your keyring and only one key is used for each purpose, then" + ," it is possible for SPEC in this case to merely be a tag which offers" ," information about what this key is used for, for example, any of" ," `tor', `ssh-client', `ssh-host', or `strongswan' will do." ,"" @@ -478,7 +537,7 @@ kiki_usage = putStr . unlines $ ," executed in order to create the FILE." ,"" - ,"Output:" +{- ,"Output:" ," --show-wk Show fingerprints for the working key (which will be used to" ," make signatures) and all its subkeys and UID." ,"" @@ -503,6 +562,7 @@ kiki_usage = putStr . unlines $ ,"" ," --help Shows this help screen." ,"" + -} ,"Specifying keys on the kiki command line:" ,"" ," SPEC ::= MASTER/SUBKEY" @@ -516,7 +576,7 @@ kiki_usage = putStr . unlines $ ,"" ," MASTER may be any of" ," * The tail end of a fingerprint prefixed by 'fp:'" - ," * A sub-string of a user id (without slashes) prefixed by 'u:'" + ," * A sub-string of a user id (without slashes) prefixed by 'u:'" ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" ,"" @@ -570,63 +630,76 @@ doAutosign rt kd@(KeyData k ksigs umap submap) = ops = fingerprint_material a==fingerprint_material b gs = groupBy sameMaster (sortBy (comparing code) bindings') - -kiki "sync" args_raw = do - let (args,trail1) = break (=="--") args_raw +processArgs sargspec polyVariadicArgs defaultPoly args_raw = (sargs,margs) + where + (args,trail1) = break (=="--") args_raw trail = drop 1 trail1 - (sargs,margs) = + commonArgSpec = [ ("--homedir",1) + , ("--passphrase-fd",1) + ] + (sargs,margs) = (sargs, foldl' (\m (k:xs)->Map.alter (appendArgs k xs) k m) Map.empty gargs) - where (sargs,vargs) = partitionStaticArguments sargspec args - sargspec = [ ("--homedir",1) - , ("--passphrase-fd",1) - , ("--import",0) - , ("--autosign",0) - , ("--import-if-authentic",0) - , ("--show-wk",0) - , ("--show-all",0) - , ("--show-whose-key",0) - , ("--show-key",1) - , ("--show-pem",1) - , ("--show-ssh",1) - , ("--show-wip",1) - , ("--help",0) - ] - argspec = map fst sargspec ++ ["--keyrings" - ,"--keypairs" - ,"--wallets" - ,"--hosts"] - -- "--bitcoin-keypairs" - -- Disabled. We shouldn't accept private key - -- data on the command line. + where (sargs,vargs) = partitionStaticArguments (commonArgSpec ++ sargspec) args + argspec = map fst sargspec ++ polyVariadicArgs args' = if map (take 1) (take 1 vargs) == ["-"] then vargs - else "--keyrings":vargs + else defaultPoly:vargs + -- grouped args gargs = (sargs ++) - . toLast (++trail) + . toLast (++trail) . groupBy (\_ s-> take 1 s /= "-") $ args' - appendArgs k xs opt = + appendArgs k xs opt = if k `elem` argspec then Just . maybe xs (++xs) $ opt else error . unlines $ [ "unrecognized option "++k , "Use --help for usage." ] + +data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } + +parseCommonArgs margs = CommonArgsParsed { cap_homespec = homespec, cap_passfd = passfd } + where + passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs + homespec = join . take 1 <$> Map.lookup "--homedir" margs + passfd = fmap (FileDesc . read) passphrase_fd + +parseKeySpecs = map $ \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) + +--kiki :: (Eq a, Data.String.IsString a) => a -> [String] -> IO () +kiki "sync" args_raw = do + let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keyrings" args_raw + sargspec = [ ("--import",0) + , ("--autosign",0) + , ("--import-if-authentic",0) + , ("--show-wk",0) + {-, ("--show-all",0) + , ("--show-whose-key",0) + , ("--show-key",1) + , ("--show-pem",1) + , ("--show-ssh",1) + , ("--show-wip",1) -} + , ("--help",0) + ] + polyVariadicArgs = ["--keyrings" + ,"--keypairs" + ,"--wallets" + ,"--hosts"] -- putStrLn $ "margs = " ++ show (Map.assocs margs) unkeysRef <- newIORef Map.empty pwRef <- newIORef Nothing - let keypairs0 = - flip map (fromMaybe [] $ 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) + let keypairs0 = parseKeySpecs (fromMaybe [] $ Map.lookup "--keypairs" margs) keyrings_ = fromMaybe [] $ Map.lookup "--keyrings" margs wallets = fromMaybe [] $ Map.lookup "--wallets" margs passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs @@ -636,16 +709,16 @@ kiki "sync" args_raw = do exitFailure input_key <- maybe (return Nothing) - (const $ fmap (Just . readPublicKey) Char8.getContents) + (const $ fmap (Just . readPublicKey) Char8.getContents) $ Map.lookup "--show-whose-key" margs let keypairs = catMaybes keypairs0 homespec = join . take 1 <$> Map.lookup "--homedir" margs passfd = fmap (FileDesc . read) passphrase_fd - pems = flip map keypairs + pems = flip map keypairs $ \(usage,path,cmd) -> let cmd' = guard (not $ null cmd) >> return cmd - in (ArgFile path, (MutableRef cmd', PEMFile usage)) + in (ArgFile path, (MutableRef cmd', PEMFile usage)) walts = map (\fname -> (ArgFile fname, (MutableRef Nothing, WalletFile))) wallets rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) @@ -674,19 +747,19 @@ kiki "sync" args_raw = do , homeSpec = homespec } - KikiResult rt report <- runKeyRing kikiOp + KikiResult rt report <- runKeyRing kikiOp case rt of KikiSuccess rt -> do -- interpret --show-* commands. let grip = rtGrip rt let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip) - ,("--show-all",const show_all) + {-,("--show-all",const show_all) ,("--show-whose-key", const $ show_whose_key input_key) ,("--show-key",\[x] -> show_key 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) - ,("--help", \_ _ ->kiki_usage)] + ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)-} + ,("--help", \_ _ ->kiki_sync_help)] shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) @@ -698,18 +771,29 @@ kiki "sync" args_raw = do kiki "working-key" args = do kiki "sync" ["--show-wk"] -kiki "help" args = do +-- Generic help +kiki "help" [] = do putStrLn "Valid commands are:" let longest = maximum $ map (length . fst) commands pad cmd = take (longest+3) $ cmd ++ repeat ' ' forM commands $ \(cmd,help) -> do putStrLn $ " " ++ pad cmd ++ help + putStr . unlines $ ["" + ,"See 'kiki help ' for more information on a specific command." + ] return () +kiki "help" args = forM_ args $ \arg -> case lookup arg commands of + Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." + _ -> kiki arg ["--help"] + +kiki "show" args = return () + commands :: [(String,String)] commands = [ ( "help", "display usage information" ) , ( "sync", "update key files of various kinds by propogating information" ) + , ( "show", "display information from your keyrings") , ( "working-key", "show the current working master key and its subkeys" ) ] -- cgit v1.2.3