大更新:
1、完善SQL语法 2、移除node前端,只保留静态资源 3、写好安装脚本 4、做好linux适配
This commit is contained in:
1 parent
687c012841
commit
df6d348995
166 files changed
+16317
-10763
No files matched your search
@@ -0,0 +1,206 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
|
||||
import ChuSQL.CLI.Script (stripTerminator)
|
||||
import ChuSQL.CLI.Session (
|
||||
Session,
|
||||
authenticateSession,
|
||||
isPlainIdentifier,
|
||||
newSession,
|
||||
switchDatabase,
|
||||
)
|
||||
import ChuSQL.Web.Auth (Credential (..))
|
||||
import ChuSQL.Web.Backend (ipcBackend)
|
||||
import ChuSQL.Web.Config (WebConfig (..), defaultPassword, loadWebConfigAt, resolveCredential, resolvePipeName)
|
||||
import ChuSQL.Web.Settings (readSettingsFile)
|
||||
import ChuSQL.Web.TOML (resolveConfigPath)
|
||||
import ChuSQL.Web.StorageProcess (
|
||||
StorageProcess,
|
||||
findStorageServer,
|
||||
startStorageProcessAt,
|
||||
stopStorageProcess,
|
||||
waitForStorage,
|
||||
)
|
||||
import ChuSQL.Storage.IPC (setPipeName)
|
||||
import Control.Exception (finally)
|
||||
import Control.Monad (unless)
|
||||
import Data.IORef (newIORef)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Options.Applicative
|
||||
import Repl (reportError, runRepl, runStatementOnce)
|
||||
import System.Console.Haskeline (defaultSettings, getPassword, runInputT)
|
||||
import System.Directory (getHomeDirectory)
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath ((</>))
|
||||
import System.IO (hSetEncoding, stderr, stdout, utf8)
|
||||
|
||||
-- chusql-cli:与 Web 管理端并列的前端,直连存储与引擎,账号与 Web 共用。
|
||||
|
||||
data Options = Options
|
||||
{ optUser :: Maybe Text
|
||||
, optPromptPassword :: Bool
|
||||
, optDatabase :: Text
|
||||
, optFormat :: OutputFormat
|
||||
, optExecute :: Maybe Text
|
||||
, optHistory :: Maybe FilePath
|
||||
, optPipe :: Maybe String
|
||||
, optStorage :: Maybe FilePath
|
||||
, optConfig :: Maybe FilePath
|
||||
}
|
||||
|
||||
optionsParser :: Parser Options
|
||||
optionsParser =
|
||||
Options
|
||||
<$> optional (T.pack <$> strOption (long "user" <> short 'u' <> metavar "USER" <> help "Sign in as this account (default: the configured administrator)"))
|
||||
<*> switch (long "password" <> short 'p' <> help "Always ask for the password, ignoring the configured one")
|
||||
<*> ( T.pack
|
||||
<$> strOption
|
||||
( long "database"
|
||||
<> short 'd'
|
||||
<> metavar "DB"
|
||||
<> value ""
|
||||
<> help "Database to use (default: none, select one with USE)"
|
||||
)
|
||||
)
|
||||
<*> option
|
||||
(eitherReader formatReader)
|
||||
( long "format"
|
||||
<> short 'f'
|
||||
<> metavar "FORMAT"
|
||||
<> value FormatTable
|
||||
<> showDefaultWith (T.unpack . formatName)
|
||||
<> help "Output format: table, json or csv"
|
||||
)
|
||||
<*> optional (T.pack <$> strOption (long "execute" <> short 'e' <> metavar "SQL" <> help "Run one statement and exit"))
|
||||
<*> optional (strOption (long "history" <> metavar "FILE" <> help "SQL history file (default ~/.chusql_history)"))
|
||||
<*> optional (strOption (long "pipe" <> metavar "NAME" <> help "Endpoint name of the storage process (Windows named pipe, Unix socket file; default: [server] pipe_name in chusql.toml)"))
|
||||
<*> optional (strOption (long "storage" <> metavar "SERVER" <> help "Rust storage executable to spawn when nothing answers the endpoint"))
|
||||
<*> optional (strOption (long "config" <> metavar "FILE" <> help "Config file to read (default: the fixed chusql.toml under the system config directory)"))
|
||||
|
||||
formatReader :: String -> Either String OutputFormat
|
||||
formatReader raw = maybe (Left "format must be table, json or csv") Right (parseFormat (T.pack raw))
|
||||
|
||||
parserInfo :: ParserInfo Options
|
||||
parserInfo =
|
||||
info
|
||||
(optionsParser <**> helper)
|
||||
( fullDesc
|
||||
<> progDesc "Run SQL against the ChuSQL storage engine"
|
||||
<> header "csql - the ChuSQL command line client"
|
||||
)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
hSetEncoding stdout utf8
|
||||
hSetEncoding stderr utf8
|
||||
options <- execParser parserInfo
|
||||
configPath <- resolveConfigPath (optConfig options)
|
||||
base <- loadWebConfigAt configPath
|
||||
let settingsFile = configPath
|
||||
saved <- readSettingsFile settingsFile
|
||||
credential <- resolveCredential base saved
|
||||
let rootName = credUser credential
|
||||
userName = fromMaybe rootName (optUser options)
|
||||
pipeName = resolvePipe options base
|
||||
setPipeName pipeName
|
||||
password <- resolvePassword (optPromptPassword options) userName rootName saved
|
||||
storage <- acquireStorage options pipeName settingsFile
|
||||
case storage of
|
||||
Left message -> reportError message >> exitFailure
|
||||
Right spawned ->
|
||||
connect options credential settingsFile userName password
|
||||
`finally` maybe (pure ()) stopStorageProcess spawned
|
||||
|
||||
-- | 接上存储,登录,然后进交互或跑单条语句
|
||||
connect :: Options -> Credential -> FilePath -> Text -> Text -> IO ()
|
||||
connect options credential settingsFile userName password = do
|
||||
backend <- ipcBackend
|
||||
session <- newSession backend credential settingsFile
|
||||
signedIn <- authenticateSession session userName password
|
||||
case signedIn of
|
||||
Left message -> reportError message >> exitFailure
|
||||
Right () -> runSession options session
|
||||
|
||||
runSession :: Options -> Session -> IO ()
|
||||
runSession options session = do
|
||||
formatRef <- newIORef (optFormat options)
|
||||
ready <- selectDatabase session (T.strip (optDatabase options))
|
||||
if not ready
|
||||
then exitFailure
|
||||
else case optExecute options of
|
||||
Just sql -> do
|
||||
ok <- runStatementOnce session (optFormat options) (stripTerminator sql)
|
||||
unless ok exitFailure
|
||||
Nothing -> do
|
||||
historyFile <- resolveHistory (optHistory options)
|
||||
runRepl session formatRef historyFile
|
||||
|
||||
-- | 只有 -d 明确给了一个库才切;没给就保持"未选库"(服务没有默认库)
|
||||
selectDatabase :: Session -> Text -> IO Bool
|
||||
selectDatabase _ wanted | T.null wanted = pure True
|
||||
selectDatabase session wanted
|
||||
| not (isPlainIdentifier wanted) = reportError ("not a plain database name: " <> wanted) >> pure False
|
||||
| otherwise = do
|
||||
switched <- switchDatabase session wanted
|
||||
case switched of
|
||||
Left message -> reportError message >> pure False
|
||||
Right () -> pure True
|
||||
|
||||
-- | 口令:-p 强制交互输入;否则配置里的 root 明文(同 Web)> 交互输入
|
||||
resolvePassword :: Bool -> Text -> Text -> Map.Map Text Text -> IO Text
|
||||
resolvePassword forcePrompt userName rootName saved
|
||||
| forcePrompt = promptPassword userName
|
||||
| T.toLower userName == T.toLower rootName = pure (configuredPassword saved)
|
||||
| otherwise = promptPassword userName
|
||||
where
|
||||
configuredPassword values = case nonEmpty (Map.lookup "password" values) of
|
||||
Just plain -> plain
|
||||
Nothing -> defaultPassword
|
||||
|
||||
promptPassword :: Text -> IO Text
|
||||
promptPassword user = do
|
||||
entered <- runInputT defaultSettings (getPassword (Just '*') (T.unpack user <> "'s password: "))
|
||||
pure (maybe "" T.pack entered)
|
||||
|
||||
-- | 先找已经在跑的存储;--storage 给了可执行文件才自己拉一个
|
||||
acquireStorage :: Options -> String -> FilePath -> IO (Either Text (Maybe StorageProcess))
|
||||
acquireStorage options pipeName configPath = do
|
||||
up <- waitForStorage 4
|
||||
case optStorage options of
|
||||
Nothing
|
||||
| up -> pure (Right Nothing)
|
||||
| otherwise ->
|
||||
pure
|
||||
( Left
|
||||
( "no storage process answered on pipe "
|
||||
<> T.pack pipeName
|
||||
<> "; start the server first, or pass --storage <path>"
|
||||
)
|
||||
)
|
||||
Just given
|
||||
| up -> pure (Right Nothing)
|
||||
| otherwise -> do
|
||||
found <- findStorageServer (Just given)
|
||||
case found of
|
||||
Left err -> pure (Left (T.pack err))
|
||||
Right binary -> fmap (either (Left . T.pack) (Right . Just)) (startStorageProcessAt binary pipeName configPath)
|
||||
|
||||
-- | 管名:--pipe > chusql.toml 的 [server] pipe_name(缺省 chusql-joint)
|
||||
resolvePipe :: Options -> WebConfig -> String
|
||||
resolvePipe options base = fromMaybe (resolvePipeName base) (optPipe options)
|
||||
|
||||
nonEmpty :: Maybe Text -> Maybe Text
|
||||
nonEmpty given = case T.strip <$> given of
|
||||
Just text | not (T.null text) -> Just text
|
||||
_ -> Nothing
|
||||
|
||||
resolveHistory :: Maybe FilePath -> IO (Maybe FilePath)
|
||||
resolveHistory (Just path) = pure (Just path)
|
||||
resolveHistory Nothing = do
|
||||
home <- getHomeDirectory
|
||||
pure (Just (home </> ".chusql_history"))
|
||||
@@ -0,0 +1,192 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Repl
|
||||
( runRepl
|
||||
, runStatementOnce
|
||||
, reportError
|
||||
) where
|
||||
|
||||
import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
|
||||
import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
|
||||
import ChuSQL.CLI.Session (Session, accountTable, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
|
||||
import ChuSQL.Storage.IPC (SchemaColumn (..), TableInfo (..))
|
||||
import ChuSQL.Web.Privileges (Grant (..), RoleView (..))
|
||||
import Control.Monad (forM_, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.IORef (IORef, readIORef, writeIORef)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as TIO
|
||||
import System.Console.Haskeline
|
||||
import System.IO (hIsTerminalDevice, stderr, stdin)
|
||||
|
||||
-- 交互层:提示符、多行输入、历史、元命令与错误提示。
|
||||
|
||||
-- | 交互循环;historyPath 为 Nothing 就不落盘历史
|
||||
runRepl :: Session -> IORef OutputFormat -> Maybe FilePath -> IO ()
|
||||
runRepl session formatRef historyPath =
|
||||
runInputT (defaultSettings{historyFile = historyPath}) (loop session formatRef T.empty)
|
||||
|
||||
-- | 入口处直接报错(-e 与启动阶段用)
|
||||
reportError :: Text -> IO ()
|
||||
reportError message = do
|
||||
TIO.hPutStrLn stderr ("chusql: error: " <> message)
|
||||
forM_ (errorHint message) (\hint -> TIO.hPutStrLn stderr ("hint: " <> hint))
|
||||
|
||||
-- | 跑一条语句并按格式打印;成功与否当退出码
|
||||
runStatementOnce :: Session -> OutputFormat -> Text -> IO Bool
|
||||
runStatementOnce session format sql = do
|
||||
result <- runStatement session sql
|
||||
case result of
|
||||
Left message -> reportError message >> pure False
|
||||
Right answer -> TIO.putStrLn (renderResult format answer) >> pure True
|
||||
|
||||
loop :: Session -> IORef OutputFormat -> Text -> InputT IO ()
|
||||
loop session formatRef buffer = do
|
||||
prompt <- liftIO (promptFor session buffer)
|
||||
entered <- getInputLine (T.unpack prompt)
|
||||
case entered of
|
||||
Nothing -> do
|
||||
interactive <- liftIO (hIsTerminalDevice stdin)
|
||||
when interactive (outputStrLn "")
|
||||
Just raw -> do
|
||||
let line = T.strip (T.pack raw)
|
||||
if T.null line
|
||||
then loop session formatRef buffer
|
||||
else case (T.null buffer, parseMeta line) of
|
||||
(True, Just meta) -> do
|
||||
again <- runMeta session formatRef meta
|
||||
when again (loop session formatRef T.empty)
|
||||
_ -> do
|
||||
let extended = if T.null buffer then line else buffer <> "\n" <> line
|
||||
remaining <- drain session formatRef extended
|
||||
loop session formatRef remaining
|
||||
|
||||
-- | 提示符带上当前库;续行换个样子,方便看出语句还没写完;管道输入时不出提示符
|
||||
promptFor :: Session -> Text -> IO Text
|
||||
promptFor session buffer = do
|
||||
interactive <- hIsTerminalDevice stdin
|
||||
if not interactive
|
||||
then pure ""
|
||||
else
|
||||
if not (T.null (T.strip buffer))
|
||||
then pure " -> "
|
||||
else do
|
||||
current <- sessionDatabase session
|
||||
pure (if T.null current then "chusql> " else "chusql [" <> current <> "]> ")
|
||||
|
||||
-- | 把攒下来的内容里所有完整语句依次执行,返回没写完的残余
|
||||
drain :: Session -> IORef OutputFormat -> Text -> InputT IO Text
|
||||
drain session formatRef buffer = case takeStatement buffer of
|
||||
Nothing -> pure (T.strip buffer)
|
||||
Just (statement, rest) -> do
|
||||
when (not (T.null statement)) (runOne session formatRef statement)
|
||||
drain session formatRef rest
|
||||
|
||||
runOne :: Session -> IORef OutputFormat -> Text -> InputT IO ()
|
||||
runOne session formatRef statement = do
|
||||
result <- liftIO (runStatement session statement)
|
||||
case result of
|
||||
Left message -> liftIO (reportError message)
|
||||
Right answer -> do
|
||||
format <- liftIO (readIORef formatRef)
|
||||
outputStrLn (T.unpack (renderResult format answer))
|
||||
|
||||
runMeta :: Session -> IORef OutputFormat -> Meta -> InputT IO Bool
|
||||
runMeta session formatRef meta = case meta of
|
||||
MetaQuit -> pure False
|
||||
MetaHelp -> outputStrLn (T.unpack metaHelp) >> pure True
|
||||
MetaDatabases -> listDatabases session >> pure True
|
||||
MetaTables -> listTables session >> pure True
|
||||
MetaDescribe name -> describeTable session name >> pure True
|
||||
MetaRoles -> listRoles session >> pure True
|
||||
MetaConnect name -> do
|
||||
switched <- liftIO (switchDatabase session name)
|
||||
case switched of
|
||||
Left message -> liftIO (reportError message)
|
||||
Right () -> outputStrLn ("database is now " <> T.unpack name)
|
||||
pure True
|
||||
MetaSetFormat format -> do
|
||||
liftIO (writeIORef formatRef format)
|
||||
outputStrLn ("output format is now " <> T.unpack (formatName format))
|
||||
pure True
|
||||
MetaUnknown name -> outputStrLn ("unknown command: \\" <> T.unpack name <> " (try \\?)") >> pure True
|
||||
|
||||
-- | \l:库清单
|
||||
listDatabases :: Session -> InputT IO ()
|
||||
listDatabases session = do
|
||||
answer <- liftIO (databases session)
|
||||
case answer of
|
||||
Left message -> liftIO (reportError message)
|
||||
Right names -> outputStrLn (T.unpack (renderRows ["database"] (map (: []) names)))
|
||||
|
||||
-- | \dt:表清单(base 里补上账号表)
|
||||
listTables :: Session -> InputT IO ()
|
||||
listTables session = do
|
||||
answer <- liftIO (catalog session)
|
||||
case answer of
|
||||
Left message -> liftIO (reportError message)
|
||||
Right tables -> do
|
||||
allTables <- liftIO (withAccountTable session tables)
|
||||
outputStrLn (T.unpack (renderRows headers (map tableRow allTables)))
|
||||
where
|
||||
headers = ["table", "columns", "rows", "indexes"]
|
||||
tableRow info =
|
||||
[ T.pack (tiTable info)
|
||||
, tshow (length (tiColumns info))
|
||||
, tshow (tiRows info)
|
||||
, if null (tiIndexes info) then "-" else T.intercalate ", " (map T.pack (tiIndexes info))
|
||||
]
|
||||
|
||||
-- | \d <table>:列结构
|
||||
describeTable :: Session -> Text -> InputT IO ()
|
||||
describeTable session name = do
|
||||
answer <- liftIO (catalog session)
|
||||
case answer of
|
||||
Left message -> liftIO (reportError message)
|
||||
Right tables -> do
|
||||
allTables <- liftIO (withAccountTable session tables)
|
||||
case filter (matches name) allTables of
|
||||
[] -> liftIO (reportError ("unknown table: " <> name))
|
||||
(info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
|
||||
where
|
||||
headers = ["column", "type", "primary", "unique", "nullable", "auto"]
|
||||
matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
|
||||
columnRow column =
|
||||
[ T.pack (scName column)
|
||||
, T.pack (scType column)
|
||||
, yesNo (scPrimaryKey column)
|
||||
, yesNo (scUnique column)
|
||||
, yesNo (scNullable column)
|
||||
, yesNo (scAutoIncrement column)
|
||||
]
|
||||
yesNo True = "yes"
|
||||
yesNo False = "no"
|
||||
|
||||
-- | \dr:角色清单(授权对象与成员)
|
||||
listRoles :: Session -> InputT IO ()
|
||||
listRoles session = do
|
||||
answer <- liftIO (roleViews session)
|
||||
case answer of
|
||||
Left message -> liftIO (reportError message)
|
||||
Right roles -> outputStrLn (T.unpack (renderRows ["role", "grants", "members"] (map roleRow roles)))
|
||||
where
|
||||
roleRow view =
|
||||
[ roleName view
|
||||
, if null (roleGrants view) then "-" else T.intercalate ", " (map grantText (roleGrants view))
|
||||
, if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view)
|
||||
]
|
||||
grantText grant = grantPrivilege grant <> " on " <> grantObject grant
|
||||
|
||||
-- | 当前库是 system 时,把账号表也列出来(与 Web 端一致)
|
||||
withAccountTable :: Session -> [TableInfo] -> IO [TableInfo]
|
||||
withAccountTable session tables = do
|
||||
current <- sessionDatabase session
|
||||
if current /= "system"
|
||||
then pure tables
|
||||
else do
|
||||
extra <- accountTable session
|
||||
pure (maybe tables (: tables) extra)
|
||||
|
||||
tshow :: Show a => a -> Text
|
||||
tshow = T.pack . show
|
||||
Reference in new issue
Block a user