大更新:

1、完善SQL语法
2、移除node前端,只保留静态资源
3、写好安装脚本
4、做好linux适配
This commit is contained in:
LIm1tZz7 committed 2026-10-01 20:48:38 +08:00
1 parent 687c012841
commit df6d348995
166 files changed
+16317 -10763

No files matched your search

+206
View File
@@ -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"))
+192
View File
@@ -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