From d5716df5c935fb17c4d1c8f9dbe8b32e2e6b32dc Mon Sep 17 00:00:00 2001 From: James Crayne Date: Sun, 24 Apr 2016 01:04:49 -0400 Subject: Documentation fixes --- kiki.hs | 164 ++++++++++++++++++++++++++++++++++------------------------------ 1 file changed, 88 insertions(+), 76 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 8ee88c6..f939fa4 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternGuards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -366,7 +367,7 @@ show_wip keyspec wkgrip db = do putStrLn $ walletImportFormat nwb k show_torhash pubkey _ = do - bs <- Char8.readFile pubkey + bs <- Char8.readFile pubkey let parsekey f dta = do let mdta = L.pack <$> Base64.decode (Char8.unpack dta) e <- decodeASN1 DER <$> mdta @@ -402,7 +403,7 @@ show_cert keyspec wkgrip db = do pems = map (writePEM "CERTIFICATE") qqs forM_ pems putStrLn _ -> void $ warn (keyspec ++ ": ambiguous") - + {- show_cert certfile _ = do bs <- Char8.readFile certfile @@ -436,7 +437,7 @@ show_cert certfile _ = do putStrLn "" putStrLn $ maybe "" ((" gzip blob = " ++) . b64L . pcertBlob) e -} - -- ASN1 starts: + -- ASN1 starts: -- 1 2 3 4 5 6 7 8 -- cl....pc.tag.......... -- Start Sequence tag = 0x10 @@ -508,16 +509,12 @@ kiki_usage bExport bImport bSecret cmd = putStr $ "show" -> unlines $ ["kiki show [options...]" ,"" - ," show displays infomration about keys stored in the data files which resides in" + ," show displays information about keys stored in the data files which resides in" ," the home directory (see --homedir)." ,"" ," The files pubring.gpg and subring.gpg in the directory specified by the " ," --homedir option are implicitly included in the keyring set." ,"" - ," Subkeys that are imported with kiki are given an annotation \"usage@\" which" - ," indicates what the key is for. This tag can be used as a SPEC to select a" - ," particular key. Master keys may be specified by using fingerprints or by" - ," specifying a substring of an associated UID." ,"Options: " ] ++ commonOptions ++ [" --working" @@ -562,10 +559,10 @@ kiki_usage bExport bImport bSecret cmd = putStr $ ,"" ," --help Shows this help screen." ,"" - ] + ] "sync-secret" -> unlines $ ["kiki sync-secret [KEYSPEC ...]" - ,"kiki sync-secret FLAGS [--keypairs KEYSPEC ...] [--keyrings FILE ...] [--hosts FILE ...]" + ,"kiki sync-secret FLAGS [--pems KEYSPEC ...] [--keyrings FILE ...] [--hosts FILE ...]" ," [--wallets FILE ...]" ,"" ," sync-secret syncs the information inside your OpenGPG keyring with information" @@ -603,7 +600,7 @@ kiki_usage bExport bImport bSecret cmd = putStr $ ," are not included after the --keyrings option." ,"" ," If KEYSPEC arguments appear prior to any of --keyrings, --wallets, or --hosts," - ," then they are interpretted as if arguments to --keypairs." + ," then they are interpretted as if arguments to --pems." ,"" ] ++ syncflags ++ specifyingFiles "sync-public" -> unlines $ @@ -679,7 +676,7 @@ kiki_usage bExport bImport bSecret cmd = putStr $ ,"" ," (See 'kiki help spec' for more information.)" ,"" - ] ++ syncflags ++ specifyingFiles + ] ++ syncflags ++ specifyingFiles "export-public" -> unlines $ ["kiki export-public [options...]" ,"" @@ -692,7 +689,7 @@ kiki_usage bExport bImport bSecret cmd = putStr $ ,"" ," (See 'kiki help spec' for more information.)" ,"" - ] ++ specifyingFiles + ] ++ syncflags ++ specifyingFiles "spec" -> unlines keyspec where commonOptions :: [String] @@ -772,13 +769,15 @@ kiki_usage bExport bImport bSecret cmd = putStr $ ," 5E24CD442AA6965D2012E62A905C24185D5379C2" ] -documentPassphraseFDFlag bExport bImport bSecret = +documentPassphraseFDFlag bExport bImport bSecret = + if bSecret then [" --passphrase-fd FD" ," The file descripter from which to read a passphrase. If FD is" ," 0, then the passphrase is inputted via stdin. Note that this" ," requires the user to issue CTRL-D to send EOF, so that kiki" ," knows to continue." ,""] + else [] documentImportFlag bExport bImport bSecret = if bImport then @@ -804,14 +803,8 @@ documentAutoSignFlag bExport bImport bSecret = ," 'tor' subkey corresponding to the address HOSTNAME.onion." ,""] documentKeyPairsOption :: Bool -> Bool -> Bool -> [String] -documentKeyPairsOption bExport bImport bSecret = - [" --keypairs [KEYSPEC ...]" - ," A keypair is a secret key coupled with it's corresponding public" - ," key, both of which are ordinarily stored in a single file in PEM" - ," 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." - ,"" +documentKeyPairsOption bExport bImport bSecret = + [" --pems [KEYSPEC ...]" ] ++ case (bExport,bImport,bSecret) of (True,True,True) -> -- sync-secret [" This option specifies the paths of such private PEM files which" @@ -848,29 +841,27 @@ documentKeyPairsOption bExport bImport bSecret = ] ++ afterSecond (False,True,False) -> -- import-public NOT-IMPLEMENTED [" This option specifies the paths of PEM files, of both the" - ," public and private variety, which either currently contain" - ," contain keys to be imported. If your working key has no subkey" - ," with the given tag, and the file is empty or does not exist," - ," and a shell command is specified in braces, then the shell" - ," command will be executed in a modified environment with the" - ," expectation of creating the PEM file for import. Files external" - ," to your OpenGPG keyring will not be modified by this command." - ," Unlike the import-secret command, this command leaves no" - ," possibility of secret key information leaking from your OpenGPG" - ," keyring. " + ," public and private variety, which currently contain keys to" + ," be imported. If your working key has no subkey with the" + ," given tag, and the file is empty or does not exist, and a" + ," shell command is specified in braces, then the shell command" + ," will be executed in a modified environment with the" + ," expectation of creating the PEM file for import. Files" + ," external to your OpenGPG keyring will not be modified by" + ," this command. Unlike the import-secret command, this" + ," command leaves no possibility of secret key information" + ," leaking from your OpenGPG keyring. " ,"" ] ++ afterSecond (True,False,True) -> -- export-secret - [" This option specifies the paths of such private PEM files, of" - ," both the public variety, to which kiki will export keys. These" - ," files will be updated with information from your OpenGPG" - ," keyring, but your OpenGPG keyring will not be modified by this" - ," command. Unlike the export-secret comamnd, this command leaves" - ," no possibility that secret key information will leak from your" - ," OpenGPG keyring." + [" This option specifies the paths of PEM files, of the private or" + ," public variety, which lack information to be exported. Note that" + ," files currently in the public format may be overwritten to update" + ," them to the private format which holds both public and private" + ," key information." ,"" ] ++ afterSecond - (True,False,False) -> -- export-public NOT-IMPLEMENTED + (True,False,False) -> -- export-public [" This option specifies the paths of PEM files, of the private or" ," public variety, which lack public keys to be exported. Unlike" ," the export-secret command, this command leaves no possibility" @@ -879,16 +870,42 @@ documentKeyPairsOption bExport bImport bSecret = ,"" ] ++ afterSecond _ -> afterSecond - where afterSecond = + where afterSecond = [" Subkeys that are imported with kiki are given an annotation" ," \"usage@\" which indicates what the key is for. This tag can" - ," be used as a SPEC to select a particular key. If a specifed PEM" + ] ++ if bImport then n000Import else n000Export + n000Import = + [" be used as a SPEC to select a particular key. If a specifed PEM" ," file contains a novel key for an existing tag, it will imported," ," and you will have multiple keys with the same tag." ,"" ," Each KEYSPEC specifies that a key should match the content and" - ," timestamp of an external PKCS #1 private RSA key file." - ," " + ," timestamp of an external file which is in the PKCS #1 private" + ," RSA key format." -- " or in the PKCS #8 public key format." + ] ++ n0 + n000Export = + [" be used as a SPEC to select a particular key." + ,"" + ," (TODO: check) Each KEYSPEC specifies that a key should match the content and" + ," timestamp of an indicated external file which is either in PKCS #1" + ," private RSA key format or in PKCS #8 public key format (provided" + ," that the file already exists). If the file does not exist, it" + ] ++ (if bSecret then n00Secret else n00Public) ++ n0 + n00Secret = + [" will be created and have PKCS #1 Private RSA Key format." + ] + n00Public = + [" will be created and have PKCS #8 Public Key format." + ] + + n0 = + ["" + ," 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 information about" + ," what this key is used for, for example, any of `tor'," + ," `ssh-client', `ssh-host', or `strongswan' will do." + ,"" ," KEYSPEC ::= tag '=' file" ] ++ if bImport then " | tag '=' file '{' '}'":next else next @@ -902,14 +919,9 @@ documentKeyPairsOption bExport bImport bSecret = next' = ["" ," where the format of SPEC is documented in 'kiki help spec'." - ,"" - ," 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 information about" - ," what this key is used for, for example, any of `tor'," - ," `ssh-client', `ssh-host', or `strongswan' will do."] ++ next'' - next'' = if bImport then timeStamps ++ next''' else next''' - timeStamps = + ] ++ next'' + next'' = if bImport then timeStamps ++ next''' else next''' + timeStamps = ["" ," Your OpenGPG keyring contains time stamps for each subkey." ," Timestamps of newly imported keys will reflect the mtimes of" @@ -941,10 +953,10 @@ documentWalletsOption :: Bool -> Bool -> Bool -> [String] documentWalletsOption bExport bImport False = [] documentWalletsOption bExport bImport True = [" --wallets [FILE ...]" - ," Provide wallet files with secret crypto-coin keys in Wallet" - ," Import Format. The keys will be treated as subkeys of your" - ," current working key (the one shown by --show-wk)." - ,""] + ," Provide wallet files with secret crypto-coin keys in Wallet" + ," Import Format. The keys will be treated as subkeys of your" + ," current working key (the one shown by --show-wk)." + ,""] documentHostsOption :: Bool -> Bool -> Bool -> [String] documentHostsOption bExport bImport bSecret = @@ -1036,11 +1048,11 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp -- Flag-specific options --- bSecret: --keypairs and --wallets +-- bSecret: --pems and --wallets -- bImport: --import and --import-if-authentic sync :: Bool -> Bool -> Bool -> String -> [String] -> IO () sync bExport bImport bSecret cmdarg args_raw = do - let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keypairs" args_raw + let (sargs,margs) = processArgs sargspec polyVariadicArgs "--pems" args_raw sargspec = [ ("--show-wk",0) , ("--autosign",0) {-, ("--show-all",0) @@ -1054,13 +1066,13 @@ sync bExport bImport bSecret cmdarg args_raw = do [ ("--import",0), ("--import-if-authentic",0) ] polyVariadicArgs = ["--keyrings" ,"--hosts" - ,"--keypairs"] + ,"--pems"] ++ do guard bSecret [ "--wallets" ] -- putStrLn $ "margs = " ++ show (Map.assocs margs) unkeysRef <- newIORef Map.empty pwRef <- newIORef Nothing - let keypairs0 = parseKeySpecs (fromMaybe [] $ Map.lookup "--keypairs" margs) + let keypairs0 = parseKeySpecs (fromMaybe [] $ Map.lookup "--pems" margs) keyrings_ = fromMaybe [] $ Map.lookup "--keyrings" margs wallets = fromMaybe [] $ Map.lookup "--wallets" margs passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs @@ -1078,7 +1090,7 @@ sync bExport bImport bSecret cmdarg args_raw = do passfd = fmap (FileDesc . read) passphrase_fd reftyp = if bExport then KF_Subkeys else KF_None - pems = flip map keypairs + pems = flip map keypairs $ \(usage,path,cmd) -> let cmd' = mfilter (not . null) (Just cmd) in if bExport @@ -1131,7 +1143,7 @@ sync bExport bImport bSecret cmdarg args_raw = do } (\f -> maybe f (const $ kiki_usage bExport bImport bSecret cmdarg) $ Map.lookup "--help" margs) $ do - KikiResult rt report <- runKeyRing kikiOp + KikiResult rt report <- runKeyRing kikiOp case rt of KikiSuccess rt -> do -- interpret --show-* commands. @@ -1186,8 +1198,8 @@ kiki "help" [] = do return () kiki "help" args = forM_ args $ \arg -> case lookup arg commands of - Nothing | arg == "spec" -> kiki_usage False False False arg - Nothing | arg == "SPEC" -> kiki_usage False False False arg + Nothing | arg == "spec" -> kiki_usage False False False arg + Nothing | arg == "SPEC" -> kiki_usage False False False arg Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." _ -> kiki arg ["--help"] @@ -1226,8 +1238,8 @@ kiki "show" args = do , ( HomePub, streaminfo { access = Pub }) ] ++ rings - ++ pems - ++ walts + ++ pems + ++ walts ++ hosts , opPassphrases = do pfile <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfile @@ -1236,7 +1248,7 @@ kiki "show" args = do } (\f -> maybe f (const $ kiki_usage False False False "show") $ Map.lookup "--help" margs) $ do - KikiResult rt report <- runKeyRing kikiOp + KikiResult rt report <- runKeyRing kikiOp input_key <- maybe (return Nothing) (const $ fmap (Just . readPublicKey) Char8.getContents) @@ -1348,7 +1360,7 @@ kiki "merge" args = do , op { opTransforms = opTransforms op ++ [DeleteSubKey fp] } ) doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) - doAutosign True flow op = + doAutosign True flow op = if Map.null (opFiles op) then (flow, op { opTransforms = opTransforms op ++ [Autosign] }) else (flow { transforms = transforms flow ++ [Autosign] }, op) @@ -1477,7 +1489,7 @@ kiki "init-key" args = do ipsecpathpub0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" - + -- First, we ensure that the tor key exists and is imported -- so that we know where to put the strongswan key. let passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args @@ -1506,21 +1518,21 @@ kiki "init-key" args = do , opTransforms = [] } doNothing = return () - nop = KeyRingOperation + nop = KeyRingOperation { opFiles = Map.empty , opPassphrases = do pfd <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfd - , opHome=homespec, opTransforms = [] + , opHome=homespec, opTransforms = [] } if bUnprivileged then doNothing else mkdirFor torpath KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act rt <- case rt of - BadPassphrase -> + BadPassphrase -> error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" _ -> unconditionally $ return rt - + -- Now import, export, or generate the remaining secret keys. let oname' = do wk <- rtWorkingKey rt onionNameForContact (keykey wk) (rtKeyDB rt) @@ -1553,17 +1565,17 @@ kiki "init-key" args = do forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act rt <- case rt of - BadPassphrase -> + BadPassphrase -> error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" _ -> unconditionally $ return rt - + -- Finally, export public keys if they do not exist. flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do gotc <- doesFileExist (sshcpathpub) when (not gotc) $ do either warn (writeFile sshcpathpub) $ show_ssh' "ssh-client" grip (rtKeyDB rt) - if (not bUnprivileged) + if (not bUnprivileged) then do goth <- doesFileExist (sshspathpub) when (not goth) $ do -- cgit v1.2.3