大更新:

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

+75 -54
View File
@@ -2,22 +2,25 @@
module Main (main) where
import ChuSQL.Web.Api (AppEnv (..), Live (..), newAppEnv, setLive, webApp)
import ChuSQL.Web.Auth (SessionPolicy (..), newSessionStore)
import ChuSQL.Web.API (AppEnv (..), Live (..), newAppEnvAt, setLive, webApp)
import ChuSQL.Web.Auth (Credential (..), SessionPolicy (..), newSessionStore)
import ChuSQL.Web.Backend (Backend, ipcBackend)
import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
import ChuSQL.Web.Config (
WebConfig (..),
defaultPassword,
defaultUser,
loadWebConfig,
loadWebConfigAt,
resolveCredential,
resolvePipeName,
resolveStaticDir,
staticDirCandidates,
usingDefaultCredentials,
)
import ChuSQL.Web.RateLimit (newRateLimiter)
import ChuSQL.Web.Settings (effectiveSettings)
import ChuSQL.Storage.IPC (setPipeName)
import ChuSQL.Web.Settings (effectiveSettings, readSettingsFile)
import ChuSQL.Web.TOML (resolveConfigPath)
import ChuSQL.Web.StorageProcess (
StorageProcess (..),
findStorageServer,
@@ -25,8 +28,9 @@ import ChuSQL.Web.StorageProcess (
stopStorageProcess,
waitForStorage,
)
import Control.Exception (IOException, bracket, try)
import Control.Exception (IOException, bracket, onException, try)
import Data.Char (toLower)
import qualified Data.Map.Strict as Map
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
@@ -42,7 +46,8 @@ import Text.Read (readMaybe)
-- Web 管理端入口:读配置、备凭据、拉起存储进程,最后起 Warp。
data Options = Options
{ optHost :: Maybe String
{ optConfig :: Maybe FilePath
, optHost :: Maybe String
, optPort :: Maybe Int
, optStatic :: Maybe FilePath
, optStorage :: Maybe FilePath
@@ -65,7 +70,8 @@ data Options = Options
emptyOptions :: Options
emptyOptions =
Options
{ optHost = Nothing
{ optConfig = Nothing
, optHost = Nothing
, optPort = Nothing
, optStatic = Nothing
, optStorage = Nothing
@@ -91,6 +97,7 @@ parseArgs = go emptyOptions
go opts [] = Right opts
go opts ("--help" : rest) = go opts{optHelp = True} rest
go opts ("-h" : rest) = go opts{optHelp = True} rest
go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
go opts ("--host" : v : rest) = go opts{optHost = Just v} rest
go opts ("--static" : v : rest) = go opts{optStatic = Just v} rest
go opts ("--storage" : v : rest) = go opts{optStorage = Just v} rest
@@ -109,11 +116,9 @@ parseArgs = go emptyOptions
go opts ("--cookie-secure" : v : rest) = go opts{optCookieSecure = Just (isTrue v)} rest
go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
-- | 读一个整数开关
withInt :: String -> String -> (Int -> Either String Options) -> Either String Options
withInt name v k = maybe (Left (name ++ " needs an integer, got: " ++ v)) k (readMaybe v)
-- | 布尔开关认 1/true/yes/on
isTrue :: String -> Bool
isTrue s = map toLower s `elem` ["1", "true", "yes", "on"]
@@ -122,27 +127,36 @@ usage :: IO ()
usage = do
putStrLn "usage: chusql-web [options]"
putStrLn ""
putStrLn " --host H listen address (CHUSQL_WEB_HOST, default 127.0.0.1)"
putStrLn " --port N listen port (CHUSQL_WEB_PORT, default 7777)"
putStrLn " --static DIR static asset directory (CHUSQL_WEB_STATIC, default static)"
putStrLn " --user NAME account name (CHUSQL_WEB_USER, default admin)"
putStrLn " --storage SERVER Rust storage exe to spawn (CHUSQL_STORAGE_SERVER)"
putStrLn " --cookie-secure BOOL add Secure to the cookie (CHUSQL_WEB_COOKIE_SECURE, default false)"
putStrLn " --body-limit N max request body bytes (CHUSQL_WEB_BODY_LIMIT, default 65536)"
putStrLn " --session-idle N session idle timeout, sec (CHUSQL_WEB_SESSION_IDLE, default 28800)"
putStrLn " --session-max N session max age, sec (CHUSQL_WEB_SESSION_MAX, default 86400)"
putStrLn " --login-max-attempts N failed logins before 429 (CHUSQL_WEB_LOGIN_MAX_ATTEMPTS, default 5)"
putStrLn " --login-window N lockout window, sec (CHUSQL_WEB_LOGIN_WINDOW, default 300)"
putStrLn " --page-size N rows per page by default (CHUSQL_WEB_PAGE_SIZE, default 25)"
putStrLn " --max-page-size N rows per page ceiling (CHUSQL_WEB_MAX_PAGE_SIZE, default 500)"
putStrLn " --max-rows N rows returned per query (CHUSQL_WEB_MAX_ROWS, default 1000)"
putStrLn " --max-sql-length N max SQL characters (CHUSQL_WEB_MAX_SQL_LENGTH, default 20000)"
putStrLn " --seed BOOL load demo data when the db is empty (CHUSQL_WEB_SEED, default false)"
putStrLn "config: chusql.toml sits at a fixed place and its sections hold every knob below;"
putStrLn " Windows: %APPDATA%\\ChuSQL\\chusql.toml"
putStrLn " other: $XDG_CONFIG_HOME/ChuSQL/chusql.toml (or ~/.config/ChuSQL/chusql.toml)"
putStrLn " [web] host/port/static_dir/user/password and the limits; [server] pipe_name;"
putStrLn " [storage] data_dir; [page] size; [btree] order; [buffer] pool_size; [log] level"
putStrLn ""
putStrLn "password: CHUSQL_WEB_PASSWORD_HASH > CHUSQL_WEB_PASSWORD > built-in demo password"
putStrLn ("without any of them the demo account is " ++ T.unpack defaultUser ++ " / " ++ T.unpack defaultPassword)
putStrLn "storage knobs for the spawned process: CHUSQL_PAGE_SIZE / CHUSQL_BTREE_ORDER /"
putStrLn " CHUSQL_BUFFER_POOL_SIZE / CHUSQL_LOG / CHUSQL_PIPE / CHUSQL_DATA_DIR"
putStrLn " --config FILE read that config file instead ([web] host ...)"
putStrLn " --host H listen address ([web] host, default 127.0.0.1)"
putStrLn " --port N listen port ([web] port, default 7777)"
putStrLn " --static DIR static asset directory ([web] static_dir, default static)"
putStrLn " --user NAME administrator name ([web] user, default root)"
putStrLn " --storage SERVER Rust storage exe to spawn ([web] storage_server)"
putStrLn " --cookie-secure BOOL add Secure to the cookie ([web] cookie_secure, default false)"
putStrLn " --body-limit N max request body bytes ([web] body_limit, default 65536)"
putStrLn " --session-idle N session idle timeout, sec ([web] session_idle, default 28800)"
putStrLn " --session-max N session max age, sec ([web] session_max, default 86400)"
putStrLn " --login-max-attempts N failed logins before 429 ([web] login_max_attempts, default 5)"
putStrLn " --login-window N lockout window, sec ([web] login_window, default 300)"
putStrLn " --page-size N rows per page by default ([web] rows_per_page, default 25)"
putStrLn " --max-page-size N rows per page ceiling ([web] max_page_size, default 500)"
putStrLn " --max-rows N rows returned per query ([web] max_rows, default 1000)"
putStrLn " --max-sql-length N max SQL characters ([web] max_sql_length, default 20000)"
putStrLn " --seed BOOL load demo data when the db is empty ([web] seed, default false)"
putStrLn ""
putStrLn "administrator password: user / password in the [web] section of chusql.toml, else the built-in demo"
putStrLn " an empty password means the administrator signs in with no password; ordinary accounts are then refused"
putStrLn ("without either the demo administrator is " ++ T.unpack defaultUser ++ " / " ++ T.unpack defaultPassword)
putStrLn "ordinary accounts: CREATE USER / ALTER USER / DROP USER from the SQL console (administrator only)"
putStrLn "storage process: [server] pipe_name says where to talk and where a spawned one listens;"
putStrLn " [storage] data_dir, [page] size, [btree] order, [buffer] pool_size and [log] level are its own"
-- | 命令行覆盖配置
applyOptions :: WebConfig -> Options -> WebConfig
@@ -168,20 +182,19 @@ applyOptions cfg opts =
, wcSeedDemo = orElse (optSeedDemo opts) (wcSeedDemo cfg)
}
where
-- | 开关给了用开关的,否则保留原值
orElse :: Maybe a -> a -> a
orElse (Just x) _ = x
orElse Nothing y = y
-- | 配了存储进程路径就拉起来,没配就假设外面已经跑着
startStorageIfWanted :: WebConfig -> IO (Either String (Maybe StorageProcess))
startStorageIfWanted cfg = case wcStorageServer cfg of
startStorageIfWanted :: WebConfig -> FilePath -> IO (Either String (Maybe StorageProcess))
startStorageIfWanted cfg configPath = case wcStorageServer cfg of
Nothing -> pure (Right Nothing)
Just given -> do
found <- findStorageServer (Just given)
case found of
Left e -> pure (Left e)
Right bin -> fmap (fmap Just) (startStorageProcess bin)
Right bin -> fmap (fmap Just) (startStorageProcess bin configPath)
-- | 入口
main :: IO ()
@@ -200,16 +213,20 @@ main = do
-- | 起服务
run :: Options -> IO ()
run opts = do
base <- loadWebConfig
configPath <- resolveConfigPath (optConfig opts)
base <- loadWebConfigAt configPath
let cfg = applyOptions base opts
setPipeName (resolvePipeName cfg)
foundStatic <- resolveStaticDir (wcStaticDir cfg)
case foundStatic of
Nothing -> do
putStrLn ("static directory not found; looked in: " ++ unwords (staticDirCandidates (wcStaticDir cfg)))
exitFailure
Just staticDir -> do
cred <- resolveCredential cfg
storage <- startStorageIfWanted cfg
let settingsFile = configPath
saved <- readSettingsFile settingsFile
cred <- resolveCredential cfg saved
storage <- startStorageIfWanted cfg configPath
case storage of
Left err -> do
putStrLn err
@@ -226,17 +243,18 @@ run opts = do
getCurrentTime
(wcLoginMaxAttempts cfg)
(fromIntegral (wcLoginWindow cfg))
env0 <- newAppEnv backend sessions cred limiter staticDir
env0 <- newAppEnvAt settingsFile backend sessions cred limiter staticDir
`onException` maybe (pure ()) stopStorageProcess maybeStorage
let env =
env0
{ aeCookieSecure = wcCookieSecure cfg
, aeEffective = effectiveSettings cfg
, aeLog = \msg -> TIO.putStrLn ("[web] " <> msg)
, aeLog = TIO.putStrLn
}
setLive env (liveFromConfig cfg)
app <- webApp env
printBanner cfg staticDir maybeStorage
reportCredential cfg
printBanner cfg configPath staticDir maybeStorage
reportCredential cred saved
waitForStorageReport
seedIfWanted cfg backend
let settings =
@@ -273,15 +291,17 @@ serve settings app = do
exitFailure
-- | 口令是从哪来的(用了内置默认口令就明确警告)
reportCredential :: WebConfig -> IO ()
reportCredential cfg
| usingDefaultCredentials cfg = do
reportCredential :: Credential -> Map.Map Text Text -> IO ()
reportCredential cred saved
| usingDefaultCredentials saved = do
putStrLn ""
putStrLn " !! DEMO CREDENTIALS IN USE:"
putStrLn (" !! user " ++ T.unpack (wcUser cfg) ++ " / password " ++ T.unpack defaultPassword)
putStrLn " !! set CHUSQL_WEB_PASSWORD (or CHUSQL_WEB_PASSWORD_HASH) before exposing this server."
putStrLn " !! Administrator credentials are not configured; the built-in demo password is in use:"
putStrLn (" !! user " ++ T.unpack (credUser cred) ++ " / password " ++ T.unpack defaultPassword)
putStrLn " !! set user / password in the [web] section of chusql.toml and restart"
putStrLn ""
| otherwise = putStrLn ("password: from CHUSQL_WEB_PASSWORD(_HASH) (user " ++ T.unpack (wcUser cfg) ++ ")")
| T.null (credEncoded cred) =
putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (passwordless: only the administrator may sign in)")
| otherwise = putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (credentials come from the settings file only)")
-- | 配了 seed 就补一份演示数据
seedIfWanted :: WebConfig -> Backend -> IO ()
@@ -290,10 +310,10 @@ seedIfWanted cfg backend
| otherwise = do
result <- seedDemo backend
case result of
Left e -> TIO.putStrLn ("[web] demo data skipped: " <> T.pack e)
Left e -> TIO.putStrLn ("demo data skipped: " <> T.pack e)
Right report ->
TIO.putStrLn
( "[web] demo data: "
( "demo data: "
<> (if null (srCreated report) then "already present" else "created " <> T.pack (unwords (srCreated report)))
<> (if null (srSkipped report) then "" else ", kept " <> T.pack (unwords (srSkipped report)))
<> (if null (srIndexes report) then "" else ", index on " <> T.pack (unwords (srIndexes report)))
@@ -305,15 +325,16 @@ waitForStorageReport = do
up <- waitForStorage 20
putStrLn
( if up
then "storage: up (named pipe answered ping)"
then "storage: up (endpoint answered ping)"
else "storage: DOWN (no ping reply; start the Rust storage process or pass --storage)"
)
-- | 启动横幅
printBanner :: WebConfig -> FilePath -> Maybe StorageProcess -> IO ()
printBanner cfg staticDir maybeStorage = do
printBanner :: WebConfig -> FilePath -> FilePath -> Maybe StorageProcess -> IO ()
printBanner cfg configPath staticDir maybeStorage = do
putStrLn "==================== ChuSQL Web ===================="
putStrLn ("url: http://" ++ wcHost cfg ++ ":" ++ show (wcPort cfg) ++ "/")
putStrLn ("config file: " ++ configPath)
putStrLn ("static dir: " ++ staticDir)
putStrLn
( "limits: body "
@@ -340,5 +361,5 @@ printBanner cfg staticDir maybeStorage = do
++ "s"
)
case maybeStorage of
Just sp -> putStrLn ("storage proc: " ++ spPipe sp ++ " data dir " ++ spDataDir sp)
Nothing -> putStrLn "storage proc: assumed to run elsewhere (pipe name from CHUSQL_PIPE)"
Just sp -> putStrLn ("storage proc: spawned, talking on pipe " ++ spPipe sp)
Nothing -> putStrLn "storage proc: assumed to run elsewhere (pipe name from [server] pipe_name)"