准备可扩展类型系统工作,更合理的JOIN查询优化算法,并行查询

This commit is contained in:
LIm1tZz7 committed 2026-10-03 11:56:13 +08:00
1 parent 9758439b82
commit 274b7fcdcc
75 files changed
+3828 -1789

No files matched your search

+5
View File
@@ -74,6 +74,7 @@ jobs:
path: |
~/.stack
chusql-core/engine/.stack-work
chusql-bootstrap/.stack-work
chusql-server/.stack-work
chusql-web/.stack-work
chusql-cli/.stack-work
@@ -84,6 +85,10 @@ jobs:
working-directory: chusql-cli
run: stack build --fast
- name: bootstrap build
working-directory: chusql-bootstrap
run: stack build --fast
- name: engine tests
working-directory: chusql-core/engine
run: stack test --fast
+27 -3
View File
@@ -97,6 +97,10 @@ jobs:
working-directory: chusql-cli
run: stack build --fast chusql-server:exe:chusql-server
- name: build bootstrap program
working-directory: chusql-bootstrap
run: stack build --fast chusql-bootstrap:exe:csql-bootstrap
# ---------- 装配 + 打归档(CI 里直接写在这里;本机打同一个包用 scripts/package.sh)----------
# 归档里是包内容本身(bin/、scripts/、static/、install.sh 就在根上),安装脚本按这个布局找文件。
- name: package (Unix)
@@ -121,6 +125,15 @@ jobs:
cp "$front" "$stage/bin/"
done
# 引导程序住在自己的工程里,安装根也单独问它要
bootstrap_root="$(cd chusql-bootstrap && stack path --local-install-root | tail -n 1 | tr -d '\r')"
bootstrap_bin="$bootstrap_root/bin/csql-bootstrap"
if [ ! -f "$bootstrap_bin" ]; then
bootstrap_bin="$(find chusql-bootstrap/.stack-work -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true)"
fi
[ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || { echo "csql-bootstrap not found" >&2; exit 1; }
cp "$bootstrap_bin" "$stage/bin/"
# Haskell 一般静态链接,靶目录里真有共享库就一起带上;改名前的旧库(libchusql_storage.*)不能进包
for lib in chusql-core/storage/target/release/*.so chusql-core/storage/target/release/*.dylib; do
[ -f "$lib" ] || continue
@@ -130,14 +143,15 @@ jobs:
cp "$lib" "$stage/bin/"
done
cp scripts/chusql.toml scripts/init.sql "$stage/scripts/"
cp scripts/chusql.toml "$stage/scripts/"
cp scripts/install.ps1 scripts/install.sh "$stage/"
cp scripts/uninstall.ps1 scripts/uninstall.sh "$stage/"
mkdir -p "$stage/static"
cp -R chusql-web/static/. "$stage/static/"
cp scripts/csql-web.sh "$stage/"
if [ -f scripts/csql-web.ps1 ]; then cp scripts/csql-web.ps1 "$stage/"; fi
chmod +x "$stage/install.sh" "$stage/csql-web.sh"
chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh"
mkdir -p dist
tar -czf "dist/$name.tar.gz" -C "$stage" .
@@ -167,13 +181,23 @@ jobs:
Copy-Item $front "$stage/bin/"
}
$bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
$bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe'
if (-not (Test-Path $bootstrapExe)) {
$bootstrapExe = Get-ChildItem -Path 'chusql-bootstrap/.stack-work' -Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue |
Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
}
if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { throw 'csql-bootstrap.exe not found' }
Copy-Item $bootstrapExe "$stage/bin/"
# 第三方 dll 才要连带上:名字带 chusql 的是本 crate 产物或改名前的残留,上面已按名拷过
Get-ChildItem 'chusql-core/storage/target/release' -Filter '*.dll' -File -ErrorAction SilentlyContinue |
Where-Object { $_.Name -notlike 'chusql*' } |
ForEach-Object { Copy-Item $_.FullName "$stage/bin/" }
Copy-Item 'scripts/chusql.toml', 'scripts/init.sql' "$stage/scripts/"
Copy-Item 'scripts/chusql.toml' "$stage/scripts/"
Copy-Item 'scripts/install.ps1', 'scripts/install.sh' $stage
Copy-Item 'scripts/uninstall.ps1', 'scripts/uninstall.sh' $stage
New-Item -ItemType Directory -Force -Path "$stage/static" | Out-Null
Copy-Item 'chusql-web/static/*' "$stage/static" -Recurse
Copy-Item 'scripts/csql-web.sh' $stage
+1
View File
@@ -94,3 +94,4 @@ plandocs/
Thumbs.db
ehthumbs.db
desktop.ini
AGENTS.md
+19 -24
View File
@@ -1,46 +1,41 @@
# ChuSQL
本项目是一个简单的数据库项目,服务端采用 Haskell 和 Rust 联合编写,采取 B/S 模式,管理客户端运行在浏览器网页上。
本项目是一个简单的数据库项目,服务端采用 Haskell 和 Rust 联合编写
优点:
## 快速开始
- 轻量:几个可执行文件加两个动态库、一份静态资源,解包即用,没有 Node / Python 之类的运行时依赖
- 部署容易:Linux 与 macOS 一条命令装完并启动,Windows 解压后跑一次安装脚本
- 配置统一:一个 `chusql.toml` 同时管住存储、Web 与命令行
- 账号统一:Web 管理端与命令行共用同一个管理员和同一张账号表
### 安装
## 安装
Linux / macOS(自动识别当前平台,取对应发行包):
Linux / macOS:
```sh
curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web
```
Windows:下载 `chusql-windows-x86_64.zip`,解压后在 PowerShell 里执行
Windows(PowerShell 里下下来再跑;也有下载 zip 解压的包内安装):
```powershell
.\install.ps1 -Component web
irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1"
& "$env:TEMP\install.ps1" -Component web
```
不写 `--component` 时脚本会逐个问「装 cli 吗」「装 web 吗」(默认装 `csql`、不装 Web);只装命令行
客户端就把 `web` 换成 `cli`,两个都要用 `both`。安装位置、目录结构与卸载方式见
[doc/install.md](doc/install.md)。
### 启动
## 启动
```sh
csql
```
启动CLI界面,或
```sh
csql-web
```
浏览器打开 http://127.0.0.1:7778 ,默认账号 `root`,口令是安装时给的那个。服务启动后只有系统库 `system`(里面是账号表),**没有默认工作库**:自己建一个库再用 `USE <库名>` 选中它。
换口令、换端口、改数据目录都在安装时写好的 `chusql.toml` 里。
启动web界面,默认通过7778端口访问
## 文档
## 更多参考文档
| 文档 | 内容 |
| --------------------------------- | ------------------------------------------------------------------------ |
| [安装与卸载](doc/install.md) | 三种安装方式、全部安装选项、装完的目录结构、从源码安装、卸载 |
| [配置选项](doc/config.md) | 配置位置与优先级、全部配置键与默认值、数据目录、口令与安全 |
| [命令与选项](doc/commands.md) | `csql` 与 `chusql-web` 的选项、元命令、账号与角色权限、REST 接口 |
| [架构与组件](doc/architecture.md) | 三个组件怎么分工、一次请求经过什么、数据落在哪 |
- [安装与卸载](docs/install.md)
- [配置选项](docs/config.md)
- [命令与选项](docs/commands.md)
- [架构与组件](docs/architecture.md)
@@ -1,6 +1,6 @@
cabal-version: 2.4
name: chusql-fullchain
name: chusql-benchmark
version: 1.0.0
synopsis: ChuSQL 全链路基准:起真 server,全部请求走 TCP
description: 以基准客户端身份起一个 chusql-server 进程(存储与引擎都在那个进程里),
@@ -8,10 +8,11 @@ description: 以基准客户端身份起一个 chusql-server 进程(存储
本程序不链引擎、不链 server 库,只用 TCP 客户端与协议模型。
build-type: Simple
executable chusql-fullchain
executable chusql-benchmark
main-is: Main.hs
hs-source-dirs: src
build-tool-depends: chusql-server:chusql-server
, chusql-bootstrap:csql-bootstrap
build-depends: base >= 4.14 && < 5
, chusql-core-model
, chusql-interface
@@ -36,6 +36,7 @@ import System.Process (
StdStream (CreatePipe, NoStream),
createProcess,
proc,
readProcessWithExitCode,
terminateProcess,
waitForProcess,
)
@@ -350,6 +351,16 @@ locateServerExe = do
putStrLn "chusql-server was not found on PATH: run `stack build` first"
exitFailure
-- | 在 PATH 里找引导程序(server 需要先引导)
locateBootstrapExe :: IO FilePath
locateBootstrapExe = do
found <- findExecutable (binaryName "csql-bootstrap")
case found of
Just path -> pure path
Nothing -> do
putStrLn "csql-bootstrap was not found on PATH: run `stack build` first"
exitFailure
-- | 从 server 输出里读出监听端口
readListeningPort :: Handle -> IO Int
readListeningPort handle = do
@@ -396,7 +407,7 @@ startBench = do
bin <- locateServerExe
tmp <- getTemporaryDirectory
stamp <- getMonotonicTime
let name = "chusql-fullchain-" ++ show (round (stamp * 1e6) :: Int)
let name = "chusql-benchmark-" ++ show (round (stamp * 1e6) :: Int)
dataDir = tmp </> name
configPath = tmp </> (name ++ ".toml")
-- TOML 的普通字符串会吃反斜杠,路径统一用正斜杠
@@ -405,6 +416,13 @@ startBench = do
writeFile configPath (benchConfigText slashed)
printf "config : %s\n" configPath
printf "data dir : %s\n" dataDir
bootstrap <- locateBootstrapExe
(bootCode, bootOut, bootErr) <- readProcessWithExitCode bootstrap ["--config", configPath, "--passwordless"] ""
case bootCode of
ExitSuccess -> printf "bootstrap: system catalog ready\n"
_ -> do
putStrLn ("the bootstrap program failed (exit " ++ show bootCode ++ "): " ++ bootOut ++ bootErr)
exitFailure
(_, Just out, _, process) <-
createProcess (proc bin ["--config", configPath]){std_out = CreatePipe, std_err = NoStream}
port <- readListeningPort out
@@ -418,7 +436,7 @@ startBench = do
exitFailure
Right client -> do
session <- newSession client
auth <- authenticateSession session (T.pack "admin") (T.pack "s3cret")
auth <- authenticateSession session (T.pack "admin") (T.pack "")
case auth of
Left err -> do
putStrLn ("cannot sign in: " ++ T.unpack err)
@@ -429,13 +447,12 @@ startBench = do
prepareDatabase session
pure (Bench process dataDir client session)
-- | 基准用的配置:管理员凭据、随机端口、临时数据目录
-- | 基准用的配置:管理员名字、随机端口、临时数据目录
benchConfigText :: String -> String
benchConfigText dataDir =
unlines
[ "[web]"
, "user = \"admin\""
, "password = \"s3cret\""
, ""
, "[server]"
, "host = \"127.0.0.1\""
+12
View File
@@ -0,0 +1,12 @@
resolver: lts-24.59
extra-lib-dirs:
- ../chusql-core/storage/target/release
packages:
- .
- ../chusql-core/engine
- ../chusql-core/model
- ../chusql-interface
- ../chusql-server
- ../chusql-bootstrap
File renamed without changes.
+158
View File
@@ -0,0 +1,158 @@
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
import ChuSQL.Interface.Auth (hashPassword)
import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName)
import ChuSQL.Interface.Settings (readSettingsFile)
import ChuSQL.Interface.TOML (resolveConfigPath)
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
-- 引导程序:建系统库与管理员账号,装完即退,留在 bin 里备用。
data Options = Options
{ optConfig :: Maybe FilePath
, optUser :: Maybe String
, optPasswordStdin :: Bool
, optPasswordless :: Bool
, optHelp :: Bool
}
-- | 全部选项都取默认值
emptyOptions :: Options
emptyOptions =
Options
{ optConfig = Nothing
, optUser = Nothing
, optPasswordStdin = False
, optPasswordless = False
, optHelp = False
}
-- | 解析参数
parseArgs :: [String] -> Either String Options
parseArgs = go emptyOptions
where
-- | 逐条消费参数列表
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 ("--user" : v : rest) = go opts{optUser = Just v} rest
go opts ("--password-stdin" : rest) = go opts{optPasswordStdin = True} rest
go opts ("--passwordless" : rest) = go opts{optPasswordless = True} rest
go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
-- | 打印用法说明
usage :: IO ()
usage = do
putStrLn "usage: csql-bootstrap [options]"
putStrLn ""
putStrLn "config: chusql.toml sits at a fixed place (Windows: %APPDATA%\\ChuSQL\\chusql.toml;"
putStrLn " other: $XDG_CONFIG_HOME/ChuSQL/chusql.toml), the same file the server reads"
putStrLn ""
putStrLn " --config FILE read that config file instead"
putStrLn " --user NAME administrator name ([web] user, default root)"
putStrLn " --password-stdin read the administrator password from one line of stdin"
putStrLn " --passwordless leave the administrator without a password"
putStrLn ""
putStrLn "what it does: creates the system database, the __system_users table and the"
putStrLn " administrator row, then exits. It never changes an existing account, and it"
putStrLn " never deletes data, so the installer and later repairs can run it again."
-- | 入口
main :: IO ()
main = do
hSetBuffering stdout LineBuffering
args <- getArgs
case parseArgs args of
Left err -> do
putStrLn ("bad arguments: " ++ err)
usage
exitFailure
Right opts
| optHelp opts -> usage
| otherwise -> run opts
-- | 读配置、算口令哈希、发一条引导请求
run :: Options -> IO ()
run opts = do
configPath <- resolveConfigPath (optConfig opts)
base <- loadWebConfigAt configPath
saved <- readSettingsFile configPath
let name = maybe (rootUserName base saved) T.pack (optUser opts)
chosen <- readPassword opts
case chosen of
Left err -> do
putStrLn ("!! " ++ err)
usage
exitFailure
Right plain -> do
encoded <- if T.null plain then pure "" else hashPassword plain
putStrLn "================== ChuSQL Bootstrap ================="
putStrLn ("config file: " ++ configPath)
putStrLn ("administrator: " ++ T.unpack name)
putStrLn
( if T.null encoded
then "password: none yet (sign in with an empty one, then set it)"
else "password: set (stored hashed in the system table)"
)
opened <- localStorageLink (Just configPath)
case opened of
Left err -> failWith ("cannot open the storage library: " ++ err)
Right link -> do
setStorageLink link
reply <- sendRawRequest (BL.toStrict (A.encode (bootstrapRequest name encoded)))
closeConnection
report reply
-- | 引导请求:建表、插管理员行
bootstrapRequest :: Text -> Text -> A.Value
bootstrapRequest name encoded =
A.object
[ "method" A..= ("bootstrap_system" :: Text)
, "user" A..= name
, "password_hash" A..= encoded
]
-- | 看应答:system 就是成功,其余按错误处理
report :: Either String BS.ByteString -> IO ()
report (Left err) = failWith ("cannot talk to the storage library: " ++ err)
report (Right raw) = case A.eitherDecodeStrict raw of
Right (A.Object fields)
| KM.lookup "status" fields == Just (A.String "system") ->
putStrLn "system catalog: ready"
| otherwise ->
failWith ("bootstrap failed: " ++ message fields)
Right _ -> failWith ("unexpected reply from the storage library: " ++ show raw)
Left err -> failWith ("the storage library answered something that is not JSON: " ++ err)
where
-- | 取错误文本
message fields = case KM.lookup "message" fields of
Just (A.String text) -> T.unpack text
_ -> show raw
-- | 读口令:stdin 一行,空行等于不设口令
readPassword :: Options -> IO (Either String Text)
readPassword opts
| optPasswordless opts = pure (Right "")
| optPasswordStdin opts = do
line <- TIO.getLine
pure (Right (T.dropWhileEnd (\c -> c == '\r' || c == '\n') line))
| otherwise = pure (Left "pass --password-stdin or --passwordless")
-- | 打印错误并退出 1
failWith :: String -> IO a
failWith message = do
putStrLn ("!! " ++ message)
exitFailure
+20
View File
@@ -0,0 +1,20 @@
cabal-version: 2.4
name: chusql-bootstrap
version: 1.0.0
synopsis: ChuSQL 引导程序:建系统库与管理员账号
description: ChuSQL 初始化引导。首次启动前建系统库、账号表与管理员行,
装完即退,保留在 bin 里备用。后续的 catalog 修复也走这里。
build-type: Simple
executable csql-bootstrap
hs-source-dirs: app
main-is: Main.hs
build-depends: base >= 4.14 && < 5
, aeson
, bytestring
, chusql-core-engine
, chusql-interface
, text
default-language: Haskell2010
ghc-options: -Wall
@@ -8,4 +8,3 @@ packages:
- ../chusql-core/engine
- ../chusql-core/model
- ../chusql-interface
- ../chusql-server
+12
View File
@@ -0,0 +1,12 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/topics/lock_files
packages: []
snapshots:
- completed:
sha256: 0f728e30e843d7f00460ad56858b995a3b227fca683659c7df9f2fc3988a3ce1
size: 732465
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/59.yaml
original: lts-24.59
+4 -16
View File
@@ -11,15 +11,13 @@ import ChuSQL.CLI.Session (
newSession,
switchDatabase,
)
import ChuSQL.Interface.Auth (Credential (..))
import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, resolveCredential, resolvePlainPassword)
import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
import ChuSQL.Interface.Link (Client, closeClient, connectClient)
import ChuSQL.Interface.Settings (readSettingsFile)
import ChuSQL.Interface.TOML (resolveConfigPath)
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
@@ -35,7 +33,6 @@ import System.IO (hSetEncoding, stderr, stdout, utf8)
data Options = Options
{ optUser :: Maybe Text
, optPromptPassword :: Bool
, optDatabase :: Text
, optFormat :: OutputFormat
, optExecute :: Maybe Text
@@ -48,7 +45,6 @@ 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"
@@ -94,11 +90,10 @@ main = do
configPath <- resolveConfigPath (optConfig options)
base <- loadWebConfigAt configPath
saved <- readSettingsFile configPath
credential <- resolveCredential base saved
config <- loadServerConfigAt configPath
let rootName = credUser credential
let rootName = rootUserName base saved
userName = fromMaybe rootName (optUser options)
password <- resolvePassword (optPromptPassword options) userName rootName saved
password <- promptPassword userName
connected <- connectClient (T.pack (scHost config)) (scPort config)
case connected of
Left message -> reportError message >> exitFailure
@@ -141,14 +136,7 @@ selectDatabase session wanted
Left message -> reportError message >> pure False
Right () -> pure True
-- | 决定口令是交互输入还是取自配置
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 (resolvePlainPassword saved)
| otherwise = promptPassword userName
-- | 交互式读取口令
-- | 交互式读取口令;直接回车表示空口令
promptPassword :: Text -> IO Text
promptPassword user = do
entered <- runInputT defaultSettings (getPassword (Just '*') (T.unpack user <> "'s password: "))
+1 -1
View File
@@ -100,7 +100,7 @@ errorHint message
| "unknown column" `T.isInfixOf` lowered = Just "run \\d <table> to see the columns of a table"
| "unknown database" `T.isInfixOf` lowered = Just "run \\l to list the databases"
| "syntax" `T.isInfixOf` lowered = Just "one statement at a time, and every statement ends with a semicolon"
| "invalid user name or password" `T.isInfixOf` lowered = Just "check --user and the password"
| "invalid user name or password" `T.isInfixOf` lowered = Just "check --user and the password; an empty password works only while the account has none"
| "sign in first" `T.isInfixOf` lowered = Just "the session expired, restart the CLI"
| "too many failed sign-in attempts" `T.isInfixOf` lowered = Just "wait a few minutes before trying again"
| otherwise = Nothing
-82
View File
@@ -1,82 +0,0 @@
module Main where
import ChuSQL.Core.Engine.Algebra.Op (renderPlan)
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
import ChuSQL.Core.Engine.Algebra.Planner (translate)
import ChuSQL.Core.Engine
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Engine.Syntax.Parser
-- 命令行演示入口:跑几条语句并打印结果与优化前后的计划。
users :: Table
users =
Table
{ tableName = "users"
, tableCols = [("id", TInt), ("name", TStr), ("age", TInt)]
, tableRows =
[ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
, [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
, [("id", VInt 3), ("name", VStr "Carol"), ("age", VInt 30)]
]
}
orders :: Table
orders =
Table
{ tableName = "orders"
, tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)]
, tableRows =
[ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")]
, [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
, [("id", VInt 3), ("user_id", VInt 1), ("product", VStr "Cup")]
]
}
db :: Database
db = [("users", users), ("orders", orders)]
-- | 跑演示语句,打印结果与优化前后的计划
main :: IO ()
main = do
putStrLn "==================== Engine ====================="
let q1 = makeSelect ["name"] "users" (Just (Gt (Col "age") (LitInt 18)))
print (rowsOf (runStatement db q1))
let q2 = makeSelect ["*"] "users" Nothing
print (rowsOf (runStatement db q2))
let q3 = makeSelect ["name"] "nonexistent" Nothing
print (rowsOf (runStatement db q3))
let q4 =
makeSelect
["name"]
"users"
( Just
( Or
(Lt (Col "age") (LitInt 18))
(Gt (Col "age") (LitInt 30))
)
)
print (rowsOf (runStatement db q4))
let parsed = parseStatement "SELECT name FROM users WHERE age > 18 AND name = 'Alice'"
print (rowsOf (parsed >>= runStatement db))
putStrLn "\n==================== Optimizer ====================="
let planSql =
"SELECT u.name, o.product FROM users u \
\JOIN orders o ON u.id = o.user_id WHERE u.age > 18"
case parseStatement planSql of
Left err -> putStrLn err
Right query -> case translate query of
Left err -> putStrLn err
Right plan -> do
putStrLn "--- plan before optimization ---"
putStrLn (renderPlan plan)
putStrLn "--- plan after optimization ---"
putStrLn (renderPlan (optimize db plan))
putStrLn "--- rows ---"
print (rowsOf (runStatement db query))
+8 -16
View File
@@ -9,13 +9,18 @@ build-type: Simple
library
hs-source-dirs: src
exposed-modules: ChuSQL.Core.Engine.Algebra.Eval
exposed-modules: ChuSQL.Core.Engine.Algebra.Cost
ChuSQL.Core.Engine.Algebra.Eval
ChuSQL.Core.Engine.Algebra.Expr
ChuSQL.Core.Engine.Algebra.JoinOrder
ChuSQL.Core.Engine.Algebra.Op
ChuSQL.Core.Engine.Algebra.Optimize
ChuSQL.Core.Engine.Algebra.Planner
ChuSQL.Core.Engine.Algebra.Sort
ChuSQL.Core.Engine.Builtin
ChuSQL.Core.Engine.Error
ChuSQL.Core.Engine
ChuSQL.Core.Engine.Parallel
ChuSQL.Core.Engine.Semantic
ChuSQL.Core.Engine.Storage
ChuSQL.Core.Engine.Storage.FFI
@@ -42,20 +47,6 @@ library
default-language: Haskell2010
ghc-options: -Wall
executable chusql-core-engine
main-is: Main.hs
hs-source-dirs: app
build-depends: base
, chusql-core-engine
, chusql-core-model
default-language: Haskell2010
ghc-options: -Wall
-- 运行期找 libchusql_core_storage.so:$ORIGIN 让二进制与动态库同目录即可
if os(linux)
ld-options: -Wl,-rpath,$ORIGIN
if os(osx)
ld-options: -Wl,-rpath,@loader_path
test-suite chusql-core-engine-test
type: exitcode-stdio-1.0
main-is: Spec.hs
@@ -65,6 +56,7 @@ test-suite chusql-core-engine-test
, chusql-core-model
, directory
, filepath
, hashable
, hspec
default-language: Haskell2010
ghc-options: -Wall
ghc-options: -Wall -threaded
+43 -28
View File
@@ -11,6 +11,7 @@ import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage))
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
import Data.Maybe (mapMaybe)
import qualified Data.HashSet as HS
-- 引擎入口:检查语义、按语句分发执行,另有内存实现与泛型版本。
@@ -86,13 +87,15 @@ runStatementUncheckedM db (Update tbl assigns mWhere) =
rowsResult <- scan tbl
case rowsResult of
Left err -> pure (Left err)
Right rows -> do
newRows <- mapM (updateRowM db table mWhere assigns) rows
case sequence newRows of
Left err -> pure (Left err)
Right rs -> do
result <- replaceAll tbl rs
pure (result >> Right [])
Right rows -> case checkPlan table of
Left err -> pure (Left err)
Right plan -> do
newRows <- mapM (updateRowM db table plan mWhere assigns) rows
case sequence newRows of
Left err -> pure (Left err)
Right rs -> do
result <- replaceAll tbl rs
pure (result >> Right [])
runStatementUncheckedM _ (CreateTable name cols) = do
result <- createTable name cols
pure (result >> Right [])
@@ -156,7 +159,8 @@ buildRows table current cols rows = do
-- | 逐行构造,最后统一查一遍约束
go _ _ [] acc = do
let built = reverse acc
mapM_ (runChecks table) built
plan <- checkPlan table
mapM_ (runChecks plan) built
enforceNotNull (tableCols table) built
enforceUnique (tableCols table) (current ++ built)
Right built
@@ -208,19 +212,29 @@ autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup
[] -> 1
ns -> maximum ns + 1
-- | 执行 CHECK 约束
runChecks :: Table -> Row -> Either String ()
runChecks table row = mapM_ check (tableCols table)
-- | 一次解析出来的 CHECK 条件
type CheckPlan = [(String, Expr)]
-- | 把表上的 CHECK 文本解析成条件,每语句只解析一次
checkPlan :: Table -> Either String CheckPlan
checkPlan table = mapM parse (mapMaybe checked (tableCols table))
where
-- | 查这一列的 CHECK
check (name, col) = case columnCheck col of
Nothing -> Right ()
Just text -> case parseExpression text of
Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
Right e -> case evalCondForRow e row of
Left err -> Left ("CHECK on " ++ name ++ ": " ++ err)
Right True -> Right ()
Right False -> Left ("CHECK on " ++ name ++ " failed")
-- | 只挑出带 CHECK 文本的列
checked (name, col) = (,) name <$> columnCheck col
-- | 解析一列的 CHECK 文本
parse (name, text) = case parseExpression text of
Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
Right e -> Right (name, e)
-- | 执行解析好的 CHECK 条件
runChecks :: CheckPlan -> Row -> Either String ()
runChecks plan row = mapM_ check plan
where
-- | 跑一条 CHECK
check (name, e) = case evalCondForRow e row of
Left err -> Left ("CHECK on " ++ name ++ ": " ++ err)
Right True -> Right ()
Right False -> Left ("CHECK on " ++ name ++ " failed")
-- | 只取第一行(报错提示用)
firstLine :: String -> String
@@ -242,18 +256,18 @@ enforceUnique cols rows = mapM_ check targets
where
targets = [(n, c) | (n, c) <- cols, columnUnique c || columnPrimaryKey c]
-- | 查这一列有没有重复值
check (name, _) = go name [] (mapMaybe (lookup name) rows)
check (name, _) = go name HS.empty (mapMaybe (lookup name) rows)
-- | 逐个值比过去
go _ _ [] = Right ()
-- | NULL 不算冲突,跳过
go name seen (VNull : rest) = go name seen rest
go name seen (v : rest)
| v `elem` seen = Left ("UNIQUE: duplicate value in column " ++ name)
| otherwise = go name (v : seen) rest
| HS.member (canonicalValue v) seen = Left ("UNIQUE: duplicate value in column " ++ name)
| otherwise = go name (HS.insert (canonicalValue v) seen) rest
-- | UPDATE 的一行(条件与赋值都可能带子查询)
updateRowM :: (MonadStorage m) => Database -> Table -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row)
updateRowM db table cond asgns row = do
updateRowM :: (MonadStorage m) => Database -> Table -> CheckPlan -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row)
updateRowM db table plan cond asgns row = do
keep <- case cond of
Nothing -> pure (Right True)
Just e -> evalCondForRowM db e row
@@ -262,7 +276,7 @@ updateRowM db table cond asgns row = do
Right False -> pure (Right row)
Right True -> do
row' <- applyUpdatesM db table asgns row
pure (row' >>= \r -> runChecks table r >> Right r)
pure (row' >>= \r -> runChecks plan r >> Right r)
-- | 依次求值、收类型并覆盖列(表达式可以带子查询)
applyUpdatesM :: (MonadStorage m) => Database -> Table -> [(String, Expr)] -> Row -> m (Either String Row)
@@ -316,8 +330,9 @@ alterTable db tbl change = case lookupTable db tbl of
where
-- | 改完再统一查一遍约束
checkAltered (cols, rows) = do
let table = Table tbl cols rows
mapM_ (runChecks table) rows
let table = Table tbl cols rows Nothing
plan <- checkPlan table
mapM_ (runChecks plan) rows
enforceNotNull cols rows
enforceUnique cols rows
Right (cols, rows)
@@ -0,0 +1,31 @@
module ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf, probeCost, pointRows, rangeRows, indexCheaper) where
import ChuSQL.Core.Model
-- 统计与成本估算:行数、列级不同值数与索引探路页数。
-- | 表统计,拿不到就是 Nothing
tableMetaOf :: Database -> String -> Maybe TableMeta
tableMetaOf db t = lookup t db >>= tableMeta
-- | 索引探路的页数:B+Tree 高度
probeCost :: Int -> Int
probeCost rows = max 1 (ceiling (logBase 2 (fromIntegral (max 2 rows) :: Double)))
-- | 等值点查的估算命中行数:行数除以该列不同值数
pointRows :: TableMeta -> String -> Int
pointRows m col = case [d | (c, d, _) <- metaDistinct m, c == col, d > 1] of
(d : _) -> max 1 (rows `div` d)
[] -> rows
where
rows = max 0 (metaRowCount m)
-- | 范围扫描的估算命中行数:没有直方图,按四分之一算
rangeRows :: TableMeta -> Int
rangeRows m = max 0 (metaRowCount m) `div` 4
-- | 有索引且探路加命中比全表扫便宜
indexCheaper :: TableMeta -> String -> Int -> Bool
indexCheaper m col est = col `elem` metaIndexes m && probeCost rows + est < rows
where
rows = max 0 (metaRowCount m)
@@ -1,15 +1,17 @@
module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
import ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf)
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
import ChuSQL.Core.Engine.Algebra.Optimize (optimize, relOpCols)
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
import ChuSQL.Core.Engine.Algebra.Op
import ChuSQL.Core.Engine.Algebra.Planner (translate)
import ChuSQL.Core.Engine.Algebra.Sort (compareValue, sortRows)
import ChuSQL.Core.Engine.Algebra.Sort (sortRows)
import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, invokeBuiltin, unsupportedAggregate)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage)
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Subquery (..))
import Control.Monad (filterM, foldM)
import Control.Monad (filterM)
import qualified Data.HashMap.Strict as HM
-- 执行:按算子树算出结果行,外层行供相关子查询引用。
@@ -58,17 +60,10 @@ rowsCols :: [Row] -> [String]
rowsCols (r : _) = map fst r
rowsCols [] = []
-- | 参与等值匹配的键:NULL 不参与,整数值的浮点归一
-- | 参与等值匹配的键:NULL 不参与,整值浮点归一
joinKey :: Value -> Maybe Value
joinKey VNull = Nothing
joinKey (VFloat d)
| not (isNaN d)
, not (isInfinite d)
, fromIntegral (rounded :: Integer) == d =
Just (VInt (fromIntegral rounded))
where
rounded = round d :: Integer
joinKey v = Just v
joinKey v = Just (canonicalValue v)
-- | 取一行的连接键
joinKeyOf :: String -> Row -> Maybe Value
@@ -230,57 +225,13 @@ groupRows keys rows = go rows (HM.empty, [])
valuesOf :: Row -> Expr -> [Row] -> Either String [Value]
valuesOf outer e rows = mapM (evalExpr e . (++ outer)) rows
-- | 去掉 NULL
nonNull :: [Value] -> [Value]
nonNull = filter (/= VNull)
-- | 数值相加:整数配整数还是整数
addValue :: Value -> Value -> Either String Value
addValue (VInt a) (VInt b) = Right (VInt (a + b))
addValue (VInt a) (VFloat b) = Right (VFloat (fromIntegral a + b))
addValue (VFloat a) (VInt b) = Right (VFloat (a + fromIntegral b))
addValue (VFloat a) (VFloat b) = Right (VFloat (a + b))
addValue _ _ = Left "type error: expected two numbers"
-- | 能当数用的值
numberOf :: Value -> Either String Double
numberOf (VInt n) = Right (fromIntegral n)
numberOf (VFloat d) = Right d
numberOf _ = Left "type error: expected a number"
-- | 一组值里的极值(NULL 已经先剔掉)
extremeOf :: (Value -> Value -> Value) -> [Value] -> Either String Value
extremeOf _ [] = Right VNull
extremeOf pick (x : xs) = Right (foldl pick x xs)
-- | 一个聚合算子在一组行上的结果
-- | 一个聚合算子在一组行上的结果,统一走内置函数权威
evalAgg :: Row -> Expr -> [Row] -> Either String Value
evalAgg outer agg rows = case agg of
CountAll -> Right (VInt (length rows))
CountOf e -> do
vs <- valuesOf outer e rows
Right (VInt (length (nonNull vs)))
SumOf e -> do
vs <- valuesOf outer e rows
case nonNull vs of
[] -> Right VNull
xs -> foldM addValue (VInt 0) xs
AvgOf e -> do
vs <- valuesOf outer e rows
case nonNull vs of
[] -> Right VNull
xs -> do
total <- foldM addValue (VInt 0) xs
sumOf <- numberOf total
Right (VFloat (sumOf / fromIntegral (length xs)))
MinOf e -> valuesOf outer e rows >>= extremeOf lower . nonNull
MaxOf e -> valuesOf outer e rows >>= extremeOf higher . nonNull
_ -> Left "only COUNT, SUM, AVG, MIN and MAX can be aggregated"
where
-- | 取更小的那个
lower a b = if compareValue b a == LT then b else a
-- | 取更大的那个
higher a b = if compareValue b a == GT then b else a
evalAgg outer agg rows = case builtinOfExpr agg of
Nothing -> Left unsupportedAggregate
Just builtin -> do
vs <- maybe (Right []) (\e -> valuesOf outer e rows) (aggregateArg agg)
invokeBuiltin builtin (length rows) vs
-- | 一组的输出行:分组列 + 各聚合值
oneGroup :: Row -> [String] -> [(String, Expr)] -> ([Value], [Row]) -> Either String Row
@@ -429,8 +380,8 @@ evalRelOpIn db outer (Compute items op) = do
evalRelOpIn db outer (Aggregate keys aggs op) = do
rows <- evalRelOpIn db outer op
pure (rows >>= evalAggregate outer keys aggs)
evalRelOpIn _ _ (Scan mAlias tbl cols) = do
res <- maybe (scan tbl) (scanColumns tbl) cols
evalRelOpIn db _ (Scan mAlias tbl cols) = do
res <- scanTable db tbl cols
pure (fmap (prefixRows mAlias) res)
evalRelOpIn db outer (Lookup mAlias tbl col k) = do
res <- lookupByColumn tbl col k
@@ -487,8 +438,23 @@ scanFiltered ::
String ->
Expr ->
m (Either String [Row])
scanFiltered _ outer mAlias tbl cond = do
res <- scan tbl
scanFiltered db outer mAlias tbl cond = do
res <- scanTable db tbl Nothing
pure $ do
rows <- res
filterM (evalCondForRow cond . (++ outer)) (prefixRows mAlias rows)
-- | 行数到阈值才值得并行分片
parallelRowThreshold :: Int
parallelRowThreshold = 1000
-- | 表够大且存储支持并行时按分片扫,否则顺序扫
scanTable :: (MonadStorage m) => Database -> String -> Maybe [String] -> m (Either String [Row])
scanTable db tbl cols = do
width <- parallelShards
if width > 1 && rows >= parallelRowThreshold
then scanShards width tbl cols
else maybe (scan tbl) (scanColumns tbl) cols
where
-- | 统计里的行数,没有统计算 0
rows = maybe 0 metaRowCount (tableMetaOf db tbl)
@@ -1,8 +1,8 @@
module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, inValues, threeValuedNot) where
module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot) where
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST
import Control.Monad (join)
import ChuSQL.Core.Engine.Builtin (Operator (..), executeOperator, inValues, threeValuedNot)
-- 表达式求值:三值逻辑,NULL 参与运算结果仍是 NULL。
@@ -18,22 +18,18 @@ evalExpr (LitBool b) _ = Right (VBool b)
evalExpr (LitDate s) _ = Right (VStr s)
evalExpr (LitTimestamp s) _ = Right (VStr s)
evalExpr (LitBlob s) _ = Right (VStr s)
evalExpr (Add a b) row = liftArith addArith a b row
evalExpr (Sub a b) row = liftArith subArith a b row
evalExpr (Mul a b) row = liftArith mulArith a b row
evalExpr (Div a b) row = liftArith divArith a b row
evalExpr (Add a b) row = liftOperator OpAdd a b row
evalExpr (Sub a b) row = liftOperator OpSub a b row
evalExpr (Mul a b) row = liftOperator OpMul a b row
evalExpr (Div a b) row = liftOperator OpDiv a b row
evalExpr (Neg a) row = do
v <- evalExpr a row
case v of
VNull -> Right VNull
VInt n -> Right (VInt (negate n))
VFloat d -> Right (VFloat (negate d))
_ -> Left "type error: expected a number"
evalExpr (Gt a b) row = liftCompare (> EQ) a b row
evalExpr (Lt a b) row = liftCompare (< EQ) a b row
evalExpr (Eq a b) row = liftCompare (== EQ) a b row
evalExpr (And a b) row = liftBool andValues a b row
evalExpr (Or a b) row = liftBool orValues a b row
executeOperator OpNeg [v]
evalExpr (Gt a b) row = liftOperator OpGt a b row
evalExpr (Lt a b) row = liftOperator OpLt a b row
evalExpr (Eq a b) row = liftOperator OpEq a b row
evalExpr (And a b) row = liftOperator OpAnd a b row
evalExpr (Or a b) row = liftOperator OpOr a b row
evalExpr (IsNull a) row = do
v <- evalExpr a row
Right (VBool (v == VNull))
@@ -54,21 +50,6 @@ evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
subqueryNeedsDatabase :: String
subqueryNeedsDatabase = "subquery needs a database to run"
-- | IN 三值逻辑:命中为真,碰 NULL 得 NULL
inValues :: Value -> [Value] -> Either String Value
inValues VNull _ = Right VNull
inValues v vs = do
results <- mapM (compareValues (== EQ) v) vs
Right $
if VBool True `elem` results
then VBool True
else if VNull `elem` results then VNull else VBool False
-- | NOT 的三值取反
threeValuedNot :: Value -> Value
threeValuedNot (VBool b) = VBool (not b)
threeValuedNot _ = VNull
-- | 表达式用到了哪些列
colsInExpr :: Expr -> [String]
colsInExpr (Col c) = [c]
@@ -95,6 +76,24 @@ colsInExpr (InList a es _) = colsInExpr a ++ concatMap colsInExpr es
colsInExpr (ExistsSub sq _) = subqueryRefs sq
colsInExpr _ = []
-- | 表达式里有没有除法(除法可能报错,不能提前或延后求值)
hasDivision :: Expr -> Bool
hasDivision e = case e of
Div _ _ -> True
Neg a -> hasDivision a
Add a b -> both a b
Sub a b -> both a b
Mul a b -> both a b
Gt a b -> both a b
Lt a b -> both a b
Eq a b -> both a b
And a b -> both a b
Or a b -> both a b
_ -> False
where
-- | 两个子表达式里任意一个有除法
both a b = hasDivision a || hasDivision b
-- | 表达式里有没有子查询
hasSubquery :: Expr -> Bool
hasSubquery e = case e of
@@ -188,107 +187,9 @@ evalCondForRow e row = do
VNull -> Right False
_ -> Left "type error: WHERE condition must be a boolean"
-- | 把二元运算提升到 Either
liftBinOp ::
(Value -> Value -> Either String Value) ->
Expr ->
Expr ->
Row ->
Either String Value
liftBinOp f a b row = join (f <$> evalExpr a row <*> evalExpr b row)
-- | 整数算术与浮点算术成对出现
data Arith = Arith
{ arithInt :: Int -> Int -> Either String Int
, arithFloat :: Double -> Double -> Either String Double
}
-- | 一边是 NULL 就出 NULL,两边都是整数就出整数
liftArith :: Arith -> Expr -> Expr -> Row -> Either String Value
liftArith ops a b row = liftBinOp go a b row
where
-- | NULL 出 NULL,整数配整数走整数算术
go VNull _ = Right VNull
go _ VNull = Right VNull
go (VInt x) (VInt y) = VInt <$> arithInt ops x y
go x y = case (asDouble x, asDouble y) of
(Just p, Just q) -> VFloat <$> arithFloat ops p q
_ -> Left "type error: expected two numbers"
-- | 能当数用的值
asDouble :: Value -> Maybe Double
asDouble (VInt n) = Just (fromIntegral n)
asDouble (VFloat d) = Just d
asDouble _ = Nothing
-- | 加法
addArith :: Arith
addArith = Arith (\x y -> Right (x + y)) (\x y -> Right (x + y))
-- | 减法
subArith :: Arith
subArith = Arith (\x y -> Right (x - y)) (\x y -> Right (x - y))
-- | 乘法
mulArith :: Arith
mulArith = Arith (\x y -> Right (x * y)) (\x y -> Right (x * y))
-- | 整数除法向零截断,溢出返回错误;浮点除法不能除以零
divArith :: Arith
divArith = Arith intDiv floatDiv
where
-- | 整数除法:除零与溢出都报错
intDiv _ 0 = Left "division by zero"
intDiv x y
| x == minBound && y == -1 = Left "integer division overflow"
| otherwise = Right (x `quot` y)
-- | 浮点除法:不能除以零
floatDiv _ 0 = Left "division by zero"
floatDiv x y = Right (x / y)
-- | 比较:任一侧是 NULL 就给 NULL
liftCompare ::
(Ordering -> Bool) ->
Expr ->
Expr ->
Row ->
Either String Value
liftCompare rel a b row = liftBinOp (compareValues rel) a b row
-- | 比较两个值:NULL 给 NULL,其余按数、串、布尔比
compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
compareValues rel x y
| x == VNull || y == VNull = Right VNull
| Just p <- asDouble x, Just q <- asDouble y = Right (VBool (rel (compare p q)))
| (VStr p, VStr q) <- (x, y) = Right (VBool (rel (compare p q)))
| (VBool p, VBool q) <- (x, y) = Right (VBool (rel (compare p q)))
| otherwise = Left "type error: cannot compare these values"
-- | 布尔二元运算
liftBool ::
(Value -> Value -> Either String Value) ->
Expr ->
Expr ->
Row ->
Either String Value
liftBool f = liftBinOp f
-- | 逻辑与的三值真值表
andValues :: Value -> Value -> Either String Value
andValues (VBool False) _ = Right (VBool False)
andValues _ (VBool False) = Right (VBool False)
andValues (VBool True) (VBool True) = Right (VBool True)
andValues VNull (VBool True) = Right VNull
andValues (VBool True) VNull = Right VNull
andValues VNull VNull = Right VNull
andValues _ _ = Left "type error: expected two booleans"
-- | 逻辑或的三值真值表
orValues :: Value -> Value -> Either String Value
orValues (VBool True) _ = Right (VBool True)
orValues _ (VBool True) = Right (VBool True)
orValues (VBool False) (VBool False) = Right (VBool False)
orValues VNull (VBool False) = Right VNull
orValues (VBool False) VNull = Right VNull
orValues VNull VNull = Right VNull
orValues _ _ = Left "type error: expected two booleans"
-- | 二元运算节点统一走运算符权威
liftOperator :: Operator -> Expr -> Expr -> Row -> Either String Value
liftOperator op a b row = do
x <- evalExpr a row
y <- evalExpr b row
executeOperator op [x, y]
@@ -0,0 +1,197 @@
module ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins) where
import ChuSQL.Core.Engine.Algebra.Cost (pointRows, rangeRows, tableMetaOf)
import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, hasDivision)
import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
import ChuSQL.Core.Model
import Data.List (partition)
-- 内连接链顺序优化:按统计估算中间结果,只在行序不可观察处重排。
-- | 重排入口:顶层行序可观察
reorderJoins :: Database -> RelOp -> RelOp
reorderJoins db = pass db False
-- | 往下带“行序是否不可观察”,可观察时不动内连接
pass :: Database -> Bool -> RelOp -> RelOp
pass db _ (Sort spec x) = Sort spec (pass db True x)
pass db _ (Limit n x) = Limit n (pass db False x)
pass db _ (Aggregate keys aggs x) = Aggregate keys aggs (pass db False x)
pass db free (Project cols x) = Project cols (pass db free x)
pass db free (Compute items x) = Compute items (pass db free x)
pass db free (Filter p x) = Filter p (pass db free x)
pass db free (Join kind l r c)
| free
, Just (leaves, conds) <- innerChain (Join kind l r c)
, length leaves > 1
, Just order <- cheaperOrder db leaves conds =
rebuildChain db (map (pass db free) order) conds
| otherwise = Join kind (pass db free l) (pass db free r) c
pass _ _ op = op
-- | 把内连接链拆成叶子与条件,遇到外连接就放弃
innerChain :: RelOp -> Maybe ([RelOp], [Expr])
innerChain (Join InnerJoin l r c) = do
(ls, lcs) <- innerChain l
(rs, rcs) <- innerChain r
pure (ls ++ rs, lcs ++ rcs ++ [c])
innerChain (Join _ _ _ _) = Nothing
innerChain op = Just ([op], [])
-- | 叶子算子的估算行数,拿不到统计就是 Nothing
leafRows :: Database -> RelOp -> Maybe Int
leafRows db op = case op of
Scan _ t _ -> rowCountOf db t
Lookup _ t c _ -> pointRows <$> tableMetaOf db t <*> pure c
Range _ t _ _ _ -> rangeRows <$> tableMetaOf db t
Filter p x -> scaleRows db p x <$> leafRows db x
Project _ x -> leafRows db x
_ -> Nothing
-- | 表统计里的行数
rowCountOf :: Database -> String -> Maybe Int
rowCountOf db t = metaRowCount <$> tableMetaOf db t
-- | 过滤之后的大致行数:等值看不同值数,其他按四分之一
scaleRows :: Database -> Expr -> RelOp -> Int -> Int
scaleRows db p x rows = case p of
Eq (Col k) _ -> case distinctOf db x k of
Just d | d > 1 -> max 1 (rows `div` d)
_ -> quarter
Gt _ _ -> quarter
Lt _ _ -> quarter
And a b -> max 1 (min (scaleRows db a x rows) (scaleRows db b x rows))
_ -> quarter
where
quarter = max 1 (rows `div` 4)
-- | 叶子对应的别名与表名
leafSource :: RelOp -> Maybe (Maybe String, String)
leafSource (Scan a t _) = Just (a, t)
leafSource (Lookup a t _ _) = Just (a, t)
leafSource (Range a t _ _ _) = Just (a, t)
leafSource (Filter _ x) = leafSource x
leafSource (Project _ x) = leafSource x
leafSource _ = Nothing
-- | 某列在叶子统计里的不同值数
distinctOf :: Database -> RelOp -> String -> Maybe Int
distinctOf db leaf col = do
(alias, t) <- leafSource leaf
m <- tableMetaOf db t
num <- lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
pure num
-- | 若干叶子里某列最大的不同值数
distinctOn :: Database -> [RelOp] -> String -> Maybe Int
distinctOn db leaves col = case [d | leaf <- leaves, Just d <- [distinctOf db leaf col]] of
[] -> Nothing
ds -> Just (maximum ds)
-- | 两侧等值键里较大的不同值数
keyDistinct :: Database -> [RelOp] -> RelOp -> [Expr] -> Maybe Int
keyDistinct db have x conds = case [v | Eq (Col a) (Col b) <- conds, Just v <- [pair a b]] of
(v : _) -> Just v
[] -> Nothing
where
haveCols = concatMap (relOpCols db) have
xCols = relOpCols db x
-- | 这一对列是不是两侧之间的等值键
pair a b
| a `elem` haveCols, b `elem` xCols = bigger (distinctOn db have a) (distinctOf db x b)
| b `elem` haveCols, a `elem` xCols = bigger (distinctOn db have b) (distinctOf db x a)
| otherwise = Nothing
-- | 两个可选统计取大的那个
bigger (Just a) (Just b) = Just (max a b)
bigger (Just a) Nothing = Just a
bigger Nothing (Just b) = Just b
bigger Nothing Nothing = Nothing
-- | 一次连接之后的大致行数
stepRows :: Database -> [RelOp] -> Int -> RelOp -> [Expr] -> Int
stepRows db have acc x conds = case keyDistinct db have x conds of
Just v | v > 1 -> max 1 (acc * rows `div` v)
_ -> acc * rows
where
rows = maybe 1 id (leafRows db x)
-- | 一批叶子按给定顺序连接,累加每一步的中间结果
chainCost :: Database -> [RelOp] -> [Expr] -> Int
chainCost db (l : ls) conds = go [l] (maybe 1 id (leafRows db l)) ls
where
-- | 逐步接上后面的叶子
go _ _ [] = 0
go have acc (x : xs) =
let card = stepRows db have acc x conds
in card + go (have ++ [x]) card xs
chainCost _ [] _ = 0
-- | 贪心扩展一个顺序:每次挑中间结果最小的下一张
growOrder :: Database -> [RelOp] -> [Expr] -> [Int] -> [Int] -> [Int]
growOrder db leaves conds have rest = case rest of
[] -> have
_ ->
let next = pick rest
in growOrder db leaves conds (have ++ [next]) (filter (/= next) rest)
where
-- | 候选里成本最低的那个,同价取序号小的
pick (i : is) = foldl cheaper i is
pick [] = 0
cheaper i j = if costOf j < costOf i then j else i
-- | 这个前缀的估算成本
costOf i = chainCost db [leaves !! k | k <- have ++ [i]] conds
-- | 每个起点贪心一遍,取最便宜的顺序
bestOrder :: Database -> [RelOp] -> [Expr] -> [RelOp]
bestOrder db leaves conds = pick (map start [0 .. n - 1])
where
n = length leaves
-- | 从第 i 张表开始的贪心顺序
start i = [leaves !! k | k <- growOrder db leaves conds [i] (filter (/= i) [0 .. n - 1])]
-- | 成本最低的那个
pick (o : os) = foldl cheaper o os
pick [] = []
cheaper o o' = if cost o' < cost o then o' else o
-- | 一个顺序的估算成本
cost o = chainCost db o conds
-- | 统计齐全、没有除法且确实更省时给出新顺序
cheaperOrder :: Database -> [RelOp] -> [Expr] -> Maybe [RelOp]
cheaperOrder db leaves conds
| any hasDivision conds = Nothing
| any unknown leaves = Nothing
| bestCost < textCost = Just best
| otherwise = Nothing
where
-- | 这个叶子是不是拿不到统计
unknown x = case leafRows db x of
Just _ -> False
Nothing -> True
best = bestOrder db leaves conds
bestCost = chainCost db best conds
textCost = chainCost db leaves conds
-- | 按新顺序重建左深链,条件挂到两侧都齐的那一步
rebuildChain :: Database -> [RelOp] -> [Expr] -> RelOp
rebuildChain db (l : ls) conds = go (relOpCols db l) l ls conds
where
-- | 逐个接上后面的叶子
go _ acc [] rest = applyConds rest acc
go have acc (x : xs) rest =
let have' = have ++ relOpCols db x
(now, later) = partition (\c -> colsInExpr c `subsetOf` have') rest
in go have' (Join InnerJoin acc x (conjOf now)) xs later
-- | 若干条件用 AND 串起来
conjOf [] = LitBool True
conjOf (c : cs) = foldl And c cs
rebuildChain _ [] _ = Unit
-- | 挂不上去的条件套成 Filter
applyConds :: [Expr] -> RelOp -> RelOp
applyConds [] op = op
applyConds (c : cs) op = Filter c (applyConds cs op)
-- | 条件的列是不是都在可用列里
subsetOf :: [String] -> [String] -> Bool
subsetOf need have = all (`elem` have) need
@@ -1,9 +1,9 @@
module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), renderPlan) where
module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols, renderPlan) where
import ChuSQL.Core.Model (Value)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir)
-- 关系代数算子定义与算子树文本渲染。
-- 关系代数算子定义、输出列推导与算子树文本渲染。
data RelOp
= Scan (Maybe String) String (Maybe [String])
@@ -19,6 +19,27 @@ data RelOp
| Join JoinKind RelOp RelOp Expr
deriving (Show, Eq)
-- | 算子会产出哪些列
relOpCols :: Database -> RelOp -> [String]
relOpCols _ Unit = []
relOpCols _ (Compute items _) = map fst items
relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs
relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols
relOpCols db (Scan mAlias tbl Nothing) =
case lookup tbl db of
Nothing -> []
Just t -> map (prefix ++) (colNames t)
where
prefix = maybe "" (++ ".") mAlias
relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl Nothing)
relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing)
relOpCols db (Filter _ x) = relOpCols db x
relOpCols _ (Project ["*"] _) = ["*"]
relOpCols _ (Project cols _) = cols
relOpCols db (Sort _ x) = relOpCols db x
relOpCols db (Limit _ x) = relOpCols db x
relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r
-- | 连接的显示名
kindLabel :: JoinKind -> String
kindLabel InnerJoin = "Join"
@@ -1,33 +1,14 @@
module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject, relOpCols) where
module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject) where
import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr)
import ChuSQL.Core.Engine.Algebra.Op (RelOp (..))
import ChuSQL.Core.Engine.Algebra.Cost (indexCheaper, pointRows, rangeRows, tableMetaOf)
import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr, hasDivision)
import ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins)
import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
import Data.List (nub)
-- 查询优化:谓词下推、投影下推与常量折叠。
-- | 算子会产出哪些列
relOpCols :: Database -> RelOp -> [String]
relOpCols _ Unit = []
relOpCols _ (Compute items _) = map fst items
relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs
relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols
relOpCols db (Scan mAlias tbl Nothing) =
case lookup tbl db of
Nothing -> []
Just t -> map (prefix ++) (colNames t)
where
prefix = maybe "" (++ ".") mAlias
relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl Nothing)
relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing)
relOpCols db (Filter _ x) = relOpCols db x
relOpCols _ (Project ["*"] _) = ["*"]
relOpCols _ (Project cols _) = cols
relOpCols db (Sort _ x) = relOpCols db x
relOpCols db (Limit _ x) = relOpCols db x
relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r
-- 查询优化:谓词下推、投影下推、常量折叠、扫描方式与连接顺序选择。
-- | need 是否都在 have 里
isSubsetOf :: [String] -> [String] -> Bool
@@ -90,24 +71,6 @@ pushOne _ (Filter p (Sort spec x))
| not (hasDivision p) = Sort spec (Filter p x)
pushOne _ op = op
-- | 除法可能报错,不能提前或延后求值
hasDivision :: Expr -> Bool
hasDivision e = case e of
Div _ _ -> True
Neg a -> hasDivision a
Add a b -> both a b
Sub a b -> both a b
Mul a b -> both a b
Gt a b -> both a b
Lt a b -> both a b
Eq a b -> both a b
And a b -> both a b
Or a b -> both a b
_ -> False
where
-- | 两个子表达式里任意一个有除法
both a b = hasDivision a || hasDivision b
-- | 检查子计划中可能报错的除法
planHasDivision :: RelOp -> Bool
planHasDivision (Filter p x) = hasDivision p || planHasDivision x
@@ -183,24 +146,38 @@ foldConstants (And a b) = foldNode (And (foldConstants a) (foldConstants b))
foldConstants (Or a b) = foldNode (Or (foldConstants a) (foldConstants b))
foldConstants e = e
-- | 点查值不值得改写;没有统计就按老规矩改
worthLookup :: Database -> String -> String -> Bool
worthLookup db t col = case tableMetaOf db t of
Nothing -> True
Just m -> indexCheaper m col (pointRows m col)
-- | 范围扫描值不值得改写;没有统计就按老规矩改
worthRange :: Database -> String -> String -> Bool
worthRange db t col = case tableMetaOf db t of
Nothing -> True
Just m -> indexCheaper m col (rangeRows m)
-- | 单节点重写
rewriteNode :: Database -> RelOp -> RelOp
rewriteNode _ (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t Nothing)) =
Lookup mAlias t (unqualify mAlias k) (VInt v)
rewriteNode _ (Filter (Eq (Col k) (LitStr v)) (Scan mAlias t Nothing)) =
Lookup mAlias t (unqualify mAlias k) (VStr v)
rewriteNode _ (Filter (And (Gt (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
| k1 == k2 = Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False))
rewriteNode _ (Filter (And (Gt (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
| k1 == k2 = Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False))
rewriteNode _ (Filter (Gt (Col k) (LitInt v)) (Scan mAlias t Nothing)) =
Range mAlias t (unqualify mAlias k) (Just (VInt v, False)) Nothing
rewriteNode _ (Filter (Gt (Col k) (LitStr v)) (Scan mAlias t Nothing)) =
Range mAlias t (unqualify mAlias k) (Just (VStr v, False)) Nothing
rewriteNode _ (Filter (Lt (Col k) (LitInt v)) (Scan mAlias t Nothing)) =
Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, False))
rewriteNode _ (Filter (Lt (Col k) (LitStr v)) (Scan mAlias t Nothing)) =
Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, False))
rewriteNode db (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t Nothing))
| worthLookup db t (unqualify mAlias k) = Lookup mAlias t (unqualify mAlias k) (VInt v)
rewriteNode db (Filter (Eq (Col k) (LitStr v)) (Scan mAlias t Nothing))
| worthLookup db t (unqualify mAlias k) = Lookup mAlias t (unqualify mAlias k) (VStr v)
rewriteNode db (Filter (And (Gt (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
| k1 == k2 && worthRange db t (unqualify mAlias k1) =
Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False))
rewriteNode db (Filter (And (Gt (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
| k1 == k2 && worthRange db t (unqualify mAlias k1) =
Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False))
rewriteNode db (Filter (Gt (Col k) (LitInt v)) (Scan mAlias t Nothing))
| worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) (Just (VInt v, False)) Nothing
rewriteNode db (Filter (Gt (Col k) (LitStr v)) (Scan mAlias t Nothing))
| worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) (Just (VStr v, False)) Nothing
rewriteNode db (Filter (Lt (Col k) (LitInt v)) (Scan mAlias t Nothing))
| worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, False))
rewriteNode db (Filter (Lt (Col k) (LitStr v)) (Scan mAlias t Nothing))
| worthRange db t (unqualify mAlias k) = Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, False))
rewriteNode db (Filter p (Join kind l r c))
| not (hasDivision p || planHasDivision (Join kind l r c)) =
case kind of
@@ -235,4 +212,4 @@ optimizePredicates db op =
-- | 优化总入口
optimize :: Database -> RelOp -> RelOp
optimize db op = pushProject db ["*"] (optimizePredicates db op)
optimize db op = pushProject db ["*"] (reorderJoins db (optimizePredicates db op))
@@ -12,19 +12,6 @@ flipOrdering LT = GT
flipOrdering GT = LT
flipOrdering EQ = EQ
-- | 比较两个值:NULL 最小,数值跨整数与小数比较
compareValue :: Value -> Value -> Ordering
compareValue VNull VNull = EQ
compareValue VNull _ = LT
compareValue _ VNull = GT
compareValue (VInt a) (VInt b) = compare a b
compareValue (VFloat a) (VFloat b) = compare a b
compareValue (VInt a) (VFloat b) = compare (fromIntegral a) b
compareValue (VFloat a) (VInt b) = compare a (fromIntegral b)
compareValue (VStr a) (VStr b) = compare a b
compareValue (VBool a) (VBool b) = compare a b
compareValue _ _ = EQ
-- | 取出排序键(按 spec 顺序,每行只查一次)
sortKey :: [(String, SortDir)] -> Row -> [Maybe Value]
sortKey spec row = [lookup col row | (col, _) <- spec]
@@ -0,0 +1,282 @@
module ChuSQL.Core.Engine.Builtin
( Builtin (..)
, builtinNames
, resolveBuiltin
, builtinName
, invokeBuiltin
, builtinOfExpr
, builtinNode
, aggregateArg
, unsupportedAggregate
, Operator (..)
, operatorOfExpr
, operatorSymbol
, executeOperator
, threeValuedNot
, inValues
) where
import ChuSQL.Core.Model (Value (..), compareValue)
import ChuSQL.Core.Engine.Syntax.AST (Expr (..))
import Control.Monad (foldM)
import Data.Char (toLower)
-- 内置函数与运算符的唯一权威:名称解析和求值都只在这里实现一次。
-- | 内置聚合函数
data Builtin = BCountAll | BCount | BSum | BAvg | BMin | BMax
deriving (Show, Eq, Enum, Bounded)
-- | 名字到内置函数的对照表,解析只认这张表
builtinNames :: [(String, Builtin)]
builtinNames =
[ ("count", BCount)
, ("sum", BSum)
, ("avg", BAvg)
, ("min", BMin)
, ("max", BMax)
]
-- | 按名字解析内置函数,名字不分大小写
resolveBuiltin :: String -> Maybe Builtin
resolveBuiltin name = lookup (map toLower name) builtinNames
-- | 内置函数在 SQL 里的名字
builtinName :: Builtin -> String
builtinName BCountAll = "count"
builtinName b = case [n | (n, x) <- builtinNames, x == b] of
(n : _) -> n
[] -> "count"
-- | 在一组上调用内置函数:给出行数与各行的参数值
invokeBuiltin :: Builtin -> Int -> [Value] -> Either String Value
invokeBuiltin BCountAll rows _ = Right (VInt rows)
invokeBuiltin BCount _ vs = Right (VInt (length (nonNull vs)))
invokeBuiltin BSum _ vs = case nonNull vs of
[] -> Right VNull
xs -> foldM addValue (VInt 0) xs
invokeBuiltin BAvg _ vs = case nonNull vs of
[] -> Right VNull
xs -> do
total <- foldM addValue (VInt 0) xs
sumValue <- numberOf total
Right (VFloat (sumValue / fromIntegral (length xs)))
invokeBuiltin BMin _ vs = extremeOf lower (nonNull vs)
invokeBuiltin BMax _ vs = extremeOf higher (nonNull vs)
-- | 去掉 NULL
nonNull :: [Value] -> [Value]
nonNull = filter (/= VNull)
-- | 聚合节点对应的内置函数;其余节点给 Nothing
builtinOfExpr :: Expr -> Maybe Builtin
builtinOfExpr CountAll = Just BCountAll
builtinOfExpr (CountOf _) = Just BCount
builtinOfExpr (SumOf _) = Just BSum
builtinOfExpr (AvgOf _) = Just BAvg
builtinOfExpr (MinOf _) = Just BMin
builtinOfExpr (MaxOf _) = Just BMax
builtinOfExpr _ = Nothing
-- | 内置函数对应的 AST 节点
builtinNode :: Builtin -> Expr -> Expr
builtinNode BCountAll _ = CountAll
builtinNode BCount e = CountOf e
builtinNode BSum e = SumOf e
builtinNode BAvg e = AvgOf e
builtinNode BMin e = MinOf e
builtinNode BMax e = MaxOf e
-- | 聚合调用的参数表达式,COUNT(*) 没有参数
aggregateArg :: Expr -> Maybe Expr
aggregateArg (CountOf x) = Just x
aggregateArg (SumOf x) = Just x
aggregateArg (AvgOf x) = Just x
aggregateArg (MinOf x) = Just x
aggregateArg (MaxOf x) = Just x
aggregateArg _ = Nothing
-- | 只支持这几个聚合函数
unsupportedAggregate :: String
unsupportedAggregate = "only COUNT, SUM, AVG, MIN and MAX can be aggregated"
-- | 数值相加:整数配整数还是整数
addValue :: Value -> Value -> Either String Value
addValue (VInt a) (VInt b) = Right (VInt (a + b))
addValue (VInt a) (VFloat b) = Right (VFloat (fromIntegral a + b))
addValue (VFloat a) (VInt b) = Right (VFloat (a + fromIntegral b))
addValue (VFloat a) (VFloat b) = Right (VFloat (a + b))
addValue _ _ = Left "type error: expected two numbers"
-- | 能当数用的值
numberOf :: Value -> Either String Double
numberOf (VInt n) = Right (fromIntegral n)
numberOf (VFloat d) = Right d
numberOf _ = Left "type error: expected a number"
-- | 一组值里的极值,空组给 NULL
extremeOf :: (Value -> Value -> Value) -> [Value] -> Either String Value
extremeOf _ [] = Right VNull
extremeOf pick (x : xs) = Right (foldl pick x xs)
-- | 取更小的那个
lower :: Value -> Value -> Value
lower a b = if compareValue b a == LT then b else a
-- | 取更大的那个
higher :: Value -> Value -> Value
higher a b = if compareValue b a == GT then b else a
-- | 运算符:AST 里的每个运算节点对应一个
data Operator
= OpAdd
| OpSub
| OpMul
| OpDiv
| OpNeg
| OpGt
| OpLt
| OpEq
| OpAnd
| OpOr
deriving (Show, Eq, Enum, Bounded)
-- | 运算符的 SQL 写法
operatorSymbol :: Operator -> String
operatorSymbol OpAdd = "+"
operatorSymbol OpSub = "-"
operatorSymbol OpMul = "*"
operatorSymbol OpDiv = "/"
operatorSymbol OpNeg = "-"
operatorSymbol OpGt = ">"
operatorSymbol OpLt = "<"
operatorSymbol OpEq = "="
operatorSymbol OpAnd = "AND"
operatorSymbol OpOr = "OR"
-- | 运算节点对应的运算符;其余节点给 Nothing
operatorOfExpr :: Expr -> Maybe Operator
operatorOfExpr (Add _ _) = Just OpAdd
operatorOfExpr (Sub _ _) = Just OpSub
operatorOfExpr (Mul _ _) = Just OpMul
operatorOfExpr (Div _ _) = Just OpDiv
operatorOfExpr (Neg _) = Just OpNeg
operatorOfExpr (Gt _ _) = Just OpGt
operatorOfExpr (Lt _ _) = Just OpLt
operatorOfExpr (Eq _ _) = Just OpEq
operatorOfExpr (And _ _) = Just OpAnd
operatorOfExpr (Or _ _) = Just OpOr
operatorOfExpr _ = Nothing
-- | 运算符求值:算错个数是内部错误
executeOperator :: Operator -> [Value] -> Either String Value
executeOperator op vs = case (op, vs) of
(OpNeg, [x]) -> evalNeg x
(OpGt, [x, y]) -> compareValues (== GT) x y
(OpLt, [x, y]) -> compareValues (< EQ) x y
(OpEq, [x, y]) -> compareValues (== EQ) x y
(OpAnd, [x, y]) -> andValues x y
(OpOr, [x, y]) -> orValues x y
(_, [x, y]) | Just a <- arithOf op -> evalArith a x y
_ -> Left ("internal error: wrong operand count for operator " ++ operatorSymbol op)
-- | 取负
evalNeg :: Value -> Either String Value
evalNeg VNull = Right VNull
evalNeg (VInt n) = Right (VInt (negate n))
evalNeg (VFloat d) = Right (VFloat (negate d))
evalNeg _ = Left "type error: expected a number"
-- | 整数算术与浮点算术成对出现
data Arith = Arith
{ arithInt :: Int -> Int -> Either String Int
, arithFloat :: Double -> Double -> Either String Double
}
-- | 二元算术运算符对应的实现
arithOf :: Operator -> Maybe Arith
arithOf OpAdd = Just (Arith (\x y -> Right (x + y)) (\x y -> Right (x + y)))
arithOf OpSub = Just (Arith (\x y -> Right (x - y)) (\x y -> Right (x - y)))
arithOf OpMul = Just (Arith (\x y -> Right (x * y)) (\x y -> Right (x * y)))
arithOf OpDiv = Just divArith
arithOf _ = Nothing
-- | 一边是 NULL 就出 NULL,两边都是整数就出整数
evalArith :: Arith -> Value -> Value -> Either String Value
evalArith _ VNull _ = Right VNull
evalArith _ _ VNull = Right VNull
evalArith ops (VInt x) (VInt y) = VInt <$> arithInt ops x y
evalArith ops x y = case (asDouble x, asDouble y) of
(Just p, Just q) -> VFloat <$> arithFloat ops p q
_ -> Left "type error: expected two numbers"
-- | 整数除法向零截断,溢出返回错误;浮点除法不能除以零
divArith :: Arith
divArith = Arith intDiv floatDiv
where
-- | 整数除法:除零与溢出都报错
intDiv _ 0 = Left "division by zero"
intDiv x y
| x == minBound && y == -1 = Left "integer division overflow"
| otherwise = Right (x `quot` y)
-- | 浮点除法:不能除以零
floatDiv _ 0 = Left "division by zero"
floatDiv x y = Right (x / y)
-- | 能当数用的值
asDouble :: Value -> Maybe Double
asDouble (VInt n) = Just (fromIntegral n)
asDouble (VFloat d) = Just d
asDouble _ = Nothing
-- | 比较两个值:NULL 给 NULL,其余按全序比
compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
compareValues rel x y
| x == VNull || y == VNull = Right VNull
| comparableValue x y = Right (VBool (rel (compareValue x y)))
| otherwise = Left "type error: cannot compare these values"
-- | 两个值是否落在可以用全序比较的同一族里
comparableValue :: Value -> Value -> Bool
comparableValue (VInt _) (VFloat _) = True
comparableValue (VFloat _) (VInt _) = True
comparableValue (VInt _) (VInt _) = True
comparableValue (VFloat _) (VFloat _) = True
comparableValue (VStr _) (VStr _) = True
comparableValue (VBool _) (VBool _) = True
comparableValue _ _ = False
-- | 逻辑与的三值真值表
andValues :: Value -> Value -> Either String Value
andValues (VBool False) _ = Right (VBool False)
andValues _ (VBool False) = Right (VBool False)
andValues (VBool True) (VBool True) = Right (VBool True)
andValues VNull (VBool True) = Right VNull
andValues (VBool True) VNull = Right VNull
andValues VNull VNull = Right VNull
andValues _ _ = Left "type error: expected two booleans"
-- | 逻辑或的三值真值表
orValues :: Value -> Value -> Either String Value
orValues (VBool True) _ = Right (VBool True)
orValues _ (VBool True) = Right (VBool True)
orValues (VBool False) (VBool False) = Right (VBool False)
orValues VNull (VBool False) = Right VNull
orValues (VBool False) VNull = Right VNull
orValues VNull VNull = Right VNull
orValues _ _ = Left "type error: expected two booleans"
-- | NOT 的三值取反
threeValuedNot :: Value -> Value
threeValuedNot (VBool b) = VBool (not b)
threeValuedNot _ = VNull
-- | IN 三值逻辑:命中为真,碰 NULL 得 NULL
inValues :: Value -> [Value] -> Either String Value
inValues VNull _ = Right VNull
inValues v vs = do
results <- mapM (\x -> executeOperator OpEq [v, x]) vs
Right $
if VBool True `elem` results
then VBool True
else if VNull `elem` results then VNull else VBool False
@@ -0,0 +1,74 @@
module ChuSQL.Core.Engine.Error
( ErrorCategory (..)
, ErrorRule (..)
, errorRules
, errorCategory
, errorCode
, errorLike
, accountErrorCode
) where
import Data.List (isInfixOf)
-- 引擎与存储错误文本的唯一分类表和协议错误码表
-- | 错误大类
data ErrorCategory
= NoDatabaseError
| PermissionError
| CatalogError
| TypeError
| StorageError
| ProtocolError
| UnknownError
deriving (Eq, Show)
-- | 一条识别规则:命中文本片段就算这一类,并给出协议错误码
data ErrorRule = ErrorRule
{ ruleMarker :: String
, ruleCategory :: ErrorCategory
, ruleCode :: String
}
-- | 唯一的错误识别表,顺序即优先级
errorRules :: [ErrorRule]
errorRules =
[ ErrorRule "no database selected" NoDatabaseError "no_database"
, ErrorRule "administrator required" PermissionError "forbidden"
, ErrorRule "unknown table" CatalogError "not_found"
, ErrorRule "unknown column" CatalogError "query_error"
, ErrorRule "unknown database" CatalogError "not_found"
, ErrorRule "unknown role" CatalogError "not_found"
, ErrorRule "unknown account" CatalogError "not_found"
, ErrorRule "unknown index" CatalogError "query_error"
, ErrorRule "unknown user" CatalogError "query_error"
, ErrorRule "permission denied" PermissionError "query_error"
, ErrorRule "already exists" CatalogError "query_error"
, ErrorRule "type error" TypeError "query_error"
, ErrorRule "cannot put this value into" TypeError "query_error"
, ErrorRule "division by zero" TypeError "query_error"
, ErrorRule "overflow" TypeError "query_error"
, ErrorRule "storage" StorageError "query_error"
, ErrorRule "storage library call failed" StorageError "query_error"
, ErrorRule "unsupported protocol" ProtocolError "query_error"
]
-- | 命中的第一条规则
errorLike :: String -> Maybe ErrorRule
errorLike message = case [r | r <- errorRules, ruleMarker r `isInfixOf` message] of
[] -> Nothing
(r : _) -> Just r
-- | 错误文本属于哪一大类
errorCategory :: String -> ErrorCategory
errorCategory message = maybe UnknownError ruleCategory (errorLike message)
-- | 错误文本对应的协议错误码
errorCode :: String -> String
errorCode message = maybe "query_error" ruleCode (errorLike message)
-- | 账号服务对外的错误码
accountErrorCode :: String -> String
accountErrorCode "account already exists" = "conflict"
accountErrorCode "unknown account" = "not_found"
accountErrorCode _ = "storage_error"
@@ -0,0 +1,82 @@
module ChuSQL.Core.Engine.Parallel (
parallelShardLimit,
Pool,
workerPool,
poolRun,
) where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar)
import Control.Exception (SomeException, throwIO, try)
import System.IO.Unsafe (unsafePerformIO)
-- 并行执行:常驻工作线程池,结果按提交顺序收回。
-- | 单次并行扫描最多切几片
parallelShardLimit :: Int
parallelShardLimit = 8
-- | 池:待办队列与唤醒信号
data Pool = Pool
{ poolJobs :: MVar [IO ()]
, poolReady :: MVar ()
}
{-# NOINLINE poolRef #-}
-- | 进程全局的池,按容量复用
poolRef :: MVar (Maybe (Int, Pool))
poolRef = unsafePerformIO (newMVar Nothing)
-- | 按容量取池,不够就新建一个
workerPool :: Int -> IO Pool
workerPool size = modifyMVar poolRef reuse
where
-- | 现有池够大就留着,否则换新的
reuse current = case current of
Just (capacity, pool)
| capacity >= wanted -> pure (current, pool)
_ -> do
pool <- startPool wanted
pure (Just (wanted, pool), pool)
-- | 池的线程数至少一个
wanted = max 1 size
-- | 起 wanted 个常驻线程吃队列
startPool n = do
jobs <- newMVar []
ready <- newMVar ()
sequence_ [forkIO (worker jobs ready) | _ <- [1 .. n]]
pure (Pool jobs ready)
-- | 一个工作线程:被唤醒一次就取一个待办
worker :: MVar [IO ()] -> MVar () -> IO ()
worker jobs ready = do
takeMVar ready
job <- modifyMVar jobs pick
case job of
Nothing -> worker jobs ready
Just act -> act >> worker jobs ready
where
-- | 取队首,空队列就回 Nothing
pick [] = pure ([], Nothing)
pick (j : js) = pure (js, Just j)
-- | 往池里丢一个待办
submit :: Pool -> IO () -> IO ()
submit pool job = do
modifyMVar_ (poolJobs pool) (pure . (++ [job]))
putMVar (poolReady pool) ()
-- | 跑一个动作,结果或异常都填进格子
fillCell :: MVar (Either SomeException a) -> IO a -> IO ()
fillCell cell act = try act >>= putMVar cell
-- | 并发跑一批动作,按输入顺序返回结果与异常
poolRun :: Pool -> [IO a] -> IO [a]
poolRun _ [] = pure []
poolRun pool actions = do
cells <- mapM (const newEmptyMVar) actions
sequence_ [submit pool (fillCell cell act) | (cell, act) <- zip cells actions]
outcomes <- mapM takeMVar cells
mapM (either throwIO pure) outcomes
@@ -243,16 +243,11 @@ comparison db place env a b = do
then Right (InferType CBool)
else Left (place ++ ": both sides of = must have the same type, got " ++ renderType ta ++ " and " ++ renderType tb)
-- | 两类能不能比
-- | 两类能不能比,类型族规则来自 Model
compatible :: InferredType -> InferredType -> Bool
compatible InferNull _ = True
compatible _ InferNull = True
compatible (InferType a) (InferType b)
| numericType a && numericType b = True
| typeClassOf a == typeClassOf b = True
| typeClassOf a == TemporalClass && typeClassOf b == TextClass = True
| typeClassOf b == TemporalClass && typeClassOf a == TextClass = True
| otherwise = False
compatible (InferType a) (InferType b) = comparableTypes a b
-- | 逻辑运算两边的类型检查
boolean :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
@@ -35,6 +35,14 @@ class (Monad m) => MonadStorage m where
result <- scan t
pure (fmap (map (\row -> [(c, v) | c <- cols, Just v <- [lookup c row]])) result)
-- \| 本存储能用的并行分片数;不支持并行的存储返回 1
parallelShards :: m Int
parallelShards = pure 1
-- \| 按分片并行扫描并按分片序拼接;默认退回顺序扫描
scanShards :: Int -> String -> Maybe [String] -> m (Either String [Row])
scanShards _ t cols = maybe (scan t) (scanColumns t) cols
-- \| 追加一行
insert :: String -> Row -> m (Either String ())
@@ -28,8 +28,10 @@ module ChuSQL.Core.Engine.Storage.IPC (
import ChuSQL.Core.Model
import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
import ChuSQL.Core.Engine.Parallel (parallelShardLimit, poolRun, workerPool)
import ChuSQL.Core.Engine.Storage
import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest)
import Control.Concurrent (getNumCapabilities)
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
import Data.Aeson (eitherDecodeStrict, encode)
import Data.ByteString qualified as BS
@@ -166,6 +168,18 @@ doScan t = ask "scan" (ReqScan t) $ \resp -> case resp of
RespRows rows -> Just rows
_ -> Nothing
-- | 发带投影的 Scan
doScanColumns :: String -> [String] -> IO (Either String [Row])
doScanColumns t cols = ask "scan" (ReqScanColumns t cols) $ \resp -> case resp of
RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
_ -> Nothing
-- | 发分片 Scan:只取第 shard 片
doScanShard :: String -> Maybe [String] -> Int -> Int -> IO (Either String [Row])
doScanShard t cols shard shards = ask "scan_shard" (ReqScanShard t cols shard shards) $ \resp -> case resp of
RespRows rows -> Just rows
_ -> Nothing
-- | 发 Insert(索引由存储层维护)
doInsert :: String -> Row -> IO (Either String ())
doInsert t r = ask "insert" (ReqInsert t r) okOnly
@@ -290,9 +304,20 @@ instance MonadStorage IPCStorage where
-- \| 发 Scan
scan t = IPCStorage (doScan t)
-- \| 只取指定列
scanColumns t cols = IPCStorage $ ask "scan" (ReqScanColumns t cols) $ \resp -> case resp of
RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
_ -> Nothing
scanColumns t cols = IPCStorage (doScanColumns t cols)
-- \| 并行分片数:按 RTS 能力数,封顶在 parallelShardLimit
parallelShards = IPCStorage $ do
caps <- getNumCapabilities
pure (max 1 (min parallelShardLimit caps))
-- \| 分片并行扫,再按分片序拼接
scanShards width t cols
| width <= 1 = IPCStorage (maybe (doScan t) (doScanColumns t) cols)
| otherwise = IPCStorage $ do
pool <- workerPool width
parts <- poolRun pool [doScanShard t cols shard width | shard <- [0 .. width - 1]]
pure (fmap concat (sequence parts))
-- \| 发 Insert(索引由存储层自己维护)
insert t r = IPCStorage (doInsert t r)
@@ -341,7 +366,7 @@ instance MonadStorage IPCStorage where
rows <- doScan (tiTable info)
pure
( tiTable info
, Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows)
, Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows) (Just (metaOf info))
)
-- \| 只问数据字典要结构,设了当前库只留它的表
@@ -354,6 +379,10 @@ instance MonadStorage IPCStorage where
Left _ -> []
Right xs -> concatMap (visibleTables current) xs
-- | 线上表信息转引擎侧统计
metaOf :: TableInfo -> TableMeta
metaOf info = TableMeta (tiRows info) (tiStats info) (tiIndexes info)
-- | 没设库名就照单全收;设了库名只收这个库的表,键名去掉库名前缀
visibleTables :: Maybe String -> TableInfo -> [(String, Table)]
visibleTables current info
@@ -365,4 +394,4 @@ visibleTables current info
where
named = info {tiTable = unqualify current (tiTable info)}
-- | 组装成不带行的表
bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [])
bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [] (Just (metaOf i)))
@@ -44,7 +44,7 @@ instance MonadStorage MemoryStorage where
createTable name cols = MemoryStorage $ \db ->
if any ((== name) . fst) db
then Right (Left ("table already exists: " ++ name), db)
else Right (Right (), db ++ [(name, Table name cols [])])
else Right (Right (), db ++ [(name, Table name cols [] Nothing)])
-- \| 删表;不存在报错
dropTable name = MemoryStorage $ \db ->
@@ -3,6 +3,7 @@
module ChuSQL.Core.Engine.Syntax.Parser (parseStatement, parseExpression) where
import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
import ChuSQL.Core.Engine.Builtin (Builtin (..), builtinName, builtinNames, builtinNode)
import ChuSQL.Core.Engine.Syntax.AST
import Control.Monad (void)
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
@@ -172,18 +173,14 @@ inPredicate = do
subquerySelect :: Parser Subquery
subquerySelect = Subquery <$> selectStatement <*> pure []
-- | 聚合调用:COUNT/SUM/AVG/MIN/MAX
-- | 聚合调用:名称与节点都由内置函数表给出
aggregateCall :: Parser Expr
aggregateCall =
choice
[ CountAll <$ try (keyword "count" *> between (symbol "(") (symbol ")") (symbol "*"))
, CountOf <$> aggArg "count"
, SumOf <$> aggArg "sum"
, AvgOf <$> aggArg "avg"
, MinOf <$> aggArg "min"
, MaxOf <$> aggArg "max"
]
aggregateCall = choice (countAll : map named builtinNames)
where
-- | COUNT(*),没有参数
countAll = CountAll <$ try (keyword (builtinName BCountAll) *> between (symbol "(") (symbol ")") (symbol "*"))
-- | 表里每一个带参数的内置函数
named (name, builtin) = builtinNode builtin <$> aggArg name
-- | 读聚合函数的参数
aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr)
+419 -3
View File
@@ -2,24 +2,32 @@
module Main where
import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp)
import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM)
import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr)
import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), renderPlan)
import ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject)
import ChuSQL.Core.Engine.Algebra.Planner (translate)
import ChuSQL.Core.Engine.Algebra.Sort (sortRows)
import ChuSQL.Core.Engine.Builtin
import ChuSQL.Core.Engine.Error
import ChuSQL.Core.Engine
import ChuSQL.Core.Engine.Parallel (poolRun, workerPool)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Semantic (prepare)
import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
import ChuSQL.Core.Engine.Storage.IPC (IPCStorage (runIPCStorage), closeConnection, doListTables, getDatabaseName, localStorageLink, setDatabaseName, setStorageLink)
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Engine.Syntax.Parser
import Control.Exception (IOException, finally, try)
import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
import Control.Exception (ErrorCall, IOException, finally, try)
import Data.Hashable (hash)
import Data.List (isInfixOf, sortOn)
import Data.Unique (hashUnique, newUnique)
import System.CPUTime (getCPUTime)
import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly)
import System.FilePath ((</>))
import System.Timeout (timeout)
import Test.Hspec
-- 引擎层的 hspec 测试:语法、执行、优化器与存储链路行为。
@@ -35,6 +43,7 @@ users =
, [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
, [("id", VInt 3), ("name", VStr "Carol"), ("age", VInt 30)]
]
, tableMeta = Nothing
}
-- | 测试表 orders:id/user_id/product
@@ -48,12 +57,51 @@ orders =
, [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
, [("id", VInt 3), ("user_id", VInt 1), ("product", VStr "Cup")]
]
, tableMeta = Nothing
}
-- | 两个测试表组成的默认库
testDB :: Database
testDB = [("users", users), ("orders", orders)]
-- | 连接链测试表 a:6 行,id 各不相同
chainA :: Table
chainA =
Table
{ tableName = "a"
, tableCols = [("id", TInt), ("name", TStr)]
, tableRows = [[("id", VInt n), ("name", VStr ("a" ++ show n))] | n <- [1 .. 6]]
, tableMeta = Just (TableMeta 6 [("id", 6, False)] ["id"])
}
-- | 连接链测试表 b:4 行,a_id 各不相同
chainB :: Table
chainB =
Table
{ tableName = "b"
, tableCols = [("id", TInt), ("a_id", TInt)]
, tableRows = [[("id", VInt n), ("a_id", VInt n)] | n <- [1 .. 4]]
, tableMeta = Just (TableMeta 4 [("id", 4, False), ("a_id", 4, False)] ["id"])
}
-- | 连接链测试表 c:2 行,b_id 各不相同
chainC :: Table
chainC =
Table
{ tableName = "c"
, tableCols = [("id", TInt), ("b_id", TInt)]
, tableRows = [[("id", VInt n), ("b_id", VInt n)] | n <- [1, 2]]
, tableMeta = Just (TableMeta 2 [("id", 2, False), ("b_id", 2, False)] ["id"])
}
-- | 三张表组成的连接链测试库
chainDB :: Database
chainDB = [("a", chainA), ("b", chainB), ("c", chainC)]
-- | 同一个连接链测试库,但没有统计
chainDBWithoutStats :: Database
chainDBWithoutStats = [(n, t { tableMeta = Nothing }) | (n, t) <- chainDB]
-- | 跑引擎层全部 hspec 用例
main :: IO ()
main = hspec $ do
@@ -1161,6 +1209,47 @@ main = hspec $ do
fmap firstFilterCond (optimizedPlan "SELECT name FROM users WHERE 1 > 2")
`shouldBe` Right (Just (LitBool False))
it "picks the index only when the statistics make it cheaper" $ do
let stat rows distinct indexes = TableMeta rows [(c, d, False) | (c, d) <- distinct] indexes
dbWith m = [("users", Table "users" [("id", TInt), ("name", TStr)] [] (Just m))]
unknown = [("users", Table "users" [("id", TInt), ("name", TStr)] [] Nothing)]
point = Filter (Eq (Col "id") (LitInt 1)) (Scan Nothing "users" Nothing)
range = Filter (Gt (Col "id") (LitInt 5)) (Scan Nothing "users" Nothing)
-- 索引在、点查命中一行:改写
optimize (dbWith (stat 10000 [("id", 10000)] ["id"])) point
`shouldBe` Lookup Nothing "users" "id" (VInt 1)
-- 拿不到统计:保持原有改写行为
optimize unknown point `shouldBe` Lookup Nothing "users" "id" (VInt 1)
-- 没有索引:不改写,省掉一次白跑的存储层查询
optimize (dbWith (stat 10000 [("id", 10000)] [])) point `shouldBe` point
-- 有索引但整列一个值:点查等于全表,全表扫更便宜
optimize (dbWith (stat 10000 [("name", 1)] ["name"])) (Filter (Eq (Col "name") (LitStr "a")) (Scan Nothing "users" Nothing))
`shouldBe` Filter (Eq (Col "name") (LitStr "a")) (Scan Nothing "users" Nothing)
-- 范围扫描同理
optimize (dbWith (stat 10000 [("id", 10000)] ["id"])) range
`shouldBe` Range Nothing "users" "id" (Just (VInt 5, False)) Nothing
optimize (dbWith (stat 10000 [("id", 10000)] [])) range `shouldBe` range
it "reorders an inner join chain only when the statistics say it is cheaper" $ do
let sql =
"SELECT a.name FROM a JOIN b ON a.id = b.a_id JOIN c ON b.id = c.b_id ORDER BY a.name"
unordered = "SELECT a.name FROM a JOIN b ON a.id = b.a_id JOIN c ON b.id = c.b_id"
-- 统计说先接最小的 c 更省:文本顺序 a / b / c 换成一个更便宜的顺序
fmap planTables (optimizedPlanIn chainDB sql) `shouldBe` Right ["b", "c", "a"]
-- 拿不到统计:保持文本顺序
fmap planTables (optimizedPlanIn chainDBWithoutStats sql) `shouldBe` Right ["a", "b", "c"]
-- 行序可观察(没有 ORDER BY):不动顺序
fmap planTables (optimizedPlanIn chainDB unordered) `shouldBe` Right ["a", "b", "c"]
it "keeps an inner join chain result identical when it reorders it" $ do
let sql =
"SELECT a.name FROM a JOIN b ON a.id = b.a_id JOIN c ON b.id = c.b_id ORDER BY a.name"
case parseStatement sql >>= prepare chainDB of
Left err -> expectationFailure err
Right q -> case translate q of
Left err -> expectationFailure err
Right relOp -> evalRelOp chainDB (optimize chainDB relOp) `shouldBe` evalRelOp chainDB relOp
it "removes a filter whose predicate folds to true" $ do
fmap anyFilter (optimizedPlan "SELECT name FROM users WHERE 1 = 1")
`shouldBe` Right False
@@ -1600,6 +1689,24 @@ main = hspec $ do
fmap sortRow (indexRow fresh)
`shouldBe` Just (sortRow [("id", VInt 3), ("code", VInt 502)])
it "schema carries the row count, index list and column statistics" $ do
withTestSession $ \srv -> withServerEnv srv $ do
_ <- runIPCStorage (runStatementM (CreateTable "meta_t" [("id", TInt), ("code", TInt)]))
_ <-
runIPCStorage
( runStatementM
(Insert "meta_t" ["id", "code"] [[LitInt 1, LitInt 500], [LitInt 2, LitInt 501]])
)
_ <- runIPCStorage (runStatementM (CreateIndex "meta_t" "code"))
db <- runIPCStorage schema
case lookup "meta_t" db of
Nothing -> expectationFailure "meta_t missing from schema"
Just t -> do
fmap metaRowCount (tableMeta t) `shouldBe` Just 2
fmap metaIndexes (tableMeta t) `shouldBe` Just ["id", "code"]
fmap (sortOn fst . map (\(c, d, _) -> (c, d)) . metaDistinct) (tableMeta t)
`shouldBe` Just [("code", 2), ("id", 2)]
it "CREATE INDEX accepts duplicates and returns every matching row" $ do
withTestSession $ \srv -> withServerEnv srv $ do
_ <- runIPCStorage (runStatementM (CreateTable "dup_ix" [("id", TInt), ("age", TInt)]))
@@ -1662,7 +1769,7 @@ main = hspec $ do
`shouldBe` Right (makeSelect ["*"] "t" (Just (Eq (Col "flag") (LitBool True))))
it "inserts and reads back a boolean column end-to-end" $ do
let db = [("t", Table "t" [("id", TInt), ("flag", TBool)] [])]
let db = [("t", Table "t" [("id", TInt), ("flag", TBool)] [] Nothing)]
case runStatement db (Insert "t" ["id", "flag"] [[LitInt 1, LitBool True]]) of
Left e -> expectationFailure e
Right (db', _) ->
@@ -1877,6 +1984,206 @@ main = hspec $ do
run nulls "ALTER TABLE nl ALTER COLUMN tag DROP NOT NULL" `shouldSatisfy` isRight
run strict "ALTER TABLE nl2 ALTER COLUMN tag DROP NOT NULL" `shouldSatisfy` isRight
describe "ChuSQL.Core.Model (值语义唯一权威)" $ do
it "treats an integral float and an int as the same value" $ do
valuesEqual (VInt 1) (VFloat 1.0) `shouldBe` True
compareValue (VInt 1) (VFloat 1.0) `shouldBe` EQ
hash (VInt 1) `shouldBe` hash (VFloat 1.0)
hashValue (VInt 1) `shouldBe` hashValue (VFloat 1.0)
it "keeps null, text and boolean in their own buckets" $ do
hash VNull `shouldNotBe` hash (VInt 0)
hash (VInt 1) `shouldNotBe` hash (VStr "1")
hash (VStr "a") `shouldNotBe` hash (VBool True)
it "orders null below every value and compares across families" $ do
compareValue VNull (VInt minBound) `shouldBe` LT
compareValue (VInt maxBound) VNull `shouldBe` GT
compareValue VNull VNull `shouldBe` EQ
compareValue (VInt 1) (VStr "a") `shouldBe` LT
compareValue (VStr "a") (VBool True) `shouldBe` LT
compareValue (VBool True) VNull `shouldBe` GT
it "propagates null through comparisons" $ do
evalExpr (Eq (Col "v") LitNull) [("v", VInt 1)] `shouldBe` Right VNull
evalExpr (Gt LitNull (LitInt 1)) [] `shouldBe` Right VNull
it "uses one comparability rule and one canonical form" $ do
comparableTypes CInt CFloat `shouldBe` True
assignable CInt CFloat `shouldBe` True
assignable CStr CInt `shouldBe` False
comparableTypes CInt CStr `shouldBe` False
comparableTypes CStr CDate `shouldBe` True
canonicalValue (VFloat 3.0) `shouldBe` VInt 3
canonicalValue (VFloat 3.5) `shouldBe` VFloat 3.5
describe "比较语义统一(排序 / 聚合 / 哈希连接)" $ do
-- vals:在给定库上跑 SQL 只取值
let vals db input = fmap (map (map snd)) (parseStatement input >>= rowsOf . runStatement db)
-- seed:建一张两列空表
seed name = case parseStatement ("CREATE TABLE " ++ name ++ " (id int, v int)") >>= runStatement emptyDB of
Left e -> error e
Right (db, _) -> db
-- ins:插入一行,失败直接判测试失败
ins db input = case parseStatement input >>= runStatement db of
Left e -> error e
Right (db', _) -> db'
rows3 =
ins
(ins (ins (seed "m") "INSERT INTO m (id, v) VALUES (1, 2)") "INSERT INTO m (id, v) VALUES (2, 1)")
"INSERT INTO m (id, v) VALUES (3, 2)"
withNull =
ins
(ins (ins (seed "m2") "INSERT INTO m2 (id, v) VALUES (1, 2)") "INSERT INTO m2 (id) VALUES (2)")
"INSERT INTO m2 (id, v) VALUES (3, 1)"
it "sorts with the same rule that aggregates use" $ do
map (map snd) (sortRows [("v", Asc)] [[("v", VFloat 1.5)], [("v", VNull)], [("v", VInt 1)]])
`shouldBe` [[VNull], [VInt 1], [VFloat 1.5]]
vals rows3 "SELECT v FROM m ORDER BY v, id" `shouldBe` Right [[VInt 1], [VInt 2], [VInt 2]]
vals rows3 "SELECT v FROM m ORDER BY v DESC, id" `shouldBe` Right [[VInt 2], [VInt 2], [VInt 1]]
vals rows3 "SELECT MIN(v), MAX(v) FROM m" `shouldBe` Right [[VInt 1, VInt 2]]
it "sorts the catalog names that are unknown into one code" $ do
errorCode "unknown database: d" `shouldBe` "not_found"
errorCode "unknown role: r" `shouldBe` "not_found"
errorCode "unknown account" `shouldBe` "not_found"
it "puts null first when sorting and skips it in aggregates" $ do
vals withNull "SELECT v FROM m2 ORDER BY v" `shouldBe` Right [[VNull], [VInt 1], [VInt 2]]
vals withNull "SELECT MIN(v), MAX(v), SUM(v), COUNT(v), COUNT(*) FROM m2"
`shouldBe` Right [[VInt 1, VInt 2, VInt 3, VInt 2, VInt 3]]
it "uses 1 and 1.0 as one key in predicates and unique columns" $ do
let one = ins (seed "f1") "INSERT INTO f1 (id, v) VALUES (1, 1)"
vals one "SELECT id FROM f1 WHERE v = 1.0" `shouldBe` Right [[VInt 1]]
vals one "SELECT id FROM f1 WHERE v = 1" `shouldBe` Right [[VInt 1]]
let uniqueTable = case parseStatement "CREATE TABLE uq (id int, v int UNIQUE)" >>= runStatement emptyDB of
Left e -> error e
Right (db, _) -> db
seeded = ins uniqueTable "INSERT INTO uq (id, v) VALUES (1, 1)"
case parseStatement "INSERT INTO uq (id, v) VALUES (2, 1.0)" >>= runStatement seeded of
Left err -> err `shouldBe` "UNIQUE: duplicate value in column v"
Right _ -> expectationFailure "1.0 must clash with 1 on a unique column"
describe "ChuSQL.Core.Engine.Builtin (解析与调用唯一入口)" $ do
it "resolves aggregate names case-insensitively" $ do
resolveBuiltin "COUNT" `shouldBe` Just BCount
resolveBuiltin "Sum" `shouldBe` Just BSum
resolveBuiltin "median" `shouldBe` Nothing
map fst builtinNames `shouldBe` ["count", "sum", "avg", "min", "max"]
it "invokes every aggregate from one place" $ do
invokeBuiltin BCountAll 3 [] `shouldBe` Right (VInt 3)
invokeBuiltin BCount 3 [VInt 1, VNull, VInt 2] `shouldBe` Right (VInt 2)
invokeBuiltin BSum 0 [] `shouldBe` Right VNull
invokeBuiltin BSum 3 [VInt 1, VNull, VInt 2] `shouldBe` Right (VInt 3)
invokeBuiltin BAvg 2 [VInt 1, VInt 3] `shouldBe` Right (VFloat 2)
invokeBuiltin BMin 2 [VNull, VInt 4] `shouldBe` Right (VInt 4)
invokeBuiltin BMax 2 [VNull, VInt 4] `shouldBe` Right (VInt 4)
it "maps names to syntax nodes in one table" $ do
builtinOfExpr CountAll `shouldBe` Just BCountAll
builtinNode BCount (Col "age") `shouldBe` CountOf (Col "age")
builtinNode BAvg (Col "age") `shouldBe` AvgOf (Col "age")
aggregateArg (SumOf (Col "age")) `shouldBe` Just (Col "age")
aggregateArg CountAll `shouldBe` Nothing
unsupportedAggregate `shouldBe` "only COUNT, SUM, AVG, MIN and MAX can be aggregated"
it "exposes one operator table and one executor" $ do
operatorSymbol <$> operatorOfExpr (Add (LitInt 1) (LitInt 2)) `shouldBe` Just "+"
operatorSymbol <$> operatorOfExpr (And (LitBool True) (LitBool False)) `shouldBe` Just "AND"
executeOperator OpAdd [VInt 1, VInt 2] `shouldBe` Right (VInt 3)
executeOperator OpDiv [VInt 1, VInt 0] `shouldBe` Left "division by zero"
executeOperator OpNeg [VFloat 2] `shouldBe` Right (VFloat (-2))
executeOperator OpEq [VInt 1, VFloat 1.0] `shouldBe` Right (VBool True)
executeOperator OpGt [VNull, VInt 1] `shouldBe` Right VNull
executeOperator OpAnd [VBool True, VNull] `shouldBe` Right VNull
executeOperator OpOr [VBool True, VNull] `shouldBe` Right (VBool True)
executeOperator OpAdd [VInt 1] `shouldSatisfy` isLeft
executeOperator OpNeg [VInt 1, VInt 2] `shouldSatisfy` isLeft
it "keeps null comparisons three-valued" $ do
inValues VNull [VInt 1] `shouldBe` Right VNull
inValues (VInt 1) [VInt 1, VNull] `shouldBe` Right (VBool True)
inValues (VInt 2) [VInt 1, VNull] `shouldBe` Right VNull
threeValuedNot VNull `shouldBe` VNull
threeValuedNot (VBool True) `shouldBe` VBool False
describe "ChuSQL.Core.Engine.Parallel (分片调度与分片选择)" $ do
it "keeps the submission order of finished jobs" $ do
pool <- workerPool 4
results <- poolRun pool [delayed 30000 (1 :: Int), delayed 1000 2, delayed 20000 3]
results `shouldBe` [1, 2, 3]
it "dispatches every job without waiting for the slow one" $ do
pool <- workerPool 4
finished <- timeout 800000 (poolRun pool (replicate 4 (delayed 300000 ())))
finished `shouldBe` Just (replicate 4 ())
it "rethrows job failures in the submission order" $ do
pool <- workerPool 4
let failed = error "first bad job" :: IO ()
later = error "second bad job" :: IO ()
outcome <- try (poolRun pool (pure () : failed : [later])) :: IO (Either ErrorCall [()])
case outcome of
Left err -> show err `shouldContain` "first bad job"
Right _ -> expectationFailure "poolRun returned instead of rethrowing the job failure"
it "scans a small table in one sequential request" $ do
probe <- newProbe users 4
let op = Scan Nothing "users" Nothing
runProbeStorage (evalRelOpM testDB op) probe `shouldReturn` evalRelOp testDB op
recordedCalls probe `shouldReturn` ["scan:users"]
it "splits a large table into the available shards" $ do
probe <- newProbe bigTable 4
let op = Scan Nothing "big" Nothing
runProbeStorage (evalRelOpM bigDB op) probe `shouldReturn` evalRelOp bigDB op
recordedCalls probe `shouldReturn` ["scan_shards:4:big"]
it "projects columns through the shard path" $ do
probe <- newProbe bigTable 3
let op = Scan Nothing "big" (Just ["name"])
runProbeStorage (evalRelOpM bigDB op) probe `shouldReturn` evalRelOp bigDB op
recordedCalls probe `shouldReturn` ["scan_shards:3:big"]
it "reads shards of one table through the wire" $ do
withTestSession $ \srv -> withServerEnv srv $ do
let rows = [[("id", VInt i), ("name", VStr ("n" ++ show i))] | i <- [1 .. 400 :: Int]]
runIPCStorage (insertMany "wide" rows) `shouldReturn` Right ()
whole <- runIPCStorage (scan "wide")
fmap length whole `shouldBe` Right 400
shardRows <- runIPCStorage (scanShards 4 "wide" Nothing)
shardRows `shouldBe` whole
projected <- runIPCStorage (scanShards 4 "wide" (Just ["name"]))
fmap (map (map fst)) projected `shouldBe` Right (map (const ["name"]) rows)
fmap (concatMap (map snd)) projected
`shouldBe` Right (map (VStr . ("n" ++) . show) [1 .. 400 :: Int])
describe "ChuSQL.Core.Engine.Error (错误分类唯一入口)" $ do
it "maps messages to wire codes without changing them" $ do
errorCode "no database selected" `shouldBe` "no_database"
errorCode "administrator required" `shouldBe` "forbidden"
errorCode "unknown table: t" `shouldBe` "not_found"
errorCode "unknown column: c" `shouldBe` "query_error"
errorCode "type error: expected two numbers" `shouldBe` "query_error"
errorCode "something else" `shouldBe` "query_error"
it "keeps the account service codes in the same module" $ do
accountErrorCode "account already exists" `shouldBe` "conflict"
accountErrorCode "unknown account" `shouldBe` "not_found"
accountErrorCode "disk gone" `shouldBe` "storage_error"
it "classifies the same messages into categories" $ do
errorCategory "no database selected" `shouldBe` NoDatabaseError
errorCategory "administrator required" `shouldBe` PermissionError
errorCategory "unknown table: t" `shouldBe` CatalogError
errorCategory "type error: expected two numbers" `shouldBe` TypeError
errorCategory "storage library call failed: x" `shouldBe` StorageError
errorCategory "unsupported protocol version" `shouldBe` ProtocolError
errorCategory "something else" `shouldBe` UnknownError
-- | 每个测试表都清空行后的库
emptyDB :: Database
emptyDB = [(n, t{tableRows = []}) | (n, t) <- testDB]
@@ -1984,6 +2291,94 @@ isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft (Right _) = False
-- | 延时后返回一个值
delayed :: Int -> a -> IO a
delayed micros value = threadDelay micros >> pure value
-- | 造一个记录调用序列的探针
newProbe :: Table -> Int -> IO Probe
newProbe table width = do
calls <- newMVar []
pure Probe {probeTable = table, probeCalls = calls, probeWidth = width}
-- | 记一条存储调用
recordCall :: Probe -> String -> IO ()
recordCall probe name = modifyMVar_ (probeCalls probe) (\calls -> pure (calls ++ [name]))
-- | 取回调用序列
recordedCalls :: Probe -> IO [String]
recordedCalls = readMVar . probeCalls
-- | 按列投影(空清单保留行)
projectColumns :: [String] -> [Row] -> [Row]
projectColumns cols = map (\row -> [(c, v) | c <- cols, Just v <- [lookup c row]])
-- | 按行数切成连续分片
rowShards :: Int -> [a] -> [[a]]
rowShards width rows
| width <= 1 = [rows]
| otherwise = go rows
where
-- | 每片行数
chunk = (length rows + width - 1) `div` width
-- | 反复切出前一片
go rest
| null rest = []
| otherwise = let (part, more) = splitAt chunk rest in part : go more
-- | 声明 1000 行的大表
bigTable :: Table
bigTable = users {tableName = "big", tableMeta = Just (TableMeta 1000 [("id", 1000, False)] ["id"])}
-- | 只装大表的库
bigDB :: Database
bigDB = [("big", bigTable)]
-- | 记录存储调用、按行分片的假存储
data Probe = Probe
{ probeTable :: Table
, probeCalls :: MVar [String]
, probeWidth :: Int
}
-- | 探针单子
newtype ProbeStorage a = ProbeStorage {runProbeStorage :: Probe -> IO a}
instance Functor ProbeStorage where
fmap f (ProbeStorage act) = ProbeStorage (fmap f . act)
instance Applicative ProbeStorage where
pure value = ProbeStorage (\_ -> pure value)
ProbeStorage fn <*> ProbeStorage act = ProbeStorage (\probe -> fn probe <*> act probe)
instance Monad ProbeStorage where
ProbeStorage act >>= next =
ProbeStorage (\probe -> act probe >>= \value -> runProbeStorage (next value) probe)
instance MonadStorage ProbeStorage where
scan table = ProbeStorage $ \probe -> do
recordCall probe ("scan:" ++ table)
pure (Right (tableRows (probeTable probe)))
scanColumns table columns = ProbeStorage $ \probe -> do
recordCall probe ("scan_columns:" ++ table)
pure (Right (projectColumns columns (tableRows (probeTable probe))))
parallelShards = ProbeStorage (pure . probeWidth)
scanShards width table columns = ProbeStorage $ \probe -> do
recordCall probe ("scan_shards:" ++ show width ++ ":" ++ table)
let rows = maybe id projectColumns columns (tableRows (probeTable probe))
pure (Right (concat (rowShards width rows)))
insert _ _ = ProbeStorage (\_ -> pure (Left "probe: insert is not supported"))
replaceAll _ _ = ProbeStorage (\_ -> pure (Left "probe: replaceAll is not supported"))
createTable _ _ = ProbeStorage (\_ -> pure (Left "probe: createTable is not supported"))
dropTable _ = ProbeStorage (\_ -> pure (Left "probe: dropTable is not supported"))
dropColumn _ _ = ProbeStorage (\_ -> pure (Left "probe: dropColumn is not supported"))
replaceSchema _ _ _ = ProbeStorage (\_ -> pure (Left "probe: replaceSchema is not supported"))
snapshot = ProbeStorage (\_ -> pure [])
-- | 判断 Either 是 Right
isRight :: Either a b -> Bool
isRight (Right _) = True
@@ -2018,6 +2413,27 @@ optimizedPlan sql = do
q <- parseStatement sql
optimize testDB <$> translate q
-- | 在给定库上解析并优化 SQL,返回计划
optimizedPlanIn :: Database -> String -> Either String RelOp
optimizedPlanIn db sql = do
q <- parseStatement sql
optimize db <$> translate q
-- | 计划里出现的表名(先序)
planTables :: RelOp -> [String]
planTables op = case op of
Scan _ t _ -> [t]
Lookup _ t _ _ -> [t]
Range _ t _ _ _ -> [t]
Filter _ x -> planTables x
Project _ x -> planTables x
Compute _ x -> planTables x
Aggregate _ _ x -> planTables x
Sort _ x -> planTables x
Limit _ x -> planTables x
Join _ l r _ -> planTables l ++ planTables r
Unit -> []
-- | 计划里每个 Join 节点是不是 LEFT JOIN(先序)
leftJoinKinds :: RelOp -> [Bool]
leftJoinKinds (Join kind l r _) = (kind == LeftJoin) : (leftJoinKinds l ++ leftJoinKinds r)
+79 -6
View File
@@ -9,6 +9,7 @@ module ChuSQL.Core.Model
, TypeClass (..)
, Value (..)
, Row
, TableMeta (..)
, Table (..)
, Database
, colNames
@@ -24,10 +25,15 @@ module ChuSQL.Core.Model
, parseColumnType
, typeClassOf
, assignable
, comparableTypes
, integerType
, numericType
, valueFits
, coerceValue
, canonicalValue
, compareValue
, valuesEqual
, hashValue
) where
import Data.Char (isDigit, isSpace, toLower)
@@ -230,6 +236,19 @@ integerType CBigInt = True
integerType CSmallInt = True
integerType _ = False
-- | 比较用的类型族:同大类可比,日期时间与文本互比
comparableTypes :: ColumnType -> ColumnType -> Bool
comparableTypes a b = sameClass || crossTemporal
where
-- | 两个类型同属一个大类
sameClass = typeClassOf a == typeClassOf b
-- | 时间与文本放在一起比
crossTemporal = (temporal a && textual b) || (textual a && temporal b)
-- | 是不是时间类型
temporal t = typeClassOf t == TemporalClass
-- | 是不是文本类型
textual t = typeClassOf t == TextClass
-- | 是不是数值类型
numericType :: ColumnType -> Bool
numericType t = typeClassOf t == NumericClass
@@ -363,22 +382,76 @@ data Value
| VBool Bool
deriving (Show, Eq)
-- | 值的比较关键字:整值浮点折成整数
canonicalValue :: Value -> Value
canonicalValue (VFloat d)
| wholeDouble d = VInt (truncate d)
canonicalValue v = v
-- | 浮点是不是能精确折成整数的整值
wholeDouble :: Double -> Bool
wholeDouble d =
not (isNaN d)
&& not (isInfinite d)
&& abs d <= 9007199254740992
&& d == fromIntegral (truncate d :: Int)
-- | 值的全序:NULL 最小,数值跨类型比大小,异族按族的先后
compareValue :: Value -> Value -> Ordering
compareValue a b = case (canonicalValue a, canonicalValue b) of
(VNull, VNull) -> EQ
(VNull, _) -> LT
(_, VNull) -> GT
(VInt x, VInt y) -> compare x y
(VInt x, VFloat y) -> compare (fromIntegral x) y
(VFloat x, VInt y) -> compare x (fromIntegral y)
(VFloat x, VFloat y) -> compare x y
(VStr x, VStr y) -> compare x y
(VBool x, VBool y) -> compare x y
(x, y) -> compare (valueRank x) (valueRank y)
-- | 族的先后,只用来给异族值定序
valueRank :: Value -> Int
valueRank VNull = 0
valueRank (VInt _) = 1
valueRank (VFloat _) = 1
valueRank (VStr _) = 2
valueRank (VBool _) = 3
-- | 相等语义:比较关键字相同即相等,与 hashValue 配套
valuesEqual :: Value -> Value -> Bool
valuesEqual a b = canonicalValue a == canonicalValue b
-- | 值的关键字哈希,与 valuesEqual 用同一套关键字
hashValue :: Value -> Int
hashValue v = case canonicalValue v of
VNull -> hashWithSalt 0 (0 :: Int)
VInt n -> hashWithSalt 1 n
VFloat d -> hashWithSalt 1 d
VStr t -> hashWithSalt 2 t
VBool b -> hashWithSalt 3 b
-- | 值按类型打散搅拌
instance Hashable Value where
hashWithSalt s VNull = hashWithSalt (hashWithSalt s (0 :: Int)) ()
hashWithSalt s (VInt n) = hashWithSalt (hashWithSalt s (1 :: Int)) n
hashWithSalt s (VFloat d) = hashWithSalt (hashWithSalt s (2 :: Int)) d
hashWithSalt s (VStr t) = hashWithSalt (hashWithSalt s (3 :: Int)) t
hashWithSalt s (VBool b) = hashWithSalt (hashWithSalt s (4 :: Int)) b
hashWithSalt s = hashWithSalt s . hashValue
-- | 一行数据
type Row = [(String, Value)]
-- | 一张表:名字、列定义与全部行
-- | 一张表的统计:行数、各列不同值数(capped 表示只数到上限)、有索引的列
data TableMeta = TableMeta
{ metaRowCount :: Int
, metaDistinct :: [(String, Int, Bool)]
, metaIndexes :: [String]
}
deriving (Show)
-- | 一张表:名字、列定义与全部行;meta 为存储层统计,拿不到是 Nothing
data Table = Table
{ tableName :: String
, tableCols :: [(String, Column)]
, tableRows :: [Row]
, tableMeta :: Maybe TableMeta
}
deriving (Show)
@@ -80,6 +80,7 @@ data Request
| ReqAccountDrop T.Text
| ReqScan String
| ReqScanColumns String [String]
| ReqScanShard String (Maybe [String]) Int Int
| ReqInsert String Row
| ReqInsertBatch String [Row]
| ReqDeleteKeys String [Int]
@@ -111,6 +112,14 @@ instance ToJSON Request where
toJSON ReqPing = object ["method" .= ("ping" :: T.Text)]
toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t]
toJSON (ReqScanColumns t cols) = object ["method" .= ("scan" :: T.Text), "table" .= t, "columns" .= cols]
toJSON (ReqScanShard t cols shard shards) =
object
[ "method" .= ("scan_shard" :: T.Text)
, "table" .= t
, "columns" .= cols
, "shard" .= shard
, "shards" .= shards
]
toJSON (ReqInsert t r) =
object
[ "method" .= ("insert" :: T.Text)
+47 -6
View File
@@ -73,14 +73,25 @@ fn unpack_position(v: u64) -> (PageId, u16) {
(v >> 16, (v & 0xFFFF) as u16)
}
/// 取行里某一列的整数值(不是整数就没有)
fn row_int(row: &Row, column: &str) -> Option<i64> {
match row.get(column) {
Some(serde_json::Value::Number(n)) => n.as_i64(),
/// 数值里取整数,整值浮点折成整数
pub(crate) fn scalar_int(v: &serde_json::Value) -> Option<i64> {
match v {
serde_json::Value::Number(n) => n.as_i64().or_else(|| {
let f = n.as_f64()?;
if f.fract() != 0.0 || f.abs() > 9_007_199_254_740_992.0 {
return None;
}
Some(f as i64)
}),
_ => None,
}
}
/// 取行里某一列的整数值(不是整数就没有)
fn row_int(row: &Row, column: &str) -> Option<i64> {
row.get(column).and_then(scalar_int)
}
/// i64 键 → 8 字节大端(保序,负数也在前)
fn key_of(value: i64) -> [u8; 8] {
(value as u64 ^ (1u64 << 63)).to_be_bytes()
@@ -89,7 +100,7 @@ fn key_of(value: i64) -> [u8; 8] {
/// JSON 值 → 索引键字节(与写索引时同一套编码)
fn value_key(v: &serde_json::Value) -> Option<Vec<u8>> {
match v {
serde_json::Value::Number(n) => n.as_i64().map(|k| key_of(k).to_vec()),
serde_json::Value::Number(_) => scalar_int(v).map(|k| key_of(k).to_vec()),
serde_json::Value::String(s) => Some(s.as_bytes().to_vec()),
serde_json::Value::Bool(b) => Some(vec![u8::from(*b)]),
_ => None,
@@ -613,11 +624,41 @@ impl HeapTable {
self.scan_projected_with_positions(None)
}
/// 分片扫描,只取 [from, to) 页区间内的行
pub fn scan_columns_pages(
&mut self,
columns: Option<&[String]>,
from: PageId,
to: PageId,
) -> io::Result<Vec<Row>> {
Ok(self
.scan_pages_with_positions(columns, from, to)?
.into_iter()
.map(|(_, _, r)| r)
.collect())
}
/// 当前页数
pub fn num_pages(&mut self) -> io::Result<u64> {
self.file.num_pages()
}
/// 全表扫描,带位置与列投影
fn scan_projected_with_positions(&mut self, columns: Option<&[String]>) -> io::Result<Vec<(PageId, u16, Row)>> {
let n = self.file.num_pages()?;
self.scan_pages_with_positions(columns, 0, n)
}
/// 扫描 [from, to) 页区间,带位置与列投影
fn scan_pages_with_positions(
&mut self,
columns: Option<&[String]>,
from: PageId,
to: PageId,
) -> io::Result<Vec<(PageId, u16, Row)>> {
let n = self.file.num_pages()?;
let mut out = Vec::new();
for i in 0..n {
for i in from..to.min(n) {
let tuples = self.file.with_page(i, |p| {
let mut v = Vec::new();
for slot in HeapPage::iter_slots(p) {
-206
View File
@@ -1,206 +0,0 @@
use crate::protocol::SchemaColumn;
// 读取 scripts/init.sql,只认 CREATE TABLE 与 CREATE INDEX。
// 系统库的 schema 由这份脚本声明,进程按它建系统表。
#[derive(Debug, Clone, PartialEq, Eq)]
pub struct InitColumn {
pub name: String,
pub ty: String,
pub nullable: bool,
pub auto_increment: bool,
pub primary_key: bool,
pub unique: bool,
}
#[derive(Debug, Clone, PartialEq, Eq)]
pub struct InitTable {
pub name: String,
pub columns: Vec<InitColumn>,
pub indexes: Vec<String>,
}
impl InitColumn {
/// 转成数据字典里的列
pub fn to_schema(&self) -> SchemaColumn {
SchemaColumn {
name: self.name.clone(),
ty: self.ty.clone(),
nullable: self.nullable,
default: None,
auto_increment: self.auto_increment,
primary_key: self.primary_key,
unique: self.unique,
check: None,
}
}
}
/// 解析整份脚本;不认识的语句直接报错,避免悄悄漏建表
pub fn parse(text: &str) -> Result<Vec<InitTable>, String> {
let mut tables: Vec<InitTable> = Vec::new();
for statement in statements(text) {
let words = statement.split_whitespace().collect::<Vec<_>>();
let head = |index: usize| words.get(index).map(|word| word.to_ascii_uppercase());
match (head(0).as_deref(), head(1).as_deref()) {
(Some("CREATE"), Some("TABLE")) => {
let name = clean_name(words.get(2).ok_or("CREATE TABLE needs a name")?);
let body = statement.split_once('(').ok_or("CREATE TABLE needs a column list")?.1;
let inner = body.rsplit_once(')').map(|(inner, _)| inner).unwrap_or(body);
tables.push(InitTable { name, columns: columns(inner)?, indexes: Vec::new() });
}
(Some("CREATE"), Some("INDEX")) => {
let table = clean_name(words.get(2).ok_or("CREATE INDEX needs a table")?);
let column = statement
.split_once('(')
.and_then(|(_, rest)| rest.split_once(')'))
.map(|(column, _)| clean_name(column))
.ok_or("CREATE INDEX needs a column")?;
let entry = tables
.iter_mut()
.find(|entry| entry.name.eq_ignore_ascii_case(&table))
.ok_or_else(|| format!("CREATE INDEX on unknown table: {table}"))?;
entry.indexes.push(column);
}
_ => return Err(format!("unsupported statement: {}", statement.trim())),
}
}
Ok(tables)
}
/// 解析表定义里的列清单
fn columns(body: &str) -> Result<Vec<InitColumn>, String> {
let mut out = Vec::new();
for part in split_top_level(body) {
let words = part.split_whitespace().collect::<Vec<_>>();
if words.is_empty() {
continue;
}
let keyword = words[0].to_ascii_uppercase();
if matches!(keyword.as_str(), "PRIMARY" | "UNIQUE" | "KEY" | "CONSTRAINT" | "INDEX" | "CHECK" | "FOREIGN") {
return Err(format!("table-level constraint is not supported: {}", part.trim()));
}
let name = clean_name(words[0]);
let ty = words
.get(1)
.ok_or_else(|| format!("column {name} needs a type"))?
.to_string();
let upper = part.to_ascii_uppercase();
out.push(InitColumn {
name,
ty,
nullable: !upper.contains("NOT NULL"),
auto_increment: upper.contains("AUTO_INCREMENT"),
primary_key: upper.contains("PRIMARY KEY"),
unique: upper.contains("UNIQUE"),
});
}
Ok(out)
}
/// 按顶层的逗号切开(类型里的括号不算)
fn split_top_level(body: &str) -> Vec<String> {
let mut parts = Vec::new();
let mut current = String::new();
let mut depth = 0;
for ch in body.chars() {
match ch {
'(' => {
depth += 1;
current.push(ch);
}
')' => {
depth -= 1;
current.push(ch);
}
',' if depth == 0 => {
parts.push(std::mem::take(&mut current));
}
_ => current.push(ch),
}
}
if !current.trim().is_empty() {
parts.push(current);
}
parts
}
/// 去掉反引号与空白
fn clean_name(raw: &str) -> String {
raw.trim().trim_matches('`').trim_matches('"').trim().to_string()
}
/// 去掉注释后按分号切开
fn statements(text: &str) -> Vec<String> {
let mut cleaned = String::new();
let mut chars = text.chars().peekable();
while let Some(ch) = chars.next() {
if ch == '-' && chars.peek() == Some(&'-') {
for next in chars.by_ref() {
if next == '\n' {
cleaned.push('\n');
break;
}
}
} else if ch == '/' && chars.peek() == Some(&'*') {
chars.next();
while let Some(next) = chars.next() {
if next == '*' && chars.peek() == Some(&'/') {
chars.next();
break;
}
}
} else {
cleaned.push(ch);
}
}
cleaned
.split(';')
.map(|statement| statement.trim().to_string())
.filter(|statement| !statement.is_empty())
.collect()
}
#[cfg(test)]
mod tests {
use super::*;
/// 仓库里的系统库脚本必须始终能解析
const SYSTEM_SCHEMA: &str = include_str!("../../../scripts/init.sql");
/// 仓库自带脚本必须能解析出账号表
#[test]
fn parses_the_repository_init_script() {
let tables = parse(SYSTEM_SCHEMA).expect("scripts/init.sql must parse");
let users = tables
.iter()
.find(|table| table.name == "__chusql_users")
.expect("init.sql must declare the account table");
let names: Vec<&str> = users.columns.iter().map(|column| column.name.as_str()).collect();
assert_eq!(names, ["id", "user", "password_hash", "registered_at", "last_login_at", "revision"]);
assert_eq!(users.columns[0].ty, "int");
assert!(users.columns[0].primary_key && users.columns[0].auto_increment && !users.columns[0].nullable);
assert_eq!(users.columns[1].ty, "varchar(64)");
assert!(users.columns[1].unique);
assert_eq!(users.columns[4].ty, "timestamp");
assert!(users.columns[4].nullable);
assert_eq!(users.indexes, ["user"]);
}
/// 未知语句与表级约束要报错
#[test]
fn rejects_unknown_statements_and_table_level_constraints() {
assert!(parse("DROP TABLE users;").is_err());
assert!(parse("CREATE TABLE t (id int, PRIMARY KEY (id));").is_err());
assert!(parse("CREATE INDEX missing (user);").is_err());
}
/// 注释与空语句要被跳过
#[test]
fn ignores_comments_and_blank_statements() {
let tables = parse("-- note\nCREATE TABLE t (a int NOT NULL);\n\n/* done */\n").unwrap();
assert_eq!(tables.len(), 1);
assert_eq!(tables[0].columns[0].name, "a");
assert!(!tables[0].columns[0].nullable);
}
}
-1
View File
@@ -5,7 +5,6 @@ pub mod catalog;
pub mod config;
pub mod ffi;
pub mod heap;
pub mod initsql;
pub mod log;
pub mod page;
pub mod protocol;
+23 -4
View File
@@ -5,7 +5,7 @@ use std::collections::HashMap;
pub type Row = HashMap<String, serde_json::Value>;
pub const USERS_TABLE: &str = "__chusql_users";
pub const USERS_TABLE: &str = "__system_users";
#[derive(Debug, Clone, Serialize, Deserialize, PartialEq, Eq)]
pub struct Account {
@@ -83,12 +83,28 @@ pub enum Request {
at: Option<String>,
},
AccountDrop { user: String },
/// 引导系统目录:建系统表,给了 user 就同时补首个管理员
BootstrapSystem {
#[serde(default)]
user: Option<String>,
#[serde(default)]
password_hash: Option<String>,
},
SystemStatus,
Ping,
Scan {
table: String,
#[serde(default)]
columns: Option<Vec<String>>,
},
/// 分片扫描:第 shard 片只读总页数按 shards 均分后的那一段
ScanShard {
table: String,
#[serde(default)]
columns: Option<Vec<String>>,
shard: u32,
shards: u32,
},
Insert {
table: String,
row: Row,
@@ -174,7 +190,8 @@ impl Request {
/// 普通表操作的统一访问边界
pub fn table(&self) -> Option<&str> {
match self {
Self::Scan { table, .. } | Self::Insert { table, .. }
Self::Scan { table, .. } | Self::ScanShard { table, .. }
| Self::Insert { table, .. }
| Self::InsertBatch { table, .. } | Self::DeleteKeys { table, .. }
| Self::LookupByIndex { table, .. } | Self::ReplaceAll { table, .. }
| Self::RangeByIndex { table, .. }
@@ -185,14 +202,14 @@ impl Request {
| Self::ReplaceSchema { table, .. } => Some(table),
Self::Ping | Self::ListTables | Self::ListCatalog | Self::AccountsList
| Self::AccountCreate { .. } | Self::AccountReset { .. } | Self::AccountLogin { .. }
| Self::AccountDrop { .. } => None,
| Self::AccountDrop { .. } | Self::BootstrapSystem { .. } | Self::SystemStatus => None,
}
}
}
/// 是不是保留系统表名
pub fn reserved_table(table: &str) -> bool {
table.to_ascii_lowercase().starts_with("__chusql_")
table.to_ascii_lowercase().starts_with("__system_")
}
/// 没写 column 时按 `id` 算
@@ -219,6 +236,8 @@ pub enum Response {
},
NoIndex,
Ok,
/// 系统目录状态
System { initialized: bool },
Error { message: String },
Catalog { schemas: Vec<TableSchemaWire> },
}
+232 -62
View File
@@ -1,12 +1,11 @@
use std::collections::HashMap;
use std::collections::{HashMap, HashSet};
use std::path::PathBuf;
use std::sync::atomic::{AtomicBool, Ordering};
use std::sync::{Arc, Mutex};
use std::sync::{Arc, Mutex, RwLock};
use crate::catalog::Catalog;
use crate::config::{self, Config, Loaded};
use crate::heap::HeapTable;
use crate::initsql::{self, InitColumn, InitTable};
use crate::heap::{scalar_int, HeapTable};
use crate::log;
use crate::protocol::{
reserved_table, Account, ColumnStatWire, IndexWire, Request, Response, Row, SchemaColumn, TableSchemaWire, USERS_TABLE,
@@ -21,6 +20,7 @@ struct Server {
cfg: Config,
tables: Mutex<HashMap<String, Arc<Mutex<HeapTable>>>>,
write_lock: Mutex<()>,
gate: RwLock<()>,
catalog: Mutex<Catalog>,
wal: Wal,
recovery_required: AtomicBool,
@@ -38,6 +38,7 @@ impl Server {
cfg,
tables: Mutex::new(HashMap::new()),
write_lock: Mutex::new(()),
gate: RwLock::new(()),
catalog: Mutex::new(catalog),
wal,
recovery_required: AtomicBool::new(false),
@@ -127,6 +128,56 @@ impl Server {
f(&mut guard)
}
/// 请求带列名时逐个查字典
fn check_columns(&self, table: &str, columns: Option<&[String]>) -> std::io::Result<()> {
let Some(cols) = columns else {
return Ok(());
};
let c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
let schema = c
.describe(table)
.ok_or_else(|| std::io::Error::other(format!("unknown table: {table}")))?;
for col in cols {
if !schema.columns.iter().any(|c| &c.name == col) {
return Err(std::io::Error::other(format!("unknown column: {col}")));
}
}
Ok(())
}
/// 分片只读扫描:独立句柄读一段连续页,不经表锁
fn scan_shard(
&self,
table: &str,
columns: Option<&[String]>,
shard: u32,
shards: u32,
) -> std::io::Result<Vec<Row>> {
if shards == 0 || shard >= shards {
return Err(std::io::Error::other("invalid shard range"));
}
if !self.table_exists(table)? {
return Err(std::io::Error::new(
std::io::ErrorKind::NotFound,
format!("unknown table: {}", table),
));
}
let hidden: HashSet<String> = self
.catalog
.lock()
.map_err(|_| std::io::Error::other("catalog lock poisoned"))?
.describe(table)
.map(|s| s.dropped_columns.iter().cloned().collect())
.unwrap_or_default();
let mut t = HeapTable::open(self.table_path(table), self.cfg.page_size, self.cfg.pool_size)?;
t.set_hidden_columns(hidden);
let n = t.num_pages()?;
let chunk = n.div_ceil(u64::from(shards));
let from = u64::from(shard).saturating_mul(chunk).min(n);
let to = u64::from(shard + 1).saturating_mul(chunk).min(n);
t.scan_columns_pages(columns, from, to)
}
/// 表不存在就报错
fn with_existing_table<R>(
&self,
@@ -528,6 +579,88 @@ impl Server {
Ok(())
}
/// 账号表是否已登记为系统表
fn account_table_ready(&self) -> std::io::Result<bool> {
use std::io::{Error, ErrorKind};
let registered = {
let c = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?;
c.describe(USERS_TABLE).map(|schema| schema.system)
};
match registered {
Some(true) => Ok(true),
Some(false) => Err(Error::new(ErrorKind::AlreadyExists, "reserved account table collision")),
None => {
if self.table_path(USERS_TABLE).exists() || self.index_path(USERS_TABLE, "id").exists() {
Err(Error::new(ErrorKind::AlreadyExists, "reserved account file collision"))
} else {
Ok(false)
}
}
}
}
/// 系统目录里账号表已登记
fn system_initialized(&self) -> bool {
self.catalog
.lock()
.map(|c| c.describe(USERS_TABLE).is_some_and(|schema| schema.system))
.unwrap_or(false)
}
/// 读账号表;表没登记或数据文件缺失都算错
fn load_accounts(&self) -> std::io::Result<Vec<Account>> {
use std::io::Error;
if !self.table_path(USERS_TABLE).exists() {
return Err(Error::other("missing account data"));
}
let mut accounts: Vec<Account> = self
.with_existing_table(USERS_TABLE, |t| t.scan())?
.iter()
.map(decode_account_row)
.collect::<std::io::Result<_>>()?;
for account in accounts.iter_mut() {
normalize_account(account);
}
Ok(accounts)
}
/// 引导系统目录:建账号表,空表才补管理员
fn bootstrap_system(&self, user: Option<&str>, password_hash: Option<&str>) -> std::io::Result<Vec<Account>> {
use std::io::Error;
let _guard = self.write_lock.lock().map_err(|_| Error::other("write lock poisoned"))?;
if self.recovery_required.load(Ordering::Acquire) {
return Err(Error::other("storage recovery required"));
}
let initialized = self.account_table_ready()?;
let mut accounts = if initialized { self.load_accounts()? } else { Vec::new() };
let mut changed = !initialized;
if let Some(user) = user {
let name = account_name(user)?;
// 表里已经有行就不再补人:引导程序只在空表上播种,
// 免得有人拿 storage 透传绕过账号接口往里塞一个已知口令的账号
if accounts.is_empty() && !accounts.iter().any(|a| a.user == name) {
let id = accounts.iter().map(|a| a.id).max().unwrap_or(0)
.checked_add(1).ok_or_else(|| Error::other("account id exhausted"))?;
accounts.push(new_account(id, &name, password_hash.unwrap_or_default().to_string())?);
changed = true;
}
}
if !changed {
return Ok(accounts);
}
for row in account_rows(&accounts)? {
HeapTable::encode_row(&row, self.cfg.page_size)?;
}
let op = WalOp::Accounts { accounts: accounts.clone() };
self.recovery_required.store(true, Ordering::Release);
self.wal.truncate()?;
self.wal.append(&op)?;
self.apply_op(&op)?;
self.wal.clear()?;
self.recovery_required.store(false, Ordering::Release);
Ok(accounts)
}
/// 账号读写共享串行持久化边界
fn accounts_request(&self, request: Request) -> std::io::Result<Vec<Account>> {
use std::io::{Error, ErrorKind};
@@ -535,31 +668,10 @@ impl Server {
if self.recovery_required.load(Ordering::Acquire) {
return Err(Error::other("storage recovery required"));
}
let initialized = {
let c = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?;
match c.describe(USERS_TABLE) {
Some(schema) if schema.system => true,
Some(_) => return Err(Error::new(ErrorKind::AlreadyExists, "reserved account table collision")),
None => false,
}
};
if !initialized && (self.table_path(USERS_TABLE).exists() || self.index_path(USERS_TABLE, "id").exists()) {
return Err(Error::new(ErrorKind::AlreadyExists, "reserved account file collision"));
if !self.account_table_ready()? {
return Err(Error::other("system catalog is not initialized; run csql-bootstrap"));
}
let mut accounts: Vec<Account> = if initialized {
if !self.table_path(USERS_TABLE).exists() {
return Err(Error::other("missing account data"));
}
let mut loaded: Vec<Account> = self
.with_existing_table(USERS_TABLE, |t| t.scan())?
.iter()
.map(decode_account_row)
.collect::<std::io::Result<_>>()?;
for account in loaded.iter_mut() {
normalize_account(account);
}
loaded
} else { Vec::new() };
let mut accounts = self.load_accounts()?;
match request {
Request::AccountsList => return Ok(accounts),
Request::AccountCreate { user, password_hash } => {
@@ -609,8 +721,27 @@ impl Server {
Ok(accounts)
}
/// 一条请求翻成一条响应
/// 一条请求翻成一条响应:先过读/写门再分发
fn handle_request(&self, req: Request) -> Response {
if concurrent_read(&req) {
match self.gate.read() {
Ok(_read) => self.dispatch(req),
Err(_) => Response::Error {
message: "storage read gate poisoned".into(),
},
}
} else {
match self.gate.write() {
Ok(_write) => self.dispatch(req),
Err(_) => Response::Error {
message: "storage write gate poisoned".into(),
},
}
}
}
/// 持门后分发一条请求
fn dispatch(&self, req: Request) -> Response {
let _ddl_guard = if matches!(req, Request::CreateTable { .. } | Request::DropTable { .. }
| Request::CreateIndex { .. } | Request::DropIndex { .. }) {
match self.write_lock.lock() {
@@ -641,6 +772,13 @@ impl Server {
Err(e) => Response::Error { message: e.to_string() },
}
}
Request::BootstrapSystem { user, password_hash } => {
match self.bootstrap_system(user.as_deref(), password_hash.as_deref()) {
Ok(_) => Response::System { initialized: true },
Err(e) => Response::Error { message: e.to_string() },
}
}
Request::SystemStatus => Response::System { initialized: self.system_initialized() },
Request::Ping => {
log_debug!(request, "ping");
Response::Pong
@@ -650,15 +788,7 @@ impl Server {
log_debug!(request, "scan table={}", table);
let result = (|| {
if let Some(cols) = &columns {
let c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
let schema = c.describe(&table).ok_or_else(|| std::io::Error::other(format!("unknown table: {table}")))?;
for col in cols {
if !schema.columns.iter().any(|c| &c.name == col) {
return Err(std::io::Error::other(format!("unknown column: {col}")));
}
}
}
self.check_columns(&table, columns.as_deref())?;
self.with_existing_table(&table, |t| t.scan_columns(columns.as_deref()))
})();
@@ -673,6 +803,30 @@ impl Server {
}
}
Request::ScanShard {
table,
columns,
shard,
shards,
} => {
log_debug!(request, "scan_shard table={} shard={}/{}", table, shard, shards);
let result = (|| {
self.check_columns(&table, columns.as_deref())?;
self.scan_shard(&table, columns.as_deref(), shard, shards)
})();
match result {
Ok(rows) => Response::Rows { rows },
Err(e) => {
log_warn!(request, "scan {} shard {}/{}: {}", table, shard, shards, e);
Response::Error {
message: format!("scan {}: {}", table, e),
}
}
}
}
Request::Insert { table, row } => {
log_debug!(request, "insert table={}", table);
let tname = table.clone();
@@ -733,7 +887,7 @@ impl Server {
if !indexed {
return Response::NoIndex;
}
let found = match key.as_i64() {
let found = match scalar_int(&key) {
Some(k) => self.with_table(&table, |t| t.get_all_by_column_key(&column, k)),
None => match key.as_str() {
Some(s) => self.with_table(&table, |t| t.get_all_by_string_key(&column, s)),
@@ -1025,18 +1179,31 @@ fn account_rows(accounts: &[Account]) -> std::io::Result<Vec<Row>> {
]))).collect()
}
/// 按 init.sql 把系统表写进字典
/// 系统库的账号表结构:引导模块按这份定义建表
fn users_columns() -> Vec<SchemaColumn> {
vec![
SchemaColumn { name: "id".into(), ty: "int".into(), nullable: false,
auto_increment: true, primary_key: true, ..Default::default() },
SchemaColumn { name: "user".into(), ty: "varchar(64)".into(), nullable: false,
unique: true, ..Default::default() },
SchemaColumn { name: "password_hash".into(), ty: "varchar(256)".into(),
nullable: false, ..Default::default() },
SchemaColumn { name: "registered_at".into(), ty: "timestamp".into(),
nullable: false, ..Default::default() },
SchemaColumn { name: "last_login_at".into(), ty: "timestamp".into(),
..Default::default() },
SchemaColumn { name: "revision".into(), ty: "int".into(), nullable: false,
..Default::default() },
]
}
/// 把系统表写进字典
fn declare_system_schema(catalog: &mut Catalog, rows: &[Row]) -> std::io::Result<()> {
for table in system_schema() {
let stats: &[Row] = if table.name == USERS_TABLE { rows } else { &[] };
catalog.rebuild_stats(&table.name, stats);
catalog.set_columns(&table.name, table.columns.iter().map(InitColumn::to_schema).collect())?;
catalog.rebuild_stats(&table.name, stats);
catalog.mark_system(&table.name)?;
for index in &table.indexes {
catalog.add_index(&table.name, index)?;
}
}
catalog.rebuild_stats(USERS_TABLE, rows);
catalog.set_columns(USERS_TABLE, users_columns())?;
catalog.rebuild_stats(USERS_TABLE, rows);
catalog.mark_system(USERS_TABLE)?;
catalog.add_index(USERS_TABLE, "user")?;
Ok(())
}
@@ -1110,9 +1277,9 @@ fn account_name(user: &str) -> std::io::Result<String> {
Ok(user.to_ascii_lowercase())
}
/// 校验口令哈希长度
/// 校验口令哈希长度,空串表示免密
fn validate_account_hash(hash: &str) -> std::io::Result<()> {
if hash.is_empty() || hash.len() > 256 {
if hash.len() > 256 {
return Err(std::io::Error::other("invalid account credential"));
}
Ok(())
@@ -1172,15 +1339,6 @@ impl Drop for Server {
/// 别的库一律要显式建(没有默认工作库)。
const SYSTEM_DATABASE: &str = "system";
/// 系统库的表结构来自这份脚本(编译期嵌进来)
const SYSTEM_SCHEMA_SQL: &str = include_str!("../../../scripts/init.sql");
/// 系统库 schema:脚本缺表或多表都按它来
fn system_schema() -> &'static [InitTable] {
static TABLES: std::sync::OnceLock<Vec<InitTable>> = std::sync::OnceLock::new();
TABLES.get_or_init(|| initsql::parse(SYSTEM_SCHEMA_SQL).unwrap_or_else(|e| panic!("scripts/init.sql: {e}")))
}
/// 保留库:不能建、不能删。
fn reserved_database(name: &str) -> bool {
name == SYSTEM_DATABASE
@@ -1322,7 +1480,8 @@ impl Databases {
let request: Request = serde_json::from_value(value).map_err(Error::other)?;
let global = matches!(request, Request::AccountsList | Request::AccountCreate { .. }
| Request::AccountReset { .. } | Request::AccountLogin { .. }
| Request::AccountDrop { .. } | Request::Ping);
| Request::AccountDrop { .. } | Request::BootstrapSystem { .. }
| Request::SystemStatus | Request::Ping);
let server = if global { &self.system }
else if selected.is_empty() { return Err(Error::other("no database selected")); }
else if selected == SYSTEM_DATABASE { &self.system }
@@ -1331,6 +1490,17 @@ impl Databases {
}
}
/// 只读表页的请求可与其它读并发,其余独占
fn concurrent_read(req: &Request) -> bool {
matches!(
req,
Request::Scan { .. }
| Request::ScanShard { .. }
| Request::LookupByIndex { .. }
| Request::RangeByIndex { .. }
)
}
/// 校验库名是否合法
fn valid_database(name: &str) -> bool {
let lower = name.to_ascii_lowercase();
+322 -16
View File
@@ -32,6 +32,190 @@ fn scan_projects_columns_and_preserves_empty_rows() -> Result<(), Box<dyn std::e
Ok(())
}
/// 分片扫描按页序拼接后与整表扫描逐行一致
#[test]
fn scan_shard_concatenates_to_the_whole_scan() -> Result<(), Box<dyn std::error::Error>> {
let (_srv, data) = start_server();
let mut c = connect()?;
request_ok(&mut c, serde_json::json!({"method":"create_table","table":"wide","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?;
let rows: Vec<serde_json::Value> = (1..=1200)
.map(|i| serde_json::json!({"id": i, "name": format!("row-{i:04}")}))
.collect();
request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"wide","rows":rows}))?;
let heap_bytes = std::fs::metadata(data.path().join("databases/main/wide.db"))?.len();
assert!(heap_bytes > 4 * 4096, "分片要有意义得多页,实际只有 {heap_bytes} 字节");
let whole: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"wide"}"#))?;
let all = whole["rows"].as_array().expect("rows").clone();
assert_eq!(all.len(), 1200);
for shards in [1, 3, 4, 7, 16] {
let mut merged = Vec::new();
for shard in 0..shards {
let request = serde_json::json!({"method":"scan_shard","table":"wide","shard":shard,"shards":shards});
let part: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?;
assert_eq!(part["status"], "rows", "shards={shards} shard={shard}: {part}");
merged.extend(part["rows"].as_array().expect("rows").iter().cloned());
}
assert_eq!(
serde_json::Value::Array(merged),
serde_json::Value::Array(all.clone()),
"{shards} 个分片拼接后必须与整表同序"
);
}
Ok(())
}
/// 分片扫描支持投影与空列,越界分片和未知名都明确报错
#[test]
fn scan_shard_projects_columns_and_rejects_bad_ranges() -> Result<(), Box<dyn std::error::Error>> {
let (_srv, _data) = start_server();
let mut c = connect()?;
request_ok(&mut c, serde_json::json!({"method":"create_table","table":"items","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?;
request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"items","rows":[{"id":1,"name":"one"},{"id":2,"name":null}]}))?;
for (columns, expected) in [
(serde_json::json!(["name"]), serde_json::json!([{"name":"one"},{"name":null}])),
(serde_json::json!([]), serde_json::json!([{},{}])),
] {
let mut merged = Vec::new();
for shard in 0..3 {
let request = serde_json::json!({"method":"scan_shard","table":"items","columns":columns,"shard":shard,"shards":3});
let part: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?;
assert_eq!(part["status"], "rows", "{part}");
merged.extend(part["rows"].as_array().expect("rows").iter().cloned());
}
assert_eq!(serde_json::Value::Array(merged), expected);
}
request_ok(&mut c, serde_json::json!({"method":"create_table","table":"blank","columns":[{"name":"id","ty":"int"}]}))?;
for (line, why) in [
(r#"{"method":"scan_shard","table":"blank","shard":0,"shards":4}"#, "空表"),
(r#"{"method":"scan_shard","table":"items","shard":3,"shards":3}"#, "分片号越界"),
(r#"{"method":"scan_shard","table":"items","shard":0,"shards":0}"#, "分片数为零"),
(r#"{"method":"scan_shard","table":"missing","shard":0,"shards":2}"#, "未知表"),
(r#"{"method":"scan_shard","table":"items","columns":["missing"],"shard":0,"shards":2}"#, "未知列"),
] {
let result: serde_json::Value = serde_json::from_str(&send(&mut c, line))?;
if why == "空表" {
assert_eq!(result["rows"], serde_json::json!([]), "{line}");
} else {
assert_eq!(result["status"], "error", "{why}: {line} -> {result}");
}
}
Ok(())
}
/// 多线程并发分片读同一实例,各分片结果与整表一致
#[test]
fn concurrent_shard_reads_share_one_instance() -> Result<(), Box<dyn std::error::Error>> {
let (_srv, _data) = start_server();
let mut c = connect()?;
request_ok(&mut c, serde_json::json!({"method":"create_table","table":"wide","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?;
let rows: Vec<serde_json::Value> = (1..=600)
.map(|i| serde_json::json!({"id": i, "name": format!("row-{i:04}")}))
.collect();
request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"wide","rows":rows}))?;
let storage = CURRENT.with(|slot| slot.borrow().as_ref().cloned().expect("storage opened"));
let shards = 4;
let parts = std::thread::scope(|scope| {
let handles: Vec<_> = (0..shards)
.map(|shard| {
let storage = Arc::clone(&storage);
scope.spawn(move || {
let request = format!(
r#"{{"method":"scan_shard","database":"{FIXTURE_DATABASE}","table":"wide","shard":{shard},"shards":{shards}}}"#
);
let mut rows = Vec::new();
for _ in 0..4 {
let reply = storage.request_line(&request);
let value: serde_json::Value = serde_json::from_str(&reply).expect("json");
assert_eq!(value["status"], "rows", "{reply}");
rows = value["rows"].as_array().expect("rows").clone();
}
rows
})
})
.collect();
handles
.into_iter()
.map(|h| h.join().expect("worker thread"))
.collect::<Vec<_>>()
});
let whole: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"wide"}"#))?;
let merged: Vec<serde_json::Value> = parts.into_iter().flatten().collect();
assert_eq!(merged.len(), 600, "并发分片不能丢行");
assert_eq!(serde_json::Value::Array(merged), whole["rows"]);
Ok(())
}
/// 分片读与同表写并发时读者只看到一致快照
#[test]
fn concurrent_shard_reads_exclude_writers() -> Result<(), Box<dyn std::error::Error>> {
let (_srv, _data) = start_server();
let mut c = connect()?;
request_ok(&mut c, serde_json::json!({"method":"create_table","table":"wide","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?;
let rows: Vec<serde_json::Value> = (1..=400)
.map(|i| serde_json::json!({"id": i, "name": format!("row-{i:04}")}))
.collect();
request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"wide","rows":rows}))?;
let storage = CURRENT.with(|slot| slot.borrow().as_ref().cloned().expect("storage opened"));
let shards = 3;
let inserted = 20;
std::thread::scope(|scope| {
let writer = {
let storage = Arc::clone(&storage);
scope.spawn(move || {
for i in 401..=400 + inserted {
let request = format!(
r#"{{"method":"insert","database":"{FIXTURE_DATABASE}","table":"wide","row":{{"id":{i},"name":"row-{i:04}"}}}}"#
);
let reply = storage.request_line(&request);
let value: serde_json::Value = serde_json::from_str(&reply).expect("json");
assert_eq!(value["status"], "ok", "{reply}");
}
})
};
let readers: Vec<_> = (0..3)
.map(|_| {
let storage = Arc::clone(&storage);
scope.spawn(move || {
let mut seen = Vec::new();
for _ in 0..8 {
let mut total = 0usize;
for shard in 0..shards {
let request = format!(
r#"{{"method":"scan_shard","database":"{FIXTURE_DATABASE}","table":"wide","shard":{shard},"shards":{shards}}}"#
);
let reply = storage.request_line(&request);
let value: serde_json::Value = serde_json::from_str(&reply).expect("json");
assert_eq!(value["status"], "rows", "{reply}");
total += value["rows"].as_array().expect("rows").len();
}
seen.push(total);
}
seen
})
})
.collect();
for reader in readers {
let seen: Vec<usize> = reader.join().expect("reader thread");
assert!(
seen.iter().all(|n| (400..=400 + inserted).contains(n)),
"分片读看到越界行数: {seen:?}"
);
assert!(
seen.windows(2).all(|pair| pair[0] <= pair[1]),
"并发写时快照行数倒退: {seen:?}"
);
}
writer.join().expect("writer thread");
});
let whole: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"wide"}"#))?;
assert_eq!(whole["rows"].as_array().expect("rows").len(), 400 + inserted);
Ok(())
}
/// 删列不改堆字节,重启后不再暴露该列
#[test]
fn drop_column_keeps_heap_bytes_and_hides_values_after_restart() -> Result<(), Box<dyn std::error::Error>> {
@@ -240,7 +424,7 @@ fn startup_compaction_reclaims_dropped_columns() -> Result<(), Box<dyn std::erro
fn databases_reject_unsafe_names_and_keep_only_system_reserved() -> Result<(), Box<dyn std::error::Error>> {
let (_srv, data) = start_server();
let mut c = connect()?;
for database in ["", "../escape", "a/b", "a.b", "CON", "__chusql_users"] {
for database in ["", "../escape", "a/b", "a.b", "CON", "__system_users"] {
let response: serde_json::Value = serde_json::from_str(&send(&mut c, &serde_json::json!({"method":"create_database","database":database}).to_string()))?;
assert_eq!(response["status"], "error", "{database}: {response}");
}
@@ -270,7 +454,7 @@ fn system_database_owns_accounts_and_nothing_is_default() -> Result<(), Box<dyn
assert_eq!(listed["tables"], serde_json::json!(["main", "system"]));
let created: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-1"}"#))?;
assert_eq!(created["status"], "accounts", "{created}");
assert!(data.path().join("system/__chusql_users.db").is_file());
assert!(data.path().join("system/__system_users.db").is_file());
// 账号是全局的:请求里带的库名对账号操作不起作用
let accounts: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"accounts_list","database":"sales"}"#))?;
assert_eq!(accounts["status"], "accounts");
@@ -323,9 +507,10 @@ fn start_server() -> (ServerProc, tempfile::TempDir) {
(server, data)
}
/// 在指定数据目录起存储并建测试库
/// 在指定数据目录起存储、引导系统目录并建测试库
fn start_server_in(data: &std::path::Path) -> ServerProc {
open_storage(&write_config(data));
bootstrap_system();
create_fixture_database();
ServerProc
}
@@ -371,7 +556,7 @@ fn named_database_survives_restart_and_accounts_stay_global() -> Result<(), Box<
assert_eq!(rows["rows"], serde_json::json!([{"id":7}]));
let accounts: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"accounts_list","database":"sales"}"#))?;
assert_eq!(accounts["status"], "accounts");
let hidden: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"sales.__chusql_users"}"#))?;
let hidden: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"sales.__system_users"}"#))?;
assert_eq!(hidden["status"], "error");
Ok(())
}
@@ -404,6 +589,15 @@ fn create_fixture_database() {
}
}
/// 引导系统目录:建账号表,不塞账号
fn bootstrap_system() {
let reply = CURRENT.with(|slot| {
let storage = slot.borrow().as_ref().cloned().expect("storage opened");
storage.request_line(r#"{"method":"bootstrap_system"}"#)
});
assert!(reply.contains(r#""status":"system""#), "{reply}");
}
/// 发一行请求读一行响应(没写库名就补测试库)
fn send(c: &mut Conn, line: &str) -> String {
send_raw(c, &with_default_database(line))
@@ -437,7 +631,7 @@ fn reserved_tables_reject_every_generic_operation() -> std::io::Result<()> {
for method in ["scan", "insert", "insert_batch", "delete_keys", "lookup_by_index",
"replace_all", "describe_table", "create_table", "drop_table", "create_index",
"drop_index", "drop_column"] {
let request = serde_json::json!({"method": method, "table": "__chusql_users",
let request = serde_json::json!({"method": method, "table": "__system_users",
"column": "id", "key": 1, "keys": [], "row": {"id": 1}, "rows": [], "columns": []});
let result = send(&mut c, &request.to_string());
assert!(result.contains("reserved system table"), "{method}: {result}");
@@ -450,11 +644,11 @@ fn reserved_tables_reject_every_generic_operation() -> std::io::Result<()> {
fn generic_ipc_rejects_path_aliases() -> std::io::Result<()> {
let (_srv, _data) = start_server();
let mut c = connect()?;
for table in ["../__chusql_users", "__CHUSQL_USERS", "__chusql_users."] {
for table in ["../__system_users", "__SYSTEM_USERS", "__system_users."] {
let result = send(&mut c, &serde_json::json!({"method":"scan", "table":table}).to_string());
assert!(result.contains("error"), "{result}");
}
let result = send(&mut c, r#"{"method":"create_index","table":"business","column":"../__chusql_users"}"#);
let result = send(&mut c, r#"{"method":"create_index","table":"business","column":"../__system_users"}"#);
assert!(result.contains("invalid column name"), "{result}");
Ok(())
}
@@ -484,7 +678,7 @@ fn account_create_reset_drop_and_hidden_from_ordinary_api() -> Result<(), Box<dy
assert_eq!(empty["accounts"], serde_json::json!([]));
for method in ["list_tables", "list_catalog"] {
let result = send(&mut c, &serde_json::json!({"method":method}).to_string());
assert!(!result.contains("__chusql_users"), "{result}");
assert!(!result.contains("__system_users"), "{result}");
}
Ok(())
}
@@ -492,6 +686,7 @@ fn account_create_reset_drop_and_hidden_from_ordinary_api() -> Result<(), Box<dy
/// 用同一份数据目录重开一次存储
fn restart_at(data: &std::path::Path) -> std::io::Result<ServerProc> {
open_storage(&write_config(data));
bootstrap_system();
create_fixture_database();
Ok(ServerProc)
}
@@ -514,8 +709,8 @@ fn account_snapshot_replays_twice_without_duplicating_accounts() -> Result<(), B
wal.truncate()?;
wal.append(&WalOp::Accounts { accounts: accounts.clone() })?;
drop(wal);
std::fs::write(data.path().join("system/__chusql_users.idx"), b"torn index")?;
std::fs::write(data.path().join("system/__chusql_users.db"), b"torn heap")?;
std::fs::write(data.path().join("system/__system_users.idx"), b"torn index")?;
std::fs::write(data.path().join("system/__system_users.db"), b"torn heap")?;
let restarted = restart_at(data.path())?;
let mut connection = connect()?;
let actual: serde_json::Value = serde_json::from_str(&send(&mut connection, r#"{"method":"accounts_list"}"#))?;
@@ -555,12 +750,13 @@ fn account_failure_preserves_wal_and_blocks_writes() -> Result<(), Box<dyn std::
/// 账号文件已存在时拒绝建账号
#[test]
fn account_create_rejects_reserved_file_collision() -> std::io::Result<()> {
let (_server, data) = start_server();
std::fs::write(data.path().join("system/__chusql_users.db"), b"existing")?;
let data = tempfile::tempdir()?;
open_storage(&write_config(data.path()));
std::fs::write(data.path().join("system/__system_users.db"), b"existing")?;
let mut c = connect()?;
let result = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#);
assert!(result.contains("collision"), "{result}");
assert_eq!(std::fs::read(data.path().join("system/__chusql_users.db"))?, b"existing");
assert_eq!(std::fs::read(data.path().join("system/__system_users.db"))?, b"existing");
Ok(())
}
@@ -578,21 +774,98 @@ fn oversized_account_hash_is_rejected_before_wal() -> Result<(), Box<dyn std::er
Ok(())
}
/// 空哈希表示免密,允许建立
#[test]
fn account_create_accepts_empty_hash() -> std::io::Result<()> {
let (_server, _data) = start_server();
let mut c = connect()?;
let created: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"account_create","user":"root","password_hash":""}"#))?;
assert_eq!(created["accounts"][0]["password_hash"], serde_json::json!(""));
let listed = send(&mut c, r#"{"method":"accounts_list"}"#);
assert!(listed.contains("root"), "{listed}");
Ok(())
}
/// 字典里已有同名普通表时拒绝建账号
#[test]
fn account_create_rejects_existing_ordinary_catalog_entry() -> std::io::Result<()> {
let data = tempfile::tempdir()?;
let mut catalog = chusql_core_storage::catalog::Catalog::default();
catalog.create_table("__chusql_users", Vec::new())?;
catalog.create_table("__system_users", Vec::new())?;
std::fs::create_dir(data.path().join("system"))?;
catalog.save(data.path().join("system/catalog.json"))?;
let _server = restart_at(data.path())?;
open_storage(&write_config(data.path()));
let mut c = connect()?;
let result = send(&mut c, r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#);
assert!(result.contains("collision"), "{result}");
Ok(())
}
/// 没引导过就不能动账号
#[test]
fn account_requests_require_bootstrap() -> std::io::Result<()> {
let data = tempfile::tempdir()?;
open_storage(&write_config(data.path()));
let mut c = connect()?;
let status = send(&mut c, r#"{"method":"system_status"}"#);
assert!(status.contains(r#""initialized":false"#), "{status}");
for request in [r#"{"method":"accounts_list"}"#,
r#"{"method":"account_create","user":"alice","password_hash":"hash-one"}"#] {
let result = send(&mut c, request);
assert!(result.contains("csql-bootstrap"), "{request}: {result}");
}
Ok(())
}
/// 引导幂等:再跑一次不改已有管理员的口令
#[test]
fn bootstrap_is_idempotent_and_keeps_the_password() -> std::io::Result<()> {
let data = tempfile::tempdir()?;
open_storage(&write_config(data.path()));
let mut c = connect()?;
let created = send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-one"}"#);
assert!(created.contains(r#""initialized":true"#), "{created}");
let again = send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-two"}"#);
assert!(again.contains(r#""initialized":true"#), "{again}");
let listed = send(&mut c, r#"{"method":"accounts_list"}"#);
assert!(listed.contains("hash-one"), "{listed}");
assert!(!listed.contains("hash-two"), "{listed}");
assert_eq!(std::fs::metadata(data.path().join("system/wal.log"))?.len(), 0);
Ok(())
}
/// 引导程序不给已经播过种的表塞新账号
#[test]
fn bootstrap_does_not_add_an_account_to_a_seeded_table() -> std::io::Result<()> {
let data = tempfile::tempdir()?;
open_storage(&write_config(data.path()));
let mut c = connect()?;
send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-one"}"#);
let sneaky = send(&mut c, r#"{"method":"bootstrap_system","user":"eve","password_hash":"raw-hash"}"#);
assert!(sneaky.contains(r#""initialized":true"#), "{sneaky}");
let listed = send(&mut c, r#"{"method":"accounts_list"}"#);
assert!(!listed.contains("eve"), "{listed}");
assert!(listed.contains("hash-one"), "{listed}");
Ok(())
}
/// 空表还能被重新播种:先只建表,再补管理员
#[test]
fn bootstrap_seeds_an_empty_account_table() -> std::io::Result<()> {
let data = tempfile::tempdir()?;
open_storage(&write_config(data.path()));
let mut c = connect()?;
let bare = send(&mut c, r#"{"method":"bootstrap_system"}"#);
assert!(bare.contains(r#""initialized":true"#), "{bare}");
let empty = send(&mut c, r#"{"method":"accounts_list"}"#);
assert!(empty.contains(r#""accounts":[]"#), "{empty}");
let seeded = send(&mut c, r#"{"method":"bootstrap_system","user":"root","password_hash":"hash-again"}"#);
assert!(seeded.contains(r#""initialized":true"#), "{seeded}");
let listed = send(&mut c, r#"{"method":"accounts_list"}"#);
assert!(listed.contains("hash-again"), "{listed}");
Ok(())
}
/// 列出已建的表
#[test]
fn list_tables_returns_created_tables() {
@@ -663,6 +936,38 @@ fn duplicate_id_is_rejected() {
assert!(r.contains("duplicate value on the id index"), "got: {}", r);
}
/// 整值浮点与整数是同一个索引键
#[test]
fn integral_float_uses_the_same_index_key() -> Result<(), Box<dyn std::error::Error>> {
let (_srv, _data) = start_server();
let mut c = connect()?;
request_ok(&mut c, serde_json::json!({"method":"create_table","table":"float_id","columns":[{"name":"id","ty":"int"},{"name":"name","ty":"str"}]}))?;
request_ok(&mut c, serde_json::json!({"method":"insert","table":"float_id","row":{"id":7,"name":"A"}}))?;
let found: serde_json::Value = serde_json::from_str(&send(
&mut c,
r#"{"method":"lookup_by_index","table":"float_id","key":7.0}"#,
))?;
assert_eq!(
found["rows"],
serde_json::json!([{"id":7,"name":"A"}]),
"lookup by 7.0: {}",
found
);
let dup: serde_json::Value = serde_json::from_str(&send(
&mut c,
r#"{"method":"insert","table":"float_id","row":{"id":7.0,"name":"B"}}"#,
))?;
assert_eq!(dup["status"], "error", "7.0 must clash with 7: {}", dup);
assert!(
dup["message"].as_str().unwrap_or("").contains("duplicate value on the id index"),
"got: {}",
dup
);
Ok(())
}
/// 批量插入一次全进
#[test]
fn insert_batch_writes_all_rows() {
@@ -878,6 +1183,7 @@ fn config_file_is_used() {
std::fs::write(&config_path, text).unwrap();
open_storage(&config_path);
bootstrap_system();
create_fixture_database();
let mut c = connect().unwrap();
@@ -1016,7 +1322,7 @@ fn account_table_uses_typed_columns_and_stamps_login() -> Result<(), Box<dyn std
assert!(account["last_login_at"].is_null(), "还没登录过: {}", account);
let catalog: serde_json::Value = serde_json::from_str(&std::fs::read_to_string(data.path().join("system/catalog.json"))?)?;
let entry = &catalog["tables"]["__chusql_users"];
let entry = &catalog["tables"]["__system_users"];
let columns = entry["columns"].as_array().ok_or("missing columns")?;
let names: Vec<&str> = columns.iter().map(|col| col["name"].as_str().unwrap_or("")).collect();
assert_eq!(names, vec!["id", "user", "password_hash", "registered_at", "last_login_at", "revision"]);
@@ -12,11 +12,11 @@ import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
import Data.Text (Text)
import qualified Data.Text as T
-- 账号表(系统表 __chusql_users)的结构定义,SQL 会话与 Web 管理端共用。
-- 账号表(系统表 __system_users)的结构定义,SQL 会话与 Web 管理端共用。
-- | 账号表的名字:网页里像普通表一样浏览与编辑,但写入走账号命令
accountTableName :: String
accountTableName = "__chusql_users"
accountTableName = "__system_users"
-- | 这张表是不是账号表
isAccountTable :: Text -> Bool
@@ -4,21 +4,17 @@ module ChuSQL.Interface.Config (
WebConfig (..),
defaultWebConfig,
defaultUser,
defaultPassword,
usingDefaultCredentials,
loadWebConfigAt,
resolveCredential,
legacyPasswordKey,
resolveStaticDir,
staticDirCandidates,
rootUserName,
canonicalSettingKeys,
resolvePlainPassword,
ServerConfig (..),
defaultServerConfig,
loadServerConfigAt,
) where
import ChuSQL.Interface.Auth (Credential (..), hashPassword)
import ChuSQL.Interface.TOML (readSection)
import Data.Char (toLower)
import qualified Data.Map.Strict as Map
@@ -34,10 +30,6 @@ import Text.Read (readMaybe)
defaultUser :: Text
defaultUser = "root"
-- | 默认口令(只为方便本地测试;生产/对外必须覆盖)
defaultPassword :: Text
defaultPassword = "chusql"
-- | Web 管理端配置
data WebConfig = WebConfig
{ wcHost :: String
@@ -106,26 +98,16 @@ keyAliases =
, ("password_classes", "password-classes")
]
-- | 这份配置用的还是内置默认口令吗
usingDefaultCredentials :: Map.Map Text Text -> Bool
usingDefaultCredentials saved = Map.notMember "password" saved
-- | 配置文件的 [web] 分节里是否还留着明文口令键
legacyPasswordKey :: FilePath -> IO Bool
legacyPasswordKey path = Map.member "password" <$> readSection path "web"
-- | 设置文件里某个键的非空值
nonEmptyValue :: Text -> Map.Map Text Text -> Maybe Text
-- | 查一个键
nonEmptyValue key saved = case T.strip <$> Map.lookup key saved of
Just value | not (T.null value) -> Just value
_ -> Nothing
-- | root 凭据:明文就哈希,留空免密,缺省用演示口令
resolveCredential :: WebConfig -> Map.Map Text Text -> IO Credential
resolveCredential cfg saved = do
encoded <- case Map.lookup "password" saved of
Just plain | not (T.null (T.strip plain)) -> hashPassword (T.strip plain)
Just _ -> pure ""
Nothing -> hashPassword defaultPassword
pure (Credential (rootUserName cfg saved) encoded)
-- | 管理员名字:命令行 > 设置文件 > 内置默认
rootUserName :: WebConfig -> Map.Map Text Text -> Text
rootUserName cfg saved
@@ -144,12 +126,6 @@ withStorage :: Map.Map Text Text -> WebConfig -> WebConfig
withStorage storage cfg =
cfg{wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage}
-- | 管理员明文口令,没配回落到演示口令,显式留空回空串
resolvePlainPassword :: Map.Map Text Text -> Text
resolvePlainPassword saved = case Map.lookup "password" saved of
Just plain -> T.strip plain
Nothing -> defaultPassword
-- | [web] 分区里的启动参数,缺失或坏值一律回到内置默认
webConfigFromSection :: Map.Map Text Text -> WebConfig
webConfigFromSection saved =
@@ -55,7 +55,6 @@ settingCatalogue =
, item "max-rows" "Rows per query" "limits" "int" "1000" False False
, item "max-sql-length" "Max SQL characters" "limits" "int" "20000" False False
, item "user" "管理员账号(设置文件)" "auth" "text" "root" True True
, item "password" "管理员口令(设置文件,明文)" "auth" "secret" "" True True
, item "password-min-length" "口令最短长度" "auth" "int" "12" True False
, item "password-classes" "口令字符类别数" "auth" "int" "2" True False
, owned "data-dir" "Data directory" "storage" "text" "" "storage" "data_dir"
@@ -117,7 +116,7 @@ isRootOnly key = maybe False siRootOnly (findItem key)
-- | 网页端不能改的键
lockedKeys :: [Text]
lockedKeys = ["user", "password"]
lockedKeys = ["user"]
-- | 这项在界面上是不是只读
isLockedSetting :: Text -> Bool
+51 -25
View File
@@ -4,18 +4,17 @@ module Main (main) where
import ChuSQL.Core.Engine.Storage.FFI (storageVersion)
import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, setStorageLink)
import ChuSQL.Interface.Auth (Credential (..))
import ChuSQL.Interface.Config (
WebConfig (..),
defaultPassword,
defaultUser,
legacyPasswordKey,
loadWebConfigAt,
resolveCredential,
usingDefaultCredentials,
rootUserName,
)
import ChuSQL.Interface.RateLimit (newRateLimiter)
import ChuSQL.Interface.Settings (readSettingsFile)
import ChuSQL.Interface.TOML (resolveConfigPath)
import ChuSQL.Server.Accounts (administratorPasswordless)
import ChuSQL.Server.Backend (Backend (..), ipcBackend)
import ChuSQL.Server.TCP (
ServerConfig (..),
@@ -25,10 +24,12 @@ import ChuSQL.Server.TCP (
runServer,
)
import Control.Exception (IOException, bracket, try)
import qualified Data.Map.Strict as Map
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (getCurrentTime)
import GHC.Conc (getNumProcessors, setNumCapabilities)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
@@ -88,7 +89,7 @@ usage = do
putStrLn " Windows: %APPDATA%\\ChuSQL\\chusql.toml"
putStrLn " other: $XDG_CONFIG_HOME/ChuSQL/chusql.toml (or ~/.config/ChuSQL/chusql.toml)"
putStrLn " [storage] data_dir; [server] host/port/max_message/max_rows;"
putStrLn " [web] user/password (administrator credentials)"
putStrLn " [web] user (administrator name; the password lives in the system table)"
putStrLn ""
putStrLn " --config FILE read that config file instead"
putStrLn " --host H listen address ([server] host, default 127.0.0.1)"
@@ -103,9 +104,11 @@ usage = do
putStrLn ""
putStrLn "storage: this process loads the chusql_core_storage library in-process and owns the data directory"
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 "administrator password: lives in the __system_users system table, never in chusql.toml"
putStrLn (" the [web] user key only picks the administrator name (default " ++ T.unpack defaultUser ++ ")")
putStrLn ""
putStrLn "first run: the installer calls csql-bootstrap, which creates the system catalog"
putStrLn " {\"method\":\"system_status\"} tells whether that happened; without it the server stops"
-- | 命令行覆盖管理员
applyWebOptions :: WebConfig -> Options -> WebConfig
@@ -129,9 +132,11 @@ orElse :: Maybe a -> a -> a
orElse (Just x) _ = x
orElse Nothing y = y
-- | 入口
-- | 入口:开够能力数,分片扫描才真并行
main :: IO ()
main = do
caps <- getNumProcessors
setNumCapabilities (max 1 (min 8 caps))
hSetBuffering stdout LineBuffering
args <- getArgs
case parseArgs args of
@@ -150,7 +155,8 @@ run opts = do
base <- loadWebConfigAt configPath
let cfg = applyWebOptions base opts
saved <- readSettingsFile configPath
cred <- resolveCredential cfg saved
legacy <- legacyPasswordKey configPath
let rootName = rootUserName cfg saved
config <- applyServerOptions <$> loadServerConfigAt configPath <*> pure opts
opened <- localStorageLink (Just configPath)
case opened of
@@ -162,13 +168,14 @@ run opts = do
backend <- ipcBackend
printBanner cfg config configPath
checkStorage backend
reportCredential cred saved
checkInitialized backend
reportCredential backend rootName legacy
limiter <-
newRateLimiter
getCurrentTime
(wcLoginMaxAttempts cfg)
(fromIntegral (wcLoginWindow cfg))
env <- newServerEnv backend cred configPath config limiter
env <- newServerEnv backend rootName configPath config limiter
let announce port = putStrLn ("listening: tcp://" ++ scHost config ++ ":" ++ show port)
bracket (pure link) (const closeConnection) (const (serve env announce))
@@ -183,18 +190,37 @@ serve env announce = do
putStrLn " the port is probably taken or reserved by the system; try another one: --port 7777"
exitFailure
-- | 报告口令来源,用内置默认口令时告警
reportCredential :: Credential -> Map.Map Text Text -> IO ()
reportCredential cred saved
| usingDefaultCredentials saved = do
putStrLn ""
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 ""
| 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)")
-- | 系统目录没引导过就不许起服务
checkInitialized :: Backend -> IO ()
checkInitialized backend = do
status <- beStorage backend (A.object ["method" A..= ("system_status" :: Text)])
case status of
Right value
| statusInitialized value -> putStrLn "system: ready (the catalog is initialized)"
_ -> do
putStrLn "!! the system catalog is not initialized; run the bootstrap program first:"
putStrLn "!! csql-bootstrap --config <chusql.toml> --password-stdin"
exitFailure
where
-- | 应答里的 initialized 是不是 true
statusInitialized (A.Object fields) = KM.lookup "initialized" fields == Just (A.Bool True)
statusInitialized _ = False
-- | 报告管理员账号状态:配置里还留着明文口令、或还没设口令都提醒
reportCredential :: Backend -> Text -> Bool -> IO ()
reportCredential backend rootName legacy = do
putStrLn ("administrator: " ++ T.unpack rootName)
if legacy
then do
putStrLn " !! the [web] section still carries a plaintext password key; it is ignored now"
putStrLn " !! remove it: the administrator password lives in the __system_users system table"
else pure ()
passwordless <- administratorPasswordless backend rootName
if passwordless
then do
putStrLn " !! the administrator has no password yet: sign in with an empty password, then set one"
putStrLn " !! ALTER USER root IDENTIFIED BY '...' (or use the account page in the Web UI)"
else pure ()
-- | 探测存储是否可用,答不上 ping 就退出
checkStorage :: Backend -> IO ()
+2
View File
@@ -13,6 +13,7 @@ library
hs-source-dirs: src
exposed-modules: ChuSQL.Server.Accounts
ChuSQL.Server.Backend
ChuSQL.Server.Catalog
ChuSQL.Server.Policy
ChuSQL.Server.Privileges
ChuSQL.Server.Session
@@ -40,6 +41,7 @@ executable chusql-server
main-is: Main.hs
hs-source-dirs: app
build-depends: base
, aeson
, chusql-core-engine
, chusql-core-model
, chusql-interface
+98 -70
View File
@@ -3,11 +3,12 @@
module ChuSQL.Server.Accounts (
Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
rootUserName, principalName, principalIsRoot,
ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot,
authenticate, currentPrincipal,
listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
) where
import ChuSQL.Core.Engine.Error (accountErrorCode)
import ChuSQL.Core.Engine.Storage.IPC (Account (..), Request (..))
import ChuSQL.Core.Engine.Syntax.AST (Statement (..))
import ChuSQL.Interface.Auth
@@ -19,11 +20,11 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Text (Text)
import qualified Data.Text as T
-- 账号服务:root 来自配置,普通账号由 root 用 CREATE/ALTER/DROP USER 管理,口令在此校验并派生哈希。
-- 账号服务:管理员是系统表里名字固定的那一行,口令哈希存在表里,普通账号由管理员用 CREATE/ALTER/DROP USER 管理。
data AccountError = AccountError Text Text deriving (Show, Eq)
-- | 当前身份:配置里的管理员,或系统表里的一个普通账号
-- | 当前身份:名字固定的管理员,或系统表里的一个普通账号
data Principal
= Root Text
| Ordinary Account
@@ -39,7 +40,7 @@ principalName :: Principal -> Text
principalName (Root name) = name
principalName (Ordinary a) = accountUser a
-- | 是不是配置里的管理员
-- | 是不是名字固定的管理员
principalIsRoot :: Principal -> Bool
principalIsRoot (Root _) = True
principalIsRoot (Ordinary _) = False
@@ -49,23 +50,23 @@ data Accounts = Accounts
, acSessions :: SessionStore
, acLock :: MVar ()
, acPolicy :: IORef PasswordPolicy
, acRoot :: Credential
, acRootName :: Text
}
-- | 建账号服务,记录配置根账号
newAccounts :: Backend -> SessionStore -> Credential -> IO Accounts
newAccounts backend sessions credential = do
-- | 建账号服务,记下管理员名字
newAccounts :: Backend -> SessionStore -> Text -> IO Accounts
newAccounts backend sessions name = do
lock <- newMVar ()
policy <- newIORef defaultPasswordPolicy
pure (Accounts backend sessions lock policy credential)
pure (Accounts backend sessions lock policy (normalize name))
-- | 账号名统一小写去空白
normalize :: Text -> Text
normalize = T.toLower . T.strip
-- | 配置里的管理员叫什么
-- | 管理员叫什么
rootName :: Accounts -> Text
rootName = normalize . credUser . acRoot
rootName = acRootName
-- | 管理员名字(界面显示用)
rootUserName :: Accounts -> Text
@@ -123,16 +124,42 @@ storageFailure = AccountError "storage_error" "account storage unavailable"
unauthorized :: AccountError
unauthorized = AccountError "unauthorized" "invalid account or session"
-- | 存储侧报错翻成账号错误
-- | 存储侧报错翻成账号错误,码统一由引擎错误表给出
storageResult :: Either String [Account] -> Either AccountError ()
storageResult (Right _) = Right ()
storageResult (Left "account already exists") = Left (AccountError "conflict" "account already exists")
storageResult (Left "unknown account") = Left (AccountError "not_found" "unknown account")
storageResult (Left _) = Left storageFailure
storageResult (Left message) = Left (AccountError code text)
where
-- | 认得的码原样用,其余存储细节不外泄
code = T.pack (accountErrorCode message)
text = if code == failureCode then failureText else T.pack message
AccountError failureCode failureText = storageFailure
-- | 读系统表里的普通账号
readAccounts :: Accounts -> IO (Either AccountError [Account])
readAccounts service = fmap (either (const (Left storageFailure)) Right) (beAccounts (acBackend service) ReqAccountsList)
-- | 读系统表里的账号
readAccounts :: Backend -> IO (Either AccountError [Account])
readAccounts backend = fmap (either (const (Left storageFailure)) Right) (beAccounts backend ReqAccountsList)
-- | 表里没有管理员那一行就补一行空哈希,表示还没设口令
ensureRootAccount :: Backend -> Text -> IO (Either AccountError ())
ensureRootAccount backend name = do
stored <- readAccounts backend
case stored of
Left err -> pure (Left err)
Right accounts
| any ((== normalize name) . accountUser) accounts -> pure (Right ())
| otherwise -> do
created <- beAccounts backend (ReqAccountCreate (normalize name) "")
pure $ case created of
Right _ -> Right ()
Left "account already exists" -> Right ()
Left _ -> Left storageFailure
-- | 管理员是不是还没设口令
administratorPasswordless :: Backend -> Text -> IO Bool
administratorPasswordless backend name = do
stored <- readAccounts backend
pure $ case stored of
Right accounts -> any (\a -> accountUser a == normalize name && T.null (accountHash a)) accounts
Left _ -> False
-- | 按令牌解析当前身份,版本对不上即失效
currentUnlocked :: Accounts -> Text -> IO (Either AccountError Principal)
@@ -140,66 +167,63 @@ currentUnlocked service token = do
session <- lookupVersionedSession (acSessions service) token
case session of
Nothing -> pure (Left unauthorized)
Just (user, revision)
| user == rootName service && revision == Nothing -> pure (Right (Root (rootName service)))
| otherwise -> do
stored <- readAccounts service
pure $ do
accounts <- stored
account <- case filter ((== user) . accountUser) accounts of
[a] -> Right a
_ -> Left unauthorized
if revision == Just (accountRevision account)
then Right (Ordinary account)
else Left unauthorized
Just (user, revision) -> do
stored <- readAccounts (acBackend service)
pure $ do
accounts <- stored
account <- case filter ((== user) . accountUser) accounts of
[a] -> Right a
_ -> Left unauthorized
if revision == Just (accountRevision account)
then Right (if user == rootName service then Root user else Ordinary account)
else Left unauthorized
-- | 加锁解析当前身份
currentPrincipal :: Accounts -> Text -> IO (Either AccountError Principal)
currentPrincipal service token = withMVar (acLock service) $ \_ -> currentUnlocked service token
-- | 登录:先比 root,再查普通账号;空口令即免密
-- | 登录:比哈希,管理员未设口令时只收空口令
authenticate :: Accounts -> Text -> Text -> IO (Either AccountError Text)
authenticate service user password = withMVar (acLock service) $ \_ ->
if normalize user == rootName service
then signInRoot
else
if passwordless
then pure (Left (AccountError "forbidden" "this server only accepts the administrator"))
else signInOrdinary
authenticate service user password = withMVar (acLock service) $ \_ -> do
stored <- readAccounts (acBackend service)
case stored of
Left err -> pure (Left err)
Right accounts
| name == rootName service -> signInRoot accounts
| unset accounts -> pure (Left ordinaryRefused)
| otherwise -> signInOrdinary accounts
where
-- | 配置里没有口令
passwordless = T.null (credEncoded (acRoot service))
name = normalize user
ordinaryRefused = AccountError "forbidden" "this server only accepts the administrator"
-- | 管理员那一行还没设口令(或压根不在表里)
unset accounts = case filter ((== rootName service) . accountUser) accounts of
[a] -> T.null (accountHash a)
_ -> True
-- | 管理员登录
signInRoot
| passwordless =
if T.null password
then Right <$> createVersionedSession (acSessions service) (rootName service) Nothing
else pure (Left unauthorized)
| verifyPassword (credEncoded (acRoot service)) password =
Right <$> createVersionedSession (acSessions service) (rootName service) Nothing
| otherwise = pure (Left unauthorized)
signInRoot accounts = case filter ((== rootName service) . accountUser) accounts of
[a] | T.null (accountHash a) && T.null password -> issue a
[a] | not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
_ -> pure (Left unauthorized)
-- | 普通账号登录
signInOrdinary = do
stored <- readAccounts service
case stored of
Left err -> pure (Left err)
Right accounts -> case filter ((== normalize user) . accountUser) accounts of
[a] | verifyPassword (accountHash a) password -> do
stamp <- currentStamp
written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp))
case written of
Left _ -> pure (Left storageFailure)
Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a))
_ -> pure (Left unauthorized)
signInOrdinary accounts = case filter ((== name) . accountUser) accounts of
[a] | not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
_ -> pure (Left unauthorized)
-- | 记一次登录再发会话
issue a = do
stamp <- currentStamp
written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp))
case written of
Left _ -> pure (Left storageFailure)
Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a))
-- | 系统表里的普通账号清单(root 专用)
-- | 系统表里的账号清单(含管理员)
listAccounts :: Accounts -> IO (Either AccountError [Account])
listAccounts service = withMVar (acLock service) $ \_ -> readAccounts service
listAccounts service = withMVar (acLock service) $ \_ -> readAccounts (acBackend service)
-- | 按用户名找一个普通账号
-- | 按用户名找一个账号
findAccount :: Accounts -> Text -> IO (Either AccountError Account)
findAccount service name = withMVar (acLock service) $ \_ -> do
stored <- readAccounts service
stored <- readAccounts (acBackend service)
pure $ do
accounts <- stored
case filter ((== normalize name) . accountUser) accounts of
@@ -217,22 +241,26 @@ createUser service name password = withMVar (acLock service) $ \_ -> do
encoded <- hashPassword password
storageResult <$> beAccounts (acBackend service) (ReqAccountCreate (normalize name) encoded)
-- | 管理员重置普通账号口令
-- | 设账号口令;管理员不受口令策略约束,空口令即免密
resetPassword :: Accounts -> Text -> Text -> IO (Either AccountError ())
resetPassword service name password = withMVar (acLock service) $ \_ -> do
policy <- accountsPolicy service
case validateNewName service name >> passwordAllowed policy password of
let admin = normalize name == rootName service
checked = if admin then validateUserName name else validateNewName service name >> passwordAllowed policy password
case checked of
Left err -> pure (Left err)
Right () -> do
encoded <- hashPassword password
encoded <- if admin && T.null password then pure "" else hashPassword password
storageResult <$> beAccounts (acBackend service) (ReqAccountReset (normalize name) encoded)
-- | 删一个普通账号
dropUser :: Accounts -> Text -> IO (Either AccountError ())
dropUser service name = withMVar (acLock service) $ \_ ->
case validateUserName name of
Left err -> pure (Left err)
Right () -> storageResult <$> beAccounts (acBackend service) (ReqAccountDrop (normalize name))
if normalize name == rootName service
then pure (Left (AccountError "bad_request" "the administrator cannot be dropped"))
else case validateUserName name of
Left err -> pure (Left err)
Right () -> storageResult <$> beAccounts (acBackend service) (ReqAccountDrop (normalize name))
-- | 账号管理命令:SQL 语句与一键接口在这上面汇合
data AccountCommand
+3 -3
View File
@@ -158,7 +158,7 @@ memoryBackendWith trusted name ref =
modifyMVar ref $ \db -> case memoryAccounts db stamp req of
Left err -> pure (db, Left err)
Right accounts -> pure ((usersTable, Table usersTable [("account", TStr)]
[[("account", VStr (BL.unpack (A.encode a))) ] | a <- accounts]) : filter ((/= usersTable) . fst) db, Right accounts)
[[("account", VStr (BL.unpack (A.encode a))) ] | a <- accounts] Nothing) : filter ((/= usersTable) . fst) db, Right accounts)
, beWithDatabase = withDatabase
, beDatabases = pure (Right (nub [name, systemDatabaseName]))
, beStorage = \_ -> pure (Left "storage is not available in this backend")
@@ -367,7 +367,7 @@ systemDatabaseName :: String
systemDatabaseName = "system"
usersTable :: String
usersTable = "__chusql_users"
usersTable = "__system_users"
-- | 角色与授权表的名字,不带内部前缀
rolesTable :: String
@@ -384,7 +384,7 @@ internalNames = [rolesTable, grantsTable, membersTable]
-- | 名字是否带内部表前缀
reserved :: String -> Bool
reserved = T.isPrefixOf "__chusql_" . T.toLower . T.pack
reserved = T.isPrefixOf "__system_" . T.toLower . T.pack
-- | 是不是服务自己的内部表
internalTable :: String -> Bool
+189
View File
@@ -0,0 +1,189 @@
module ChuSQL.Server.Catalog
( Catalog
, newCatalog
, normalizeRole
, normalizeUser
, normalizeObject
, withCatalog
, withCatalogLock
, ensureCatalog
, eachAction
, readRoleNames
, insertRole
, dropRole
, readGrants
, addGrant
, removeGrant
, readMembers
, addMember
, removeMember
) where
import ChuSQL.Core.Model (Row, Value (..))
import ChuSQL.Interface.Actions (sqlLiteral)
import ChuSQL.Interface.Protocol (Grant (..))
import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, rolesTable)
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import Data.List (intercalate, isInfixOf)
import Data.Text (Text)
import qualified Data.Text as T
-- 内部目录(系统表)的唯一访问入口,调用方不拼 SQL
-- | 三张系统表的读写都在这里,外面只认下面这些操作
data Catalog = Catalog
{ catBackend :: Backend
, catLock :: MVar ()
}
-- | 建一个目录句柄
newCatalog :: Backend -> IO Catalog
newCatalog backend = Catalog backend <$> newMVar ()
-- | 角色名统一小写去空白
normalizeRole :: Text -> Text
normalizeRole = T.toLower . T.strip
-- | 用户名统一小写去空白
normalizeUser :: Text -> Text
normalizeUser = T.toLower . T.strip
-- | 授权对象落库口径:`*` 原样,裸表名按当前库补全
normalizeObject :: Text -> Text -> Text
normalizeObject database object
| T.strip object == T.pack "*" = T.pack "*"
| T.any (== '.') object = T.toLower (T.strip object)
| otherwise = normalizeUser database <> T.pack "." <> normalizeUser object
-- | 加锁跑一段目录动作
withCatalogLock :: Catalog -> IO a -> IO a
withCatalogLock catalog action = withMVar (catLock catalog) (const action)
-- | 建表后跑一段目录动作
withCatalog :: Catalog -> IO (Either String a) -> IO (Either String a)
withCatalog catalog action = withCatalogLock catalog $ do
ready <- ensureCatalog catalog
case ready of
Left err -> pure (Left err)
Right () -> action
-- | 确保三张系统表存在,已存在算成功
ensureCatalog :: Catalog -> IO (Either String ())
ensureCatalog catalog = eachAction tableDefs (createTable catalog)
where
-- | 三张系统表的定义
tableDefs =
[ (rolesTable, "(name VARCHAR(64))")
, (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
, (membersTable, "(role VARCHAR(64), member VARCHAR(64))")
]
-- | 建一张系统表,已存在算成功
createTable :: Catalog -> (String, String) -> IO (Either String ())
createTable catalog (table, columns) = do
result <- beStatement (catBackend catalog) ("CREATE TABLE " ++ table ++ " " ++ columns)
pure $ case result of
Right _ -> Right ()
Left err
| "exists" `isInfixOf` err -> Right ()
| otherwise -> Left err
-- | 跑一条系统表写语句
exec :: Catalog -> String -> IO (Either String ())
exec catalog sql = fmap (either Left (const (Right ()))) (beStatement (catBackend catalog) sql)
-- | 读一张系统表
readRows :: Catalog -> String -> IO (Either String [Row])
readRows catalog table = fmap (fmap srRows) (beStatement (catBackend catalog) ("SELECT * FROM " ++ table))
-- | 角色名清单
readRoleNames :: Catalog -> IO (Either String [Text])
readRoleNames catalog = fmap (fmap (map (normalizeRole . cell "name"))) (readRows catalog rolesTable)
-- | 新建一个角色
insertRole :: Catalog -> Text -> IO (Either String ())
insertRole catalog role = exec catalog (insertSql rolesTable ["name"] [normalizeRole role])
-- | 删掉一个角色,连同它的授权与成员
dropRole :: Catalog -> Text -> IO (Either String ())
dropRole catalog role = do
first <- exec catalog ("DELETE FROM " ++ rolesTable ++ " WHERE name = " ++ roleLiteral role)
second <- exec catalog ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role)
third <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role)
pure (sequence_ [first, second, third])
-- | 全部授权
readGrants :: Catalog -> IO (Either String [Grant])
readGrants catalog = fmap (fmap (map grantOf)) (readRows catalog grantsTable)
-- | 记一条授权,同名的先清掉
addGrant :: Catalog -> Text -> Text -> Text -> IO (Either String ())
addGrant catalog role privilege object = do
cleared <- removeGrant catalog role privilege object
case cleared of
Left err -> pure (Left err)
Right () -> exec catalog (insertSql grantsTable ["role", "privilege", "object"] [normalizeRole role, privilege, object])
-- | 取消一条授权
removeGrant :: Catalog -> Text -> Text -> Text -> IO (Either String ())
removeGrant catalog role privilege object = exec catalog (deleteGrantSql role privilege object)
-- | 全部成员关系
readMembers :: Catalog -> IO (Either String [(Text, Text)])
readMembers catalog = fmap (fmap (map memberOf)) (readRows catalog membersTable)
-- | 记一条成员关系
addMember :: Catalog -> Text -> Text -> IO (Either String ())
addMember catalog role user = exec catalog (insertSql membersTable ["role", "member"] [normalizeRole role, normalizeUser user])
-- | 取消一条成员关系
removeMember :: Catalog -> Text -> Text -> IO (Either String ())
removeMember catalog role user =
exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role ++ " AND member = " ++ literal (normalizeUser user))
-- | 一串动作挨着跑,遇到第一个错误就停
eachAction :: [a] -> (a -> IO (Either e ())) -> IO (Either e ())
eachAction [] _ = pure (Right ())
eachAction (item : rest) action = do
result <- action item
case result of
Left err -> pure (Left err)
Right () -> eachAction rest action
-- | 行里取一列文本
cell :: String -> Row -> Text
cell column row = case lookup column row of
Just (VStr value) -> T.pack value
_ -> T.empty
-- | 一行授权记录
grantOf :: Row -> Grant
grantOf row =
Grant
{ grantRole = normalizeRole (cell "role" row)
, grantPrivilege = T.toLower (T.strip (cell "privilege" row))
, grantObject = T.toLower (T.strip (cell "object" row))
}
-- | 一行成员关系
memberOf :: Row -> (Text, Text)
memberOf row = (normalizeRole (cell "role" row), normalizeUser (cell "member" row))
-- | 拼一条删授权的语句
deleteGrantSql :: Text -> Text -> Text -> String
deleteGrantSql role privilege object =
"DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role
++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object
-- | 拼一条插入语句
insertSql :: String -> [String] -> [Text] -> String
insertSql table columns values =
"INSERT INTO " ++ table ++ " (" ++ intercalate ", " columns ++ ") VALUES (" ++ intercalate ", " (map literal values) ++ ")"
-- | 角色名的 SQL 字面量
roleLiteral :: Text -> String
roleLiteral = literal . normalizeRole
-- | 文本值的 SQL 字面量
literal :: Text -> String
literal = sqlLiteral . VStr . T.unpack
+49 -151
View File
@@ -17,23 +17,35 @@ module ChuSQL.Server.Privileges (
runPrivilegeCommand,
) where
import ChuSQL.Core.Model (Row, Value (..))
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalName)
import ChuSQL.Interface.Actions (sqlLiteral)
import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
import ChuSQL.Server.Backend (
Backend (..),
StatementResult (..),
exprTables,
grantsTable,
membersTable,
rolesTable,
systemDatabaseName,
tableRefsOf,
)
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import Data.List (intercalate, isInfixOf, nub, sort)
import ChuSQL.Server.Catalog (
Catalog,
addGrant,
addMember,
dropRole,
eachAction,
insertRole,
newCatalog,
normalizeObject,
normalizeRole,
normalizeUser,
readGrants,
readMembers,
readRoleNames,
removeGrant,
removeMember,
withCatalogLock,
ensureCatalog,
)
import Data.List (nub, sort)
import Data.Text (Text)
import qualified Data.Text as T
@@ -63,15 +75,12 @@ data PrivilegeCommand
deriving (Show, Eq)
data Privileges = Privileges
{ pvBackend :: Backend
, pvLock :: MVar ()
{ pvCatalog :: Catalog
}
-- | 建权限服务,固定在 system 库上
newPrivileges :: Backend -> IO Privileges
newPrivileges base = do
lock <- newMVar ()
pure (Privileges (beWithDatabase base systemDatabaseName) lock)
newPrivileges base = Privileges <$> newCatalog (beWithDatabase base systemDatabaseName)
-- | 语句转管理命令,不认的给 Nothing
privilegeCommand :: Statement -> Maybe PrivilegeCommand
@@ -137,13 +146,6 @@ listRoleViews service = withTables service $ do
members <- membersOfRole service role
pure (RoleView role <$> grants <*> members)
-- | 授权对象落库口径:`*` 原样,裸表名按当前库补全
normalizeObject :: Text -> Text -> Text
normalizeObject database object
| T.strip object == "*" = "*"
| T.any (== '.') object = T.toLower (T.strip object)
| otherwise = normalizeUser database <> "." <> normalizeUser object
-- | 一条语句需要哪些 (表, 权限)
requiredActions :: Statement -> Maybe [(Text, Text)]
requiredActions stmt = case stmt of
@@ -177,34 +179,29 @@ checkAll database grants needed = case [pair | pair@(table, privilege) <- needed
-- | 一个用户实际能用的授权:他所属角色身上的那些
grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
grantsOfUser service user = do
members <- readRows service membersTable
rows <- readRows service grantsTable
members <- catalog (readMembers (pvCatalog service))
grants <- catalog (readGrants (pvCatalog service))
pure $ do
memberRows <- members
grantRows <- rows
let mine = [normalizeRole (cell "role" row) | row <- memberRows, normalizeUser (cell "member" row) == normalizeUser user]
pure [grantOf row | row <- grantRows, normalizeRole (cell "role" row) `elem` mine]
grantRows <- grants
let mine = [role | (role, member) <- memberRows, member == normalizeUser user]
pure [grant | grant <- grantRows, grantRole grant `elem` mine]
-- | 一个角色挂着的授权
roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
roleGrantsOf service role = do
rows <- readRows service grantsTable
pure $ fmap (map grantOf . filter (\row -> normalizeRole (cell "role" row) == normalizeRole role)) rows
grants <- catalog (readGrants (pvCatalog service))
pure (filter (\grant -> grantRole grant == normalizeRole role) <$> grants)
-- | 角色名清单(统一小写)
roleNames :: Privileges -> IO (Either PrivilegeError [Text])
roleNames service = do
rows <- readRows service rolesTable
pure (map (normalizeRole . cell "name") <$> rows)
roleNames service = catalog (readRoleNames (pvCatalog service))
-- | 一个角色的成员清单
membersOfRole :: Privileges -> Text -> IO (Either PrivilegeError [Text])
membersOfRole service role = do
rows <- readRows service membersTable
pure $
fmap
(map (normalizeUser . cell "member") . filter (\row -> normalizeRole (cell "role" row) == normalizeRole role))
rows
members <- catalog (readMembers (pvCatalog service))
pure (map snd . filter (\(name, _) -> name == normalizeRole role) <$> members)
-- | 角色必须存在,否则命令不落地
requireRole :: Privileges -> Text -> IO (Either PrivilegeError ())
@@ -225,129 +222,55 @@ applyCommand service database command = case command of
Left err -> pure (Left err)
Right names
| normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
| otherwise -> exec service (insertSql rolesTable ["name"] [normalizeRole role])
| otherwise -> catalog (insertRole (pvCatalog service) role)
DropRoleCommand role -> do
allowed <- requireRole service role
case allowed of
Left err -> pure (Left err)
Right () -> do
first <- exec service ("DELETE FROM " ++ rolesTable ++ " WHERE name = " ++ roleLiteral role)
second <- exec service ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role)
third <- exec service ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role)
pure (sequence_ [first, second, third])
Right () -> catalog (dropRole (pvCatalog service) role)
GrantPrivilegesCommand privileges object role -> do
allowed <- requireRole service role
case allowed of
Left err -> pure (Left err)
Right () -> each (expandPrivileges privileges) $ \privilege -> do
let target = normalizeObject database object
cleared <- exec service (deleteGrantSql role privilege target)
case cleared of
Left err -> pure (Left err)
Right () ->
exec service (insertSql grantsTable ["role", "privilege", "object"] [normalizeRole role, privilege, target])
Right () ->
eachAction (expandPrivileges privileges) $ \privilege ->
catalog (addGrant (pvCatalog service) role privilege (normalizeObject database object))
RevokePrivilegesCommand privileges object role -> do
allowed <- requireRole service role
case allowed of
Left err -> pure (Left err)
Right () ->
each (expandPrivileges privileges) $ \privilege ->
exec service (deleteGrantSql role privilege (normalizeObject database object))
eachAction (expandPrivileges privileges) $ \privilege ->
catalog (removeGrant (pvCatalog service) role privilege (normalizeObject database object))
GrantRoleCommand role users -> do
allowed <- requireRole service role
case allowed of
Left err -> pure (Left err)
Right () ->
each users $ \user -> do
eachAction users $ \user -> do
known <- membersOfRole service role
case known of
Left err -> pure (Left err)
Right members
| normalizeUser user `elem` members -> pure (Right ())
| otherwise ->
exec service (insertSql membersTable ["role", "member"] [normalizeRole role, normalizeUser user])
| otherwise -> catalog (addMember (pvCatalog service) role user)
RevokeRoleCommand role users -> do
allowed <- requireRole service role
case allowed of
Left err -> pure (Left err)
Right () ->
each users $ \user ->
exec
service
( "DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role
++ " AND member = " ++ literal (normalizeUser user)
)
Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user)
-- | 建表只在第一次用时做;已经有了就算成功
-- | 全程持锁,先保证系统表存在再跑动作
withTables :: Privileges -> IO (Either PrivilegeError a) -> IO (Either PrivilegeError a)
withTables service action = withMVar (pvLock service) $ \_ -> do
ready <- ensureTables service
withTables service action = withCatalogLock (pvCatalog service) $ do
ready <- ensureCatalog (pvCatalog service)
case ready of
Left err -> pure (Left err)
Left err -> pure (Left (storageError err))
Right () -> action
-- | 确保三张内部表存在
ensureTables :: Privileges -> IO (Either PrivilegeError ())
ensureTables service = each tableDefs (createTable service)
where
-- | 三张内部表的定义
tableDefs =
[ (rolesTable, "(name VARCHAR(64))")
, (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
, (membersTable, "(role VARCHAR(64), member VARCHAR(64))")
]
-- | 建一张内部表,已存在算成功
createTable :: Privileges -> (String, String) -> IO (Either PrivilegeError ())
createTable service (table, columns) = do
result <- beStatement (pvBackend service) ("CREATE TABLE " ++ table ++ " " ++ columns)
pure $ case result of
Right _ -> Right ()
Left err
| "exists" `isInfixOf` err -> Right ()
| otherwise -> Left (storageError err)
-- | 跑一条内部写语句
exec :: Privileges -> String -> IO (Either PrivilegeError ())
exec service sql = do
result <- beStatement (pvBackend service) sql
pure $ case result of
Left err -> Left (storageError err)
Right _ -> Right ()
-- | 读一张内部表
readRows :: Privileges -> String -> IO (Either PrivilegeError [Row])
readRows service table = do
result <- beStatement (pvBackend service) ("SELECT * FROM " ++ table)
pure $ case result of
Left err -> Left (storageError err)
Right res -> Right (srRows res)
-- | 行里取一列文本
cell :: String -> Row -> Text
cell column row = case lookup column row of
Just (VStr value) -> T.pack value
_ -> ""
-- | 一行记录转成授权
grantOf :: Row -> Grant
grantOf row =
Grant
{ grantRole = normalizeRole (cell "role" row)
, grantPrivilege = T.toLower (T.strip (cell "privilege" row))
, grantObject = T.toLower (T.strip (cell "object" row))
}
-- | 拼一条删授权的 SQL
deleteGrantSql :: Text -> Text -> Text -> String
deleteGrantSql role privilege object =
"DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role
++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object
-- | 拼一条插入的 SQL
insertSql :: String -> [String] -> [Text] -> String
insertSql table columns values =
"INSERT INTO " ++ table ++ " (" ++ intercalate ", " columns ++ ") VALUES (" ++ intercalate ", " (map literal values) ++ ")"
-- | 目录操作转成权限错误
catalog :: IO (Either String a) -> IO (Either PrivilegeError a)
catalog action = fmap (either (Left . storageError) Right) action
-- | 把 ALL 展开成四种具体权限
expandPrivileges :: [Text] -> [Text]
@@ -357,31 +280,6 @@ expandPrivileges privileges = nub (concatMap expand (map (T.toLower . T.strip) p
expand "all" = ["select", "insert", "update", "delete"]
expand other = [other]
-- | 一串动作挨着跑,遇到第一个错误就停
each :: [a] -> (a -> IO (Either PrivilegeError ())) -> IO (Either PrivilegeError ())
each [] _ = pure (Right ())
each (item : rest) action = do
result <- action item
case result of
Left err -> pure (Left err)
Right () -> each rest action
-- | 角色名的 SQL 字面量
roleLiteral :: Text -> String
roleLiteral = literal . normalizeRole
-- | 文本值的 SQL 字面量
literal :: Text -> String
literal = sqlLiteral . VStr . T.unpack
-- | 角色名统一小写去空白
normalizeRole :: Text -> Text
normalizeRole = T.toLower . T.strip
-- | 用户名统一小写去空白
normalizeUser :: Text -> Text
normalizeUser = T.toLower . T.strip
forbidden :: PrivilegeError
forbidden = PrivilegeError "forbidden" "administrator required"
+7 -11
View File
@@ -27,10 +27,11 @@ module ChuSQL.Server.Session
import ChuSQL.Core.Model (Value (..))
import ChuSQL.Core.Protocol (Account, QueryResult (..), queryResultJson)
import ChuSQL.Core.Engine.Storage.IPC (TableInfo (..))
import qualified ChuSQL.Core.Engine.Error as E
import ChuSQL.Core.Engine.Syntax.AST (Statement (..))
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
import ChuSQL.Interface.AccountTable (systemTableInfo)
import ChuSQL.Interface.Auth (Credential, defaultSessionPolicy, newSessionStore)
import ChuSQL.Interface.Auth (defaultSessionPolicy, newSessionStore)
import ChuSQL.Server.Accounts
import ChuSQL.Server.Backend (Backend (..), StatementResult (..))
import ChuSQL.Server.Policy (configurePasswordPolicy)
@@ -54,12 +55,7 @@ data SessionError = SessionError
-- | 引擎报错翻成错误码
engineErrorCode :: String -> SessionError
engineErrorCode err
| "no database selected" `T.isInfixOf` message = SessionError "no_database" message
| "unknown table" `T.isInfixOf` message = SessionError "not_found" message
| otherwise = SessionError "query_error" message
where
message = T.pack err
engineErrorCode err = SessionError (T.pack (E.errorCode err)) (T.pack err)
data Session = Session
{ ssBackend :: Backend
@@ -71,10 +67,10 @@ data Session = Session
}
-- | 开一个会话:账号与角色服务、配置策略都和 Web 端一致
newSession :: Backend -> Credential -> FilePath -> IO Session
newSession backend credential settingsFile = do
newSession :: Backend -> Text -> FilePath -> IO Session
newSession backend name settingsFile = do
sessions <- newSessionStore getCurrentTime defaultSessionPolicy
accountsService <- newAccounts backend sessions credential
accountsService <- newAccounts backend sessions name
privileges <- newPrivileges backend
configurePasswordPolicy accountsService settingsFile
-- 服务启动后只有系统库:没 USE 之前不预设任何工作库
@@ -106,7 +102,7 @@ reloadPolicy session = do
sessionUser :: Session -> IO (Maybe Text)
sessionUser session = fmap principalName <$> readIORef (ssPrincipal session)
-- | 是不是配置里的 root
-- | 是不是管理员
sessionIsAdmin :: Session -> IO Bool
sessionIsAdmin session = maybe False principalIsRoot <$> readIORef (ssPrincipal session)
+7 -10
View File
@@ -11,11 +11,11 @@ module ChuSQL.Server.TCP (
runServer,
) where
import ChuSQL.Interface.Auth (Credential)
import ChuSQL.Interface.Config (ServerConfig (..), defaultServerConfig, loadServerConfigAt)
import ChuSQL.Interface.Policy (PasswordPolicy (..))
import ChuSQL.Interface.Protocol (ClientRequest (..), ServerResponse (..), decodeRequest, encodeResponse, protocolVersion)
import ChuSQL.Interface.RateLimit (RateLimiter, rateLimitBlock, rateLimitClear, rateLimitRecord)
import qualified ChuSQL.Core.Engine.Error as E
import ChuSQL.Server.Backend (Backend (..))
import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, catalog, databases, newSession, policyOf, reloadPolicy, roleViews, runStatementCoded, sessionIsAdmin, sessionUser)
import Control.Concurrent (forkIO)
@@ -57,16 +57,16 @@ import System.IO.Error (isEOFError)
data ServerEnv = ServerEnv
{ srvBackend :: Backend
, srvCredential :: Credential
, srvRootName :: Text
, srvSettingsFile :: FilePath
, srvConfig :: ServerConfig
, srvLimiter :: RateLimiter
}
-- | 组装服务器环境:每个连接再各开一个会话
newServerEnv :: Backend -> Credential -> FilePath -> ServerConfig -> RateLimiter -> IO ServerEnv
newServerEnv backend credential settingsFile config limiter =
pure (ServerEnv backend credential settingsFile config limiter)
newServerEnv :: Backend -> Text -> FilePath -> ServerConfig -> RateLimiter -> IO ServerEnv
newServerEnv backend rootName settingsFile config limiter =
pure (ServerEnv backend rootName settingsFile config limiter)
data ServerHandle = ServerHandle
{ shPort :: Int
@@ -154,7 +154,7 @@ serveConnection env conn = do
h <- socketToHandle conn ReadWriteMode
hSetBuffering h LineBuffering
hSetNewlineMode h noNewlineTranslation
session <- newSession (srvBackend env) (srvCredential env) (srvSettingsFile env)
session <- newSession (srvBackend env) (srvRootName env) (srvSettingsFile env)
outcome <- try (loop h session) :: IO (Either IOException ())
case outcome of
Left err | not (isEOFError err) -> hPutStrLn stderr ("connection error: " ++ show err)
@@ -253,10 +253,7 @@ overSession session action wrap = do
-- | 会话层的失败文案归一到协议错误码
sessionCode :: Text -> Text
sessionCode message
| message == "no database selected" = "no_database"
| message == "administrator required" = "forbidden"
| otherwise = "query_error"
sessionCode = T.pack . E.errorCode . T.unpack
-- | 登录:按账号名限流,成功清账
login :: ServerEnv -> Session -> Text -> Text -> IO ServerResponse
+140 -9
View File
@@ -3,11 +3,23 @@
module Main (main) where
import ChuSQL.Core.Engine.Storage.IPC (Account (..), Request (ReqAccountReset))
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
import ChuSQL.Core.Model (Database, Table (..), Value (..), pattern TInt, pattern TStr)
import ChuSQL.Interface.Auth (Credential (..), hashPasswordWith)
import ChuSQL.Interface.Protocol (ClientRequest (..), ServerResponse (..), decodeRequest, encodeResponse)
import ChuSQL.Interface.Auth (hashPasswordWith)
import ChuSQL.Interface.Protocol (ClientRequest (..), Grant (..), RoleView (..), ServerResponse (..), decodeRequest, encodeResponse)
import ChuSQL.Interface.RateLimit (newRateLimiter)
import ChuSQL.Server.Backend (memoryBackend)
import ChuSQL.Server.Accounts (Principal (..), ensureRootAccount)
import ChuSQL.Server.Backend (Backend (..), memoryBackend)
import ChuSQL.Server.Privileges (
PrivilegeCommand (..),
PrivilegeError (..),
Privileges,
authorize,
listRoleViews,
newPrivileges,
runPrivilegeCommand,
)
import ChuSQL.Server.Session (QueryResult (..))
import ChuSQL.Server.TCP (
ServerConfig (..),
@@ -74,6 +86,7 @@ spec :: Spec
spec = do
tcpSpec
tcpServerSpec
privilegeSpec
-- 夹具:内存后端装在 MVar 里,跟 Web 测试同一套表
@@ -91,18 +104,28 @@ testDb =
[ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (20 + i))]
| i <- [1 .. 5]
]
Nothing
)
, ( "orders"
, Table
"orders"
[("id", TInt), ("user_id", TInt)]
[[("id", VInt 1), ("user_id", VInt 1)]]
Nothing
)
]
-- | 测试账号:迭代次数压低(跑得快),口令 `s3cret`
testCredential :: Credential
testCredential = Credential "admin" (hashPasswordWith 1000 (BS.replicate 16 7) "s3cret")
-- | 测试管理员名字
testRootName :: Text
testRootName = "admin"
-- | 测试管理员口令
testRootPassword :: Text
testRootPassword = "s3cret"
-- | 口令哈希:迭代次数压低,跑得快
testPasswordHash :: Text -> Text
testPasswordHash raw = hashPasswordWith 1000 (BS.replicate 16 7) raw
-- 小工具
@@ -159,14 +182,23 @@ removeIfExists path = do
there <- doesFileExist path
if there then void (try (removeFile path) :: IO (Either IOException ())) else pure ()
-- | 起一台内存后端的测试服务器
-- | 起一台内存后端的测试服务器:管理员已设口令 `s3cret`
withTcpServer :: ServerConfig -> (ServerEnv -> ServerHandle -> IO a) -> IO a
withTcpServer config body = do
withTcpServer = withTcpServerAs (Just testRootPassword)
-- | 起内存后端测试服务器;Nothing 表示首启未设口令
withTcpServerAs :: Maybe Text -> ServerConfig -> (ServerEnv -> ServerHandle -> IO a) -> IO a
withTcpServerAs password config body = do
db <- newMVar testDb
limiter <- newRateLimiter getCurrentTime 50 300
path <- tempSettingsPath "tcp-server"
removeIfExists path
env <- newServerEnv (memoryBackend testDatabaseName db) testCredential path config{scPort = 0} limiter
let backend = memoryBackend testDatabaseName db
_ <- ensureRootAccount backend testRootName
case password of
Nothing -> pure ()
Just raw -> void (beAccounts backend (ReqAccountReset testRootName (testPasswordHash raw)))
env <- newServerEnv backend testRootName path config{scPort = 0} limiter
handle <- startServer env
body env handle `finally` shStop handle
@@ -321,6 +353,14 @@ tcpServerSpec = do
asText (at "status" reply) `shouldBe` "error"
asText (at "code" reply) `shouldBe` "unauthorized"
asText (at "message" reply) `shouldBe` "sign in first"
it "signs the administrator in with an empty password until one is set" $
withTcpServerAs Nothing defaultServerConfig $ \_ handle ->
withConnection handle $ \h -> do
wrong <- tcpLogin h "admin" "nope"
asText (at "code" wrong) `shouldBe` "unauthorized"
good <- tcpLogin h "admin" ""
asText (at "status" good) `shouldBe` "ok"
asBool (at "admin" good) `shouldBe` True
it "refuses a wrong password and then accepts the right one" $
withTcpServer defaultServerConfig $ \_ handle ->
withConnection handle $ \h -> do
@@ -414,3 +454,94 @@ tcpServerSpec = do
withConnection handle $ \other -> do
blocked <- tcpQuery other "select * from users"
asText (at "code" blocked) `shouldBe` "unauthorized"
-- 权限服务夹具:内存后端上的系统库视角
-- | 一个普通账号
testAccount :: Account
testAccount = Account 0 "alice" "" 0 "" Nothing
-- | 权限用例传的当前库名
testDatabase :: Text
testDatabase = T.pack testDatabaseName
-- | 一个空的权限服务加管理员身份
withPrivileges :: (Privileges -> Principal -> IO a) -> IO a
withPrivileges body = do
db <- newMVar testDb
service <- newPrivileges (memoryBackend testDatabaseName db)
body service (Root testRootName)
-- | 权限与目录 API 用例
privilegeSpec :: Spec
privilegeSpec = describe "server privileges" $ do
it "creates a role and lists it" $ withPrivileges $ \service root -> do
created <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
created `shouldBe` Right ()
views <- listRoleViews service
fmap (map roleName) views `shouldBe` Right ["reader"]
it "refuses a role that already exists" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
again <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
again `shouldBe` Left (PrivilegeError "conflict" "role already exists: reader")
it "grants a privilege on a table and shows it in the role view" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
granted <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
granted `shouldBe` Right ()
views <- listRoleViews service
fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users"]]
it "expands ALL and keeps a star object as is" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
_ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["all"] "*" "reader")
views <- listRoleViews service
fmap (concatMap (map grantPrivilege) . map roleGrants) views
`shouldBe` Right ["select", "insert", "update", "delete"]
fmap (concatMap (map grantObject) . map roleGrants) views `shouldBe` Right (replicate 4 "*")
it "revokes a privilege again" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
_ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
_ <- runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "reader")
views <- listRoleViews service
fmap (map roleGrants) views `shouldBe` Right [[]]
it "adds and removes members" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice", "bob"])
views <- listRoleViews service
fmap (map roleMembers) views `shouldBe` Right [["alice", "bob"]]
_ <- runPrivilegeCommand service root testDatabase (RevokeRoleCommand "reader" ["alice"])
remaining <- listRoleViews service
fmap (map roleMembers) remaining `shouldBe` Right [["bob"]]
it "drops a role together with its grants and members" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
_ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader")
dropped `shouldBe` Right ()
views <- listRoleViews service
views `shouldBe` Right []
it "refuses a command on a role that does not exist" $ withPrivileges $ \service root -> do
missing <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "ghost")
missing `shouldBe` Left (PrivilegeError "not_found" "unknown role: ghost")
it "refuses a table grant without a selected database" $ withPrivileges $ \service root -> do
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
refused <- runPrivilegeCommand service root "" (GrantPrivilegesCommand ["select"] "users" "reader")
refused `shouldBe` Left (PrivilegeError "no_database" "no database selected")
it "refuses a non-administrator" $ withPrivileges $ \service _ -> do
refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (CreateRoleCommand "reader")
refused `shouldBe` Left (PrivilegeError "forbidden" "administrator required")
it "authorizes the administrator on any statement" $ withPrivileges $ \service root ->
case parseStatement "SELECT * FROM users" of
Left err -> expectationFailure err
Right stmt -> authorize service root testDatabase stmt `shouldReturn` Right ()
+19 -27
View File
@@ -3,20 +3,17 @@
module Main (main) where
import ChuSQL.Web.API (AppEnv (..), Live (..), newAppEnvAt, setLive, webApp)
import ChuSQL.Interface.Auth (Credential (..), SessionPolicy (..), setPayloadPolicy)
import ChuSQL.Interface.Auth (SessionPolicy (..), setPayloadPolicy)
import ChuSQL.Interface.Config (
ServerConfig (..),
WebConfig (..),
defaultPassword,
defaultUser,
loadServerConfigAt,
loadWebConfigAt,
resolveCredential,
resolvePlainPassword,
legacyPasswordKey,
resolveStaticDir,
rootUserName,
staticDirCandidates,
usingDefaultCredentials,
)
import ChuSQL.Interface.Link (clientPing, closeClient, connectClient)
import ChuSQL.Interface.RateLimit (newRateLimiter)
@@ -126,7 +123,7 @@ usage = do
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;"
putStrLn " [web] host/port/static_dir/user (administrator name) and the limits;"
putStrLn " [storage] data_dir; [page] size; [btree] order; [buffer] pool_size; [log] level"
putStrLn ""
putStrLn " --config FILE read that config file instead ([web] host ...)"
@@ -146,9 +143,9 @@ usage = do
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 "administrator password: lives in the __system_users system table, never in chusql.toml"
putStrLn " the installer always sets one; an account whose hash is still empty signs in with an empty password"
putStrLn (" the [web] user key only picks the administrator name (default " ++ T.unpack defaultUser ++ ")")
putStrLn "ordinary accounts: CREATE USER / ALTER USER / DROP USER from the SQL console (administrator only)"
putStrLn "storage: the server owns the data directory and loads the chusql_core_storage library;"
putStrLn " this process is a plain TCP client: every statement, lookup and account request goes to it"
@@ -210,6 +207,7 @@ run opts = do
let settingsFile = configPath
policy = SessionPolicy (fromIntegral (wcSessionIdle cfg)) (fromIntegral (wcSessionMax cfg))
saved <- readSettingsFile settingsFile
legacy <- legacyPasswordKey settingsFile
config <- loadServerConfigAt settingsFile
limiter <-
newRateLimiter
@@ -227,7 +225,7 @@ run opts = do
setLive env (liveFromConfig cfg)
app <- webApp env
printBanner cfg configPath staticDir
reportCredential cfg saved
reportCredential cfg saved legacy
checkServer (aeServerHost env) (aeServerPort env)
seedIfWanted cfg saved (aeServerHost env) (aeServerPort env)
let settings =
@@ -261,23 +259,17 @@ serve settings app = do
putStrLn " on Windows: netsh interface ipv4 show excludedportrange protocol=tcp"
exitFailure
-- | 口令是从哪来的(用了内置默认口令就明确警告)
reportCredential :: WebConfig -> Map.Map Text Text -> IO ()
reportCredential cfg saved = do
credential <- resolveCredential cfg saved
if usingDefaultCredentials saved
-- | 报告管理员账号状态:配置里还留着明文口令键就提醒
reportCredential :: WebConfig -> Map.Map Text Text -> Bool -> IO ()
reportCredential cfg saved legacy = do
putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved))
if legacy
then do
putStrLn ""
putStrLn " !! Administrator credentials are not configured; the built-in demo password is in use:"
putStrLn (" !! user " ++ T.unpack (credUser credential) ++ " / password " ++ T.unpack defaultPassword)
putStrLn " !! set user / password in the [web] section of chusql.toml and restart"
putStrLn ""
else
if T.null (credEncoded credential)
then putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved) ++ " (passwordless: only the administrator may sign in)")
else putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved) ++ " (credentials come from the settings file only)")
putStrLn " !! the [web] section still carries a plaintext password key; it is ignored now"
putStrLn " !! remove it: the administrator password lives in the __system_users system table"
else pure ()
-- | 配了 seed 就以管理员身份补演示数据
-- | 配了 seed 就补演示数据(管理员已设口令时跳过)
seedIfWanted :: WebConfig -> Map.Map Text Text -> Text -> Int -> IO ()
seedIfWanted cfg saved host port
| not (wcSeedDemo cfg) = pure ()
@@ -287,9 +279,9 @@ seedIfWanted cfg saved host port
Left message -> TIO.putStrLn ("demo data skipped: " <> message)
Right client -> do
session <- newSession client
signed <- authenticateSession session (rootUserName cfg saved) (resolvePlainPassword saved)
signed <- authenticateSession session (rootUserName cfg saved) ""
case signed of
Left message -> TIO.putStrLn ("demo data skipped: " <> message)
Left message -> TIO.putStrLn ("demo data skipped: " <> message <> " (set the administrator password after seeding)")
Right () -> do
result <- seedDemo session
case result of
+1
View File
@@ -59,6 +59,7 @@ test-suite chusql-web-test
hs-source-dirs: test
other-modules: Gates
build-tool-depends: chusql-server:chusql-server
, chusql-bootstrap:csql-bootstrap
build-depends: base
, aeson
, bytestring
+1
View File
@@ -7,5 +7,6 @@ packages:
- .
- ../chusql-core/engine
- ../chusql-server
- ../chusql-bootstrap
- ../chusql-core/model
- ../chusql-interface
+1 -1
View File
@@ -18,7 +18,7 @@ export function escapeHtml(value) {
const identifierPattern = /^[A-Za-z_][A-Za-z0-9_]*$/;
// 账号表:在 system 库里像普通表一样浏览,写入会翻译成账号命令。
export const accountsTable = '__chusql_users';
export const accountsTable = '__system_users';
// 值转 SQL 字面量(字符串加引号转义)。
export function sqlLiteral(value) {
+26 -47
View File
@@ -73,8 +73,9 @@ gateSpec = do
installer `shouldSatisfy` T.isInfixOf "Get-ResponseText"
installer `shouldSatisfy` T.isInfixOf "-is [byte[]]"
installer `shouldSatisfy` T.isInfixOf "ConvertFrom-Json"
-- 装什么由人当场选:逐个问、问答用英文、默认装 csql 不装 Web,选完才问管理员口令。
-- 提问顺序固定:先 cli 后 web。两个脚本文案必须一致,改一个就得改另一个。
-- 装什么由人当场选:逐个问、问答用英文、默认装 csql 不装 Web。管理员口令不在配置里,
-- 装机时是必答项:有终端就当场问两遍,没有就给 --password / -Password 或
-- CHUSQL_ADMIN_PASSWORD,口令只经 stdin 传给 csql-bootstrap。两个脚本必须一致。
it "both installers ask which components to install, in the same words" $ do
sh <- readUtf8 (".." </> "scripts" </> "install.sh")
ps <- readUtf8 (".." </> "scripts" </> "install.ps1")
@@ -84,13 +85,21 @@ gateSpec = do
( \src -> do
src `shouldSatisfy` T.isInfixOf cliAsk
src `shouldSatisfy` T.isInfixOf webAsk
src `shouldSatisfy` T.isInfixOf "Root password for"
src `shouldSatisfy` T.isInfixOf "The administrator account is "
src `shouldSatisfy` T.isInfixOf " the password cannot be empty"
src `shouldSatisfy` T.isInfixOf "the two entries differ, try again"
src `shouldSatisfy` T.isInfixOf "--password-stdin"
src `shouldSatisfy` T.isInfixOf "CHUSQL_ADMIN_PASSWORD"
-- 管理员不能没有口令:两个脚本都不许再留空口令这条路
src `shouldSatisfy` (not . T.isInfixOf "passwordless")
-- cli 的问题必须出现在 web 之前(文档里的用法示例也按这个顺序写)
T.length (fst (T.breakOn cliAsk src)) `shouldSatisfy` (< T.length (fst (T.breakOn webAsk src)))
)
[sh, ps]
sh `shouldSatisfy` T.isInfixOf "--password PASSWORD"
sh `shouldSatisfy` T.isInfixOf "--interactive"
sh `shouldSatisfy` T.isInfixOf "both"
ps `shouldSatisfy` T.isInfixOf "-Password"
ps `shouldSatisfy` T.isInfixOf "-Interactive"
ps `shouldSatisfy` T.isInfixOf "both"
-- 到底装的哪个版本要打出来:latest 解析来的和显式指定的,两处都得有。
@@ -107,6 +116,9 @@ gateSpec = do
src `shouldSatisfy` T.isInfixOf "releases"
src `shouldSatisfy` T.isInfixOf "install.sh"
src `shouldSatisfy` T.isInfixOf "install.ps1"
-- 卸载脚本跟安装脚本同路进包:装完就得能在包根上卸干净
src `shouldSatisfy` T.isInfixOf "uninstall.sh"
src `shouldSatisfy` T.isInfixOf "uninstall.ps1"
)
[sh, ps]
sh `shouldSatisfy` T.isInfixOf "tar -czf"
@@ -137,10 +149,10 @@ gateSpec = do
launcher <- readUtf8 (".." </> "scripts" </> "csql-web.sh")
launcher `shouldSatisfy` T.isInfixOf "cd \"$home_dir\""
launcher `shouldSatisfy` T.isInfixOf "chusql-server"
-- 默认数据目录按平台惯例算,四处必须说同一件事:Rust 代码、配置示例、模板、文档。
-- 默认数据目录按平台惯例算,三处必须说同一件事:Rust 代码、配置示例、模板。
-- 跟安装脚本装的位置也是一处:Windows 装到 %LOCALAPPDATA%\ChuSQL、Unix 装到 ~/.local/share/chusql,
-- 数据都放在它下面的 data/ 里。
it "the default data dir follows the platform, and code, template and docs agree" $ do
it "the default data dir follows the platform, and code and template agree" $ do
rust <- readUtf8 (".." </> "chusql-core" </> "storage" </> "src" </> "config.rs")
rust `shouldSatisfy` T.isInfixOf "default_data_dir"
rust `shouldSatisfy` T.isInfixOf "LOCALAPPDATA"
@@ -157,10 +169,6 @@ gateSpec = do
-- 模板那行是安装时被 sed / -replace 替换的占位,必须保持能生效
template `shouldSatisfy` T.isInfixOf "\ndata_dir = "
template `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%"
configDoc <- readUtf8 (".." </> "doc" </> "config.md")
configDoc `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%\\ChuSQL\\data"
configDoc `shouldSatisfy` T.isInfixOf "chusql/data"
-- 管道传输退休后,两侧都不该再算套接字路径、也不该再认管名。
it "neither side computes a socket path or a pipe name any more" $ do
haskellIpc <- readUtf8 (".." </> "chusql-core" </> "engine" </> "src" </> "ChuSQL" </> "Core" </> "Engine" </> "Storage" </> "IPC.hs")
@@ -209,7 +217,7 @@ gateSpec = do
release `shouldSatisfy` (not . T.isInfixOf "component: [web, cli]")
it "no layer looks for a storage executable or a pipe name any more" $ do
engine <- readUtf8 (".." </> "chusql-core" </> "engine" </> "test" </> "Spec.hs")
bench <- readUtf8 (".." </> "benchmark" </> "src" </> "Main.hs")
bench <- readUtf8 (".." </> "chusql-benchmark" </> "src" </> "Main.hs")
template <- readUtf8 (".." </> "scripts" </> "chusql.toml")
mapM_
(\src -> src `shouldSatisfy` (not . T.isInfixOf "pipe_name"))
@@ -223,47 +231,18 @@ gateSpec = do
(".." </> "chusql-server" </> "src" </> "ChuSQL" </> "Server" </> "StorageProcess.hs")
moduleGone `shouldBe` False
-- 细节分到 doc/ 下四份,README 只留面向用户的关键内容;链接断了或者文档没了,等于没写。
describe "Documentation (doc/)" $ do
it "the README keeps only the essentials and links the split documents" $ do
-- 文档只做结构约束:四篇在、README 能链到它们。正文怎么写、写多长都不校验,
-- 免得以后精简文档反而过不了门禁。
describe "Documentation (docs/)" $ do
it "the README links the split documents" $ do
readme <- readUtf8 (".." </> "README.md")
mapM_
(\target -> readme `shouldSatisfy` T.isInfixOf ("doc/" <> target <> ".md"))
(\target -> readme `shouldSatisfy` T.isInfixOf ("docs/" <> target <> ".md"))
["install", "config", "commands", "architecture"]
-- 安装选项与配置键的长表已经搬走,不该在 README 里再长回来
readme `shouldSatisfy` (not . T.isInfixOf "--from-source")
readme `shouldSatisfy` (not . T.isInfixOf "pool_size")
-- 仓库布局这类开发者信息属于 doc/architecture.md,不属于 README
readme `shouldSatisfy` (not . T.isInfixOf "chusql-engine/")
it "each split document covers what its name promises" $ do
let expectations =
[ ("install", ["install.sh", "install.ps1", "--component", "--install-dir", "--from-source", "--version", "--list-versions", "-Component", "-Version", "-ListVersions", "-Interactive", "CHUSQL_GITHUB_TOKEN", "rm -rf"])
, ("config", ["[web]", "[page]", "data_dir", "host", "port"])
, ("commands", ["csql", "--format", "\\dt", "CREATE ROLE", "GRANT", "/api/roles"])
, ("architecture", ["chusql-core", "chusql-server", "chusql-web", "csql", "data_dir", "CREATE DATABASE"])
]
mapM_
( \(name, needles) -> do
doc <- readUtf8 (".." </> "doc" </> name <> ".md")
mapM_ (\needle -> doc `shouldSatisfy` T.isInfixOf needle) needles
)
expectations
-- doc/ 只写面向用户的内容:构建、测试、打包这些开发流程不进文档
it "the split documents stay user-facing (no build, test or packaging recipes)" $ do
let developerOnly =
[ "package.ps1"
, "stack build"
, "stack test"
, "cargo build"
, "cargo test"
, "cargo clippy"
, ".stack-work"
, ".github/workflows"
, "smoke-linux.sh"
]
it "the split documents exist and are not empty" $ do
mapM_
( \name -> do
doc <- readUtf8 (".." </> "doc" </> name <> ".md")
mapM_ (\needle -> doc `shouldSatisfy` (not . T.isInfixOf needle)) developerOnly
doc <- readUtf8 (".." </> "docs" </> name <> ".md")
doc `shouldSatisfy` (not . T.null)
)
["install", "config", "commands", "architecture"]
+60 -15
View File
@@ -2,7 +2,9 @@
module Main (main) where
import ChuSQL.Interface.Link (closeClient, connectClient)
import ChuSQL.Interface.RateLimit (newRateLimiter)
import ChuSQL.Interface.Session (authenticateSession, newSession, runStatement)
import ChuSQL.Interface.Settings (
applySettings,
defaultOf,
@@ -66,6 +68,7 @@ import System.Directory (
removeFile,
removePathForcibly,
)
import System.Environment (lookupEnv)
import System.Exit (ExitCode (..))
import System.FilePath ((</>))
import System.Info (os)
@@ -76,6 +79,7 @@ import System.Process (
StdStream (CreatePipe, NoStream),
createProcess,
proc,
readProcessWithExitCode,
terminateProcess,
waitForProcess,
)
@@ -222,7 +226,7 @@ ensureAccount hs user password = do
created <-
postAs
(withDb "system" hs)
"/api/tables/__chusql_users/rows"
"/api/tables/__system_users/rows"
(encode (object ["values" .= object ["user" .= user, "password" .= password]]))
check (statusCode (WT.simpleStatus created) `shouldSatisfy` (`elem` [200, 409]))
@@ -376,19 +380,38 @@ startLiveWorld label = do
config = root </> "chusql.toml"
createDirectoryIfMissing True dataDir
writeFile config (serverConfigText dataDir)
seedSystemCatalog config
(_, Just out, _, process) <-
createProcess (proc bin ["--config", config]){std_out = CreatePipe, std_err = NoStream}
port <- readListeningPort out
_ <- forkIO (drainHandle out)
setAdminPassword port
pure (LiveWorld process port config dataDir)
-- | 首启的管理员还没有口令:先用空口令登录,再按业务流程设一个
setAdminPassword :: Int -> IO ()
setAdminPassword port = do
opened <- connectClient "127.0.0.1" port
case opened of
Left err -> fail ("fixture server refused the connection: " ++ T.unpack err)
Right client -> do
session <- newSession client
signed <- authenticateSession session adminUser ""
case signed of
Left err -> fail ("fixture administrator cannot sign in: " ++ T.unpack err)
Right () -> do
changed <- runStatement session ("ALTER USER " <> adminUser <> " IDENTIFIED BY '" <> adminPassword <> "'")
case changed of
Left err -> fail ("fixture administrator keeps no password: " ++ T.unpack err)
Right _ -> pure ()
closeClient client
-- | 生成夹具 server 的配置文本
serverConfigText :: FilePath -> String
serverConfigText dataDir =
unlines
[ "[web]"
, "user = \"" ++ T.unpack adminUser ++ "\""
, "password = \"" ++ T.unpack adminPassword ++ "\""
, "password-min-length = 8"
, "password-classes = 2"
, ""
@@ -439,6 +462,28 @@ locateServerExe = do
Just path -> pure path
Nothing -> fail "chusql-server was not found on PATH: run `stack build` first"
-- | 全新的数据目录还没有系统目录:先跑引导程序建表并补一个免密管理员,
-- server 才肯启动(未引导的目录会被它拒绝)。
seedSystemCatalog :: FilePath -> IO ()
seedSystemCatalog config = do
bootstrap <- locateBootstrapExe
(code, out, errOut) <- readProcessWithExitCode bootstrap ["--config", config, "--passwordless"] ""
case code of
ExitSuccess -> pure ()
_ -> fail ("the fixture bootstrap program failed (exit " ++ show code ++ "): " ++ out ++ errOut)
-- | 找引导程序:先环境变量,再 PATH
locateBootstrapExe :: IO FilePath
locateBootstrapExe = do
fromEnv <- lookupEnv "CHUSQL_BOOTSTRAP_EXE"
case fromEnv of
Just path -> pure path
Nothing -> do
found <- findExecutable (binaryName "csql-bootstrap")
case found of
Just path -> pure path
Nothing -> fail "csql-bootstrap was not found on PATH: run `stack build` first"
-- | 构造指向真 server 的 Web 环境
liveEnv :: LiveWorld -> FilePath -> Int -> IO AppEnv
liveEnv world staticDir attempts = do
@@ -491,7 +536,7 @@ unitSpec = describe "pure helpers" $ do
it "round-trips settings through a real TOML file" $ do
path <- tempFilePath "settings"
removeIfExists path
writeSettingsFile path (Map.fromList [("rows-per-page", "50"), ("user", "admin"), ("password", "s3cret")])
writeSettingsFile path (Map.fromList [("rows-per-page", "50"), ("user", "admin")])
>>= (`shouldSatisfy` isRightE)
values <- readSettingsFile path
Map.lookup "rows-per-page" values `shouldBe` Just "50"
@@ -500,8 +545,8 @@ unitSpec = describe "pure helpers" $ do
applySettings Map.empty (Map.fromList [("nope", "1")]) `shouldSatisfy` isLeftE
applySettings Map.empty (Map.fromList [("password-min-length", "3")]) `shouldSatisfy` isLeftE
applySettings Map.empty (Map.fromList [("password-min-length", "12")]) `shouldSatisfy` isRightE
it "marks root credentials as locked and lists the live keys" $ do
isLockedSetting "password" `shouldBe` True
it "marks the administrator name as locked and lists the live keys" $ do
isLockedSetting "user" `shouldBe` True
isLockedSetting "rows-per-page" `shouldBe` False
("rows-per-page" `elem` liveKeys) `shouldBe` True
length settingCatalogue `shouldSatisfy` (> 20)
@@ -589,7 +634,7 @@ gatingSpec env = describe "gate keeping" $ do
it "rejects the account table outside the system database" $ do
hs <- adminHeaders
ensureDatabase hs testDatabaseName
res <- getAs (withDb testDatabaseName hs) "/api/tables/__chusql_users/rows"
res <- getAs (withDb testDatabaseName hs) "/api/tables/__system_users/rows"
expectStatusWith "account table outside system" res 400
it "rejects role management without a cookie" $ do
res <- getAs [] "/api/roles"
@@ -703,7 +748,7 @@ settingsSpec env = describe "settings and password policy" $ do
let entries = items (at "items" (jsonBody res))
check (length entries `shouldSatisfy` (> 20))
check (asText (at "value" (headEntry "rows-per-page" entries)) `shouldBe` "25")
check (at "locked" (headEntry "password" entries) `shouldBe` A.Bool True)
check (at "locked" (headEntry "user" entries) `shouldBe` A.Bool True)
it "writes a setting, makes the server reload the policy, and reports it applied" $ do
hs <- adminHeaders
res <-
@@ -728,12 +773,12 @@ settingsSpec env = describe "settings and password policy" $ do
values <- liftIO (readSettingsFile (aeSettingsFile env))
check (Map.lookup "password-min-length" values `shouldBe` Just "16")
check (Map.lookup "user" values `shouldBe` Just adminUser)
it "refuses unknown settings and the locked root credentials" $ do
it "refuses unknown settings and the locked administrator name" $ do
hs <- adminHeaders
unknown <- putAs hs "/api/settings" (encode (object ["values" .= object ["nope" .= ("1" :: Text)]]))
expectStatusWith "unknown setting" unknown 400
locked <- putAs hs "/api/settings" (encode (object ["values" .= object ["password" .= ("hacked" :: Text)]]))
expectStatusWith "locked credential" locked 403
locked <- putAs hs "/api/settings" (encode (object ["values" .= object ["user" .= ("hacked" :: Text)]]))
expectStatusWith "locked administrator name" locked 403
-- 账号表 ---------------------------------------------------------------------
@@ -745,14 +790,14 @@ accountSpec env = describe "the account table (system database, admin only)" $ d
hs <- adminHeaders
res <- getAs (withDb "system" hs) "/api/tables"
expectStatusWith "system tables" res 200
check (("__chusql_users" `elem` map (asText . at "table") (items (jsonBody res))) `shouldBe` True)
check (("__system_users" `elem` map (asText . at "table") (items (jsonBody res))) `shouldBe` True)
it "creates an account, changes its password, signs in as it and drops it" $ do
hs <- adminHeaders
ensureAccount hs "alice" "alice-Secret-1234"
duplicate <-
postAs
(withDb "system" hs)
"/api/tables/__chusql_users/rows"
"/api/tables/__system_users/rows"
(encode (object ["values" .= object ["user" .= ("alice" :: Text), "password" .= ("alice-Secret-9999" :: Text)]]))
expectStatusWith "duplicate account" duplicate 409
alice <- ordinaryHeaders "alice" "alice-Secret-1234"
@@ -764,14 +809,14 @@ accountSpec env = describe "the account table (system database, admin only)" $ d
changed <-
patchAs
(withDb "system" hs)
"/api/tables/__chusql_users/rows/alice"
"/api/tables/__system_users/rows/alice"
(encode (object ["values" .= object ["password" .= ("alice-Secret-5678" :: Text)]]))
expectStatusWith "change password" changed 200
_ <- ordinaryHeaders "alice" "alice-Secret-5678"
dropped <- deleteAs (withDb "system" hs) "/api/tables/__chusql_users/rows/alice"
dropped <- deleteAs (withDb "system" hs) "/api/tables/__system_users/rows/alice"
expectStatusWith "drop account" dropped 200
it "refuses account writes without a cookie" $ do
res <- getAs (withDb "system" []) "/api/tables/__chusql_users/rows"
res <- getAs (withDb "system" []) "/api/tables/__system_users/rows"
expectStatusWith "account rows without a cookie" res 401
-- 角色 -----------------------------------------------------------------------
-79
View File
@@ -1,79 +0,0 @@
# 架构与组件
ChuSQL 由三个面向用户的程序、几个共享库与一份配置组成:
| 组件 | 作用 |
| ------------------------------- | -------------------------------------------------------------------- |
| `chusql-server` | 数据库服务:进程内装入引擎与存储动态库、独占数据目录,对外只开一个 TCP 端口 |
| `chusql-web` | Web 管理端:浏览器里的数据库 IDE,自己开 HTTP 端口,后端经 TCP 连 `chusql-server` |
| `csql` | 命令行客户端,经 TCP 连 `chusql-server` |
| `chusql-core/engine`(库) | SQL 解析、语义检查、优化与执行,链进 `chusql-server` |
| `chusql-core/storage`(动态库) | 存储:页面与索引、WAL、崩溃恢复 |
| `chusql-interface`(库) | 接口层:线上协议、配置与设置、口令与限流、语句构造、TCP 客户端与会话,`chusql-web` 与 `csql` 共用 |
| `chusql-core/model`(库) | 共享类型:表与列、结果集、权限枚举 |
安装时把可执行文件与存储动态库(`libchusql_core_storage.so` / `chusql_core_storage.dll`)放进同一个目录,
进程按 exe 所在目录就能找到库。
## 数据流
浏览器、`csql` 或别的程序 → TCP → `chusql-server` → 同一进程里调 `chusql-core/engine`
(经 FFI 再调 `chusql-core/storage` 动态库)→ 磁盘。
**数据目录只有 `chusql-server` 一个进程碰**:`chusql-web` 与 `csql` 自己不开存储,它们把 SQL 与数据字典请求
交给 TCP 服务执行,拿到结果再渲染。因此库文件同一时刻只有一个持有者;进程内的并发先用一把锁串起来,
完整事务与 MVCC 见后续计划。
`chusql-web` 是「自己开 HTTP 服务、同时又是 `chusql-server` 的 TCP 客户端」:浏览器只跟 Web 说话,
Web 后端在需要认证、鉴权、读数据或改数据的时候,才把请求发给 `chusql-server`。
三种用法共用同一份 [`chusql.toml`](config.md)、同一个管理员账号与同一张账号表——任意一端改的账号与权限,
另外两端立刻生效。
## 一次请求经过什么
1. 浏览器、命令行或别的程序发起 SQL;
2. 解析与语义检查(表/列是否存在、类型是否匹配、权限是否足够)在 `chusql-server` 里完成,不合格的语句不会落到磁盘;
3. 合格语句经 FFI 交给同一进程里的存储库;
4. 存储库读写页面与索引,写之前先记 WAL;
5. 结果原路返回。
## 数据在哪里
数据都在 `[storage] data_dir` 下。不写这个键就按平台惯例:Windows `%LOCALAPPDATA%\ChuSQL\data`,
Linux / macOS `${XDG_DATA_HOME:-~/.local/share}/chusql/data`。
| 目录 | 内容 |
| --------------------- | ---------------------------- |
| `system/` | 系统库:账号表与角色授权表 |
| `databases/<库名>/` | 各自建的库 |
服务启动后只建 `system`,**没有默认工作库**;其余库由你自己 `CREATE DATABASE` 创建。
## TCP 数据库服务(`chusql-server`)
给别的程序用的接口:一条 TCP 连接一条 SQL 会话,请求和应答都是**一行一个 JSON 对象**,编码 UTF-8。
| 请求 | 字段 | 应答 `status` |
| --------------- | --------------------------- | ---------------------------------------------------------------- |
| `hello` | `protocol`(可选,默认 1) | `hello`:带 `protocol`、`server` |
| `login` | `user`、`password` | `ok`:带 `user`、`admin` |
| `query` | `sql` | `result`:带 `columns`、`rows`、`rowCount`、`truncated`、`database` |
| `catalog` | — | `catalog`:带 `schemas`(表与列) |
| `databases` | — | `databases`:带库名列表 |
| `roles` | — | `roles`:带角色与授权视图 |
| `accounts` | — | `accounts`:带账号表(仅管理员) |
| `policy` | — | `policy`:带 `minLength`、`classes`(仅管理员) |
| `reload-policy` | — | `policy`:重新读设置里的口令策略(仅管理员) |
| `storage` | `request`(存储层的原始请求) | `storage`:带 `response`(存储层的原始应答,仅管理员) |
| `ping` | — | `pong` |
| `quit` | — | `bye`,随后连接关闭 |
方法名大小写不敏感,认不出的字段忽略。任何一端出错都回 `{"status":"error","code":...,"message":...}`
且**连接不断**,客户端可以接着发下一条;`code` 取值有 `bad_request`(协议号不符、SQL 为空、行太长)、
`unauthorized`(没登录就查询、口令不对)、`forbidden`、`too_many_attempts`(登录失败被限流)、
`too_large`、`no_database`、`not_found`、`query_error`、`conflict`、`storage_error`。
登录之前只能 `hello` / `ping` / `quit`;`storage`、`accounts`、`policy`、`reload-policy` 与系统库只对管理员开放。
每条连接各有一份会话,数据库选择(`USE <库>`)不跨连接。监听参数在 `[server]` 分区(见 [config.md](config.md)),
默认只听本机 `127.0.0.1:7777`。
-165
View File
@@ -1,165 +0,0 @@
# 命令与选项
## 一共有几个可执行文件
| 命令 | 作用 | 选项 |
| ---- | ---- | ---- |
| `chusql-server` | 数据库服务:装入引擎与存储动态库、独占数据目录,对外是 TCP | 见「`chusql-server` 选项」 |
| `chusql-web` | Web 管理端:REST 接口 + 浏览器里的数据库 IDE | 见「`chusql-web` 选项」 |
| `csql` | 命令行客户端,连数据库服务的 TCP 端点 | 见「`csql` 选项」 |
| `csql-web` | 一键启动器:按配置拉起 Web 服务,日志写 `<install-dir>/logs` | 无选项(`host`/`port` 从配置读) |
四个命令共用同一份 [`chusql.toml`](config.md);`--config` 都是用来临时读另一份配置的。
## `csql` 选项
csql [options]
| 选项 | 默认 | 说明 |
| ---- | ---- | ---- |
| `-u, --user USER` | 配置里的管理员 | 用这个账号登录 |
| `-p, --password` | — | 强制交互输入口令,忽略配置里的 |
| `-d, --database DB` | 不选(启动后没有默认库) | 登录后直接选中哪个库 |
| `-f, --format FORMAT` | `table` | 输出格式:`table` / `json` / `csv` |
| `-e, --execute SQL` | — | 跑一条语句就退出(脚本化用) |
| `--history FILE` | `~/.chusql_history` | 历史文件位置 |
| `--config FILE` | 固定位置的 `chusql.toml` | 读另一份配置 |
| `-h, --help` | — | 帮助 |
脚本化示例:
csql -e "SELECT count(*) FROM orders" -f json
csql -u analyst -p -d sales -f csv -e "SELECT * FROM orders LIMIT 5"
## 交互模式
- 提示符 `chusql>`;语句以**分号**结尾,可以跨多行;上下键翻历史(默认存 `~/.chusql_history`)。
- 退出码:语句出错时非 0,方便在脚本里判断。
### 元命令
| 元命令 | 作用 |
| ------ | ---- |
| `\q` `\quit` | 退出 |
| `\?` `\h` `\help` | 帮助 |
| `\l` `\list` | 列出数据库 |
| `\dt` `\d` | 列出当前库的表 |
| `\d <表>` | 看表结构 |
| `\dr` `\roles` | 角色总览:授权对象与成员(管理员专属,等价于 Web 的 `GET /api/roles`) |
| `\c <库>` | 切换数据库 |
| `\f` `\format <fmt>` | 切换输出格式:`table` / `json` / `csv` |
普通身份用 `\dt` 时只会看到自己有 `SELECT` 权限的表,系统表永远不出现。
## 账号与权限
账号:root(配置里的 `user` / `password` 决定,见 [config.md](config.md))是管理员,其余都是普通账号,
默认**零权限**,只能看到被授权的表。系统库 `system`(账号表在里面)只有管理员能进。
服务启动后**只有系统库**,没有任何默认工作库:自己 `CREATE DATABASE shop` 再 `USE shop`。
没选库时只有"限定名"语句能跑(`SELECT * FROM shop.items`),裸表名(`SELECT * FROM items`)会报
`no database selected`——先把库选上。
CREATE USER alice IDENTIFIED BY 'secret'; -- 普通账号,口令是明文,服务端加盐派生
ALTER USER alice IDENTIFIED BY 'new-secret'; -- 改口令
DROP USER alice;
`CREATE USER` / `ALTER USER` / `DROP USER` 只有管理员能执行(Web 端在 SQL 控制台,命令行直接跑)。
权限按**角色**给,三句话:
CREATE ROLE analyst; -- 建角色(平的角色,不可继承)
GRANT SELECT, INSERT ON orders TO analyst; -- 授权:对象可以是表名或 *
GRANT analyst TO alice; -- 把角色给账号
REVOKE INSERT ON orders FROM analyst; -- 收回权限
REVOKE analyst FROM alice; -- 收回角色
DROP ROLE analyst;
| 权限 | 覆盖 |
| ---- | ---- |
| `SELECT` | `SELECT`(含 JOIN、投影、`WHERE` 里的子查询) |
| `INSERT` | `INSERT`(含 `VALUES` 里的子查询) |
| `UPDATE` | `UPDATE`(含赋值与 `WHERE` 里的子查询) |
| `DELETE` | `DELETE`(含 `WHERE` 里的子查询) |
| `ALL` | 上面四种,等价于逐条授权 |
- 对象写 `*` 表示当前库里所有表;写表名时按**当前库**限定(在 `sales` 库执行 `GRANT ... ON orders`
授权的是 `sales.orders`),换库要重新授权。
- 管理员(root)隐式拥有全部权限,不用授权;DDL(建表、建索引等)一律只有管理员能做。
- 角色语句本身只有管理员能跑;普通账号跑 `\dr` / `GET /api/roles` 会被拒(`administrator required`)。
- 授权变更立即生效;已经登录的会话不会被踢下线。
- 当前限制:没有列级授权,没有 `WITH GRANT OPTION`,角色不可继承,也没有自助查询(普通账号不能自己
看自己的授权,得问管理员)。
Web 端对应的接口是 `/api/roles` 系列(`GET` 列表、`POST` 建角色、`DELETE /api/roles/:name` 删角色、
`POST/DELETE /api/roles/:name/grants` 授权/收权、`POST/DELETE /api/roles/:name/members[/:user]` 成员),
全部管理员专属。
## `chusql-web` 选项
chusql-web [options]
| 选项 | 对应配置键 | 默认 |
| ---- | ---------- | ---- |
| `--config FILE` | — | 固定位置的 `chusql.toml` |
| `--host H` | `[web] host` | `127.0.0.1` |
| `--port N` | `[web] port` | `7778` |
| `--static DIR` | `[web] static_dir` | `static` |
| `--user NAME` | `[web] user` | `root` |
| `--cookie-secure BOOL` | `[web] cookie_secure` | `false` |
| `--body-limit N` | `[web] body_limit` | `65536` |
| `--session-idle N` | `[web] session_idle` | `28800` |
| `--session-max N` | `[web] session_max` | `86400` |
| `--login-max-attempts N` | `[web] login_max_attempts` | `5` |
| `--login-window N` | `[web] login_window` | `300` |
| `--page-size N` | `[web] rows_per_page` | `25` |
| `--max-page-size N` | `[web] max_page_size` | `500` |
| `--max-rows N` | `[web] max_rows` | `1000` |
| `--max-sql-length N` | `[web] max_sql_length` | `20000` |
| `--seed BOOL` | `[web] seed` | `false` |
| `-h, --help` | — | 帮助 |
REST 接口(界面的一键操作全走结构化接口):
| 分组 | 接口 |
| ---- | ---- |
| 探活(无需登录) | `GET /api/health`、`GET /api/status` |
| 会话 | `POST /api/login`、`POST /api/logout`、`GET /api/session` |
| 设置 | `GET`/`PUT /api/settings`、`GET`/`PUT /api/ui-settings` |
| 库 | `GET`/`POST /api/databases`、`DELETE /api/databases/:name` |
| 表 | `GET`/`POST /api/tables`、`GET`/`DELETE /api/tables/:t` |
| 行 | `GET`/`POST /api/tables/:t/rows`、`PATCH`/`DELETE /api/tables/:t/rows/:id` |
| 索引与列 | `POST /api/tables/:t/indexes`、`DELETE /api/tables/:t/indexes/:col`、`DELETE /api/tables/:t/columns/:col` |
| 演示数据 | `POST /api/demo-data` |
| SQL 控制台 | `POST /api/query`(`CREATE USER` / `CREATE ROLE` / `GRANT` 也在这里跑) |
| 角色 | `GET`/`POST /api/roles`、`DELETE /api/roles/:name`、`POST`/`DELETE /api/roles/:name/grants`、`POST`/`DELETE /api/roles/:name/members[/:user]` |
除探活、登录和首页(`GET /`、`GET /static/:file`)外都要带会话 Cookie。选库用 `X-ChuSQL-Database` 头:
**不带这个头就是"没选库"**,此时只有限定名语句(`db.table`)能跑,裸表名会得到 400 `no_database`;
`GET /api/databases` 和 `POST`/`DELETE /api/databases/:name` 不需要选库。普通身份碰 `system` 库一律 403。
## `chusql-server` 选项
chusql-server [options]
| 选项 | 对应配置键 | 默认 |
| ---- | ---------- | ---- |
| `--config FILE` | — | 固定位置的 `chusql.toml` |
| `--host H` | `[server] host` | `127.0.0.1` |
| `--port N` | `[server] port` | `7777` |
| `--user NAME` | `[web] user` | `root` |
| `--max-message N` | `[server] max_message` | `1048576` |
| `--max-rows N` | `[server] max_rows` | `1000` |
| `-h, --help` | — | 帮助 |
启动后打印实际监听地址,它同时是数据目录的唯一持有者:Web 与 `csql` 不开存储,把存储请求交给它转发。
客户端按**一行一个 JSON** 说话,方法与错误码见
[architecture.md](architecture.md) 的「TCP 数据库服务」;用 `nc` 手敲一个会话是这样:
{"method":"hello","protocol":1}
{"method":"login","user":"root","password":"..."}
{"method":"query","sql":"USE test"}
{"method":"query","sql":"SELECT * FROM users"}
{"method":"quit"}
对话里每条 SQL 走的是和 Web、`csql` 同一套解析与权限检查,账号与库选择互不共享。
-110
View File
@@ -1,110 +0,0 @@
# 配置选项
## 文件在哪
整条链路(数据库服务 / Web / 命令行)共用一份 `chusql.toml`,位置固定,**没有环境变量可以覆盖**:
| 平台 | 路径 |
| ------------ | ---- |
| Windows | `%APPDATA%\ChuSQL\chusql.toml`(`APPDATA` 没设时退到相对路径 `ChuSQL\chusql.toml`) |
| Linux / macOS | `$XDG_CONFIG_HOME/ChuSQL/chusql.toml`,没设就是 `~/.config/ChuSQL/chusql.toml`(`HOME` 也没有才退相对路径 `ChuSQL/chusql.toml`) |
安装脚本就是把 [`scripts/chusql.toml`](../scripts/chusql.toml) 这份模板写到上面的位置,并把安装时给的
`user` / `password` / `data_dir` 填进去。想临时读另一份文件,`chusql-server`、`chusql-web`、`csql`
都认 `--config <path>`(启动器 `csql-web` 没有选项,只读固定路径)。
优先级:**命令行选项 > 配置文件 > 内置默认**,也就是配置文件写什么,命令行随时能盖掉
(选项表见 [commands.md](commands.md))。
## 分区归属
| 分区 | 谁读 |
| ---- | ---- |
| `[page]` `[btree]` `[buffer]` `[storage]` `[log]` | 存储层 `chusql-core/storage`(由 `chusql-server` 装入的动态库) |
| `[server]` | TCP 数据库服务 `chusql-server`(监听地址、端口、单行上限、结果行数上限) |
| `[web]` | Web 服务 `chusql-web` 与命令行 `csql`(账号、会话、限流、分页上限、静态目录) |
数据目录只有一份配置:`chusql-server` 读它来落盘,别的进程不碰。
## 存储的分区
| 键 | 默认 | 说明 |
| -- | ---- | ---- |
| `[page] size` | `4096` | 页大小(字节) |
| `[btree] order` | `4` | B+ 树阶 |
| `[buffer] pool_size` | `1024` | 缓冲池页数 |
| `[storage] data_dir` | Windows `%LOCALAPPDATA%\ChuSQL\data`,Linux / macOS `${XDG_DATA_HOME:-~/.local/share}/chusql/data` | 数据落哪(模板里那行是安装时替换的占位) |
| `[log] level` | `info` | 日志级别 |
数据目录跟着平台惯例走,跟安装脚本装的位置是同一处(Windows 装到 `%LOCALAPPDATA%\ChuSQL`、Unix 装到
`~/.local/share/chusql`,数据放在它下面的 `data/`);`LOCALAPPDATA`/`XDG_DATA_HOME`/`HOME` 都没有时才退相对路径。
要固定就写绝对路径。
存储层没有自己的命令行选项:它是 `chusql-server` 进程内装入的动态库。
## `[web]` 分区
| 键 | 命令行(`chusql-web`) | 默认 | 说明 |
| -- | ---------------------- | ---- | ---- |
| `host` | `--host` | `127.0.0.1` | 监听地址 |
| `port` | `--port` | `7778` | 监听端口 |
| `static_dir` | `--static` | `static` | 静态资源目录(候选:给定值、`static`、`chusql-web/static`、`../chusql-web/static`、`../static`,取第一个存在的) |
| `user` | `--user` | 配置文件缺失时 `root` | 管理员账号名 |
| `password` | — | 文件里**没有**这一项时用内置演示口令 `root` / `chusql` | 管理员口令(明文,启动时哈希;见「口令与安全」) |
| `cookie_secure` | `--cookie-secure` | `false` | 给会话 Cookie 加 `Secure`(HTTPS 部署时开) |
| `body_limit` | `--body-limit` | `65536` | 请求体上限(字节) |
| `session_idle` | `--session-idle` | `28800` | 会话空闲超时(秒) |
| `session_max` | `--session-max` | `86400` | 会话最大存活(秒) |
| `login_max_attempts` | `--login-max-attempts` | `5` | 连续失败几次后限流 |
| `login_window` | `--login-window` | `300` | 限流窗口(秒) |
| `rows_per_page` | `--page-size` | `25` | 默认每页行数 |
| `max_page_size` | `--max-page-size` | `500` | 每页行数上限 |
| `max_rows` | `--max-rows` | `1000` | 单次查询返回行数上限 |
| `max_sql_length` | `--max-sql-length` | `20000` | SQL 字符数上限 |
| `seed` | `--seed` | `false` | 库为空时灌演示数据 |
| `password_min_length` | — | `12` | 普通账号口令最短长度(允许 8–256) |
| `password_classes` | — | `2` | 口令至少包含几类字符(允许 1–4:小写/大写/数字/符号) |
### 键名两种写法都认
模板 `scripts/chusql.toml` 用下划线,Web 设置页写的是连字符(规范形式)。两种写法同时出现时**连字符优先**:
[web]
rows_per_page = 25 # 模板写法
rows-per-page = 50 # 设置页写法,生效
对应关系:`static_dir`→`static-dir`、`session_idle`→`session-idle`、`session_max`→`session-max`、
`login_max_attempts`→`login-max-attempts`、`login_window`→`login-window`、`body_limit`→`body-limit`、
`rows_per_page`→`rows-per-page`、`max_page_size`→`max-page-size`、`max_rows`→`max-rows`、
`max_sql_length`→`max-sql-length`、
`password_min_length`→`password-min-length`、`password_classes`→`password-classes`。
`host`、`port`、`user`、`password`、`seed` 只有一种写法。
## `[server]` 分区
TCP 数据库服务 `chusql-server` 的监听参数。单独一段:别层的进程不认这一段,也不需要认。
| 键 | 命令行(`chusql-server`) | 默认 | 说明 |
| -- | ------------------------- | ---- | ---- |
| `host` | `--host` | `127.0.0.1` | 监听地址 |
| `port` | `--port` | `7777` | 监听端口;写 `0` 让系统分配,实际端口打在启动横幅里 |
| `max_message` | `--max-message` | `1048576` | 单行请求上限(字节),超了回 `too_large` |
| `max_rows` | `--max-rows` | `1000` | 单次查询返回行数上限,超了截断并置 `truncated` |
这四项改完要重启 `chusql-server` 才生效(Web 设置页也把它们标成需要重启)。
## 口令与安全
- `password` 给了明文 → 启动时哈希;**显式留空**(`password = ""`)= 只允许管理员免密登录,普通账号一律拒绝登录;
- **整个文件里没有 `password` 这一项** → 回落到内置演示口令 `root` / `chusql`(仅用于本机试用,正式部署请写死);
- 普通账号由管理员在 SQL 控制台用 `CREATE USER` / `ALTER USER` / `DROP USER` 管理,口令受
`password_min_length` / `password_classes` 约束;
- 生产部署建议:`host = 127.0.0.1`(或放在反向代理后)、`cookie_secure = true`、给管理员设口令,
并且别把数据目录放在共享盘上。
## 改配置的两种途径
1. 直接编辑 `chusql.toml`(新值在下次启动生效);
2. Web 设置页(`/api/settings`)按分区把改动写回同一份文件——它会写成连字符形式。
每一项都带注释的模板在 [`scripts/chusql.toml`](../scripts/chusql.toml)。
-151
View File
@@ -1,151 +0,0 @@
# 安装与卸载
发行包里的程序是编好的:**装的人不需要 GHC,也不需要 Rust**。没有对应平台的发行包、或者要改代码时,
走「从源码安装」。
## 三种安装方式
| 方式 | 适用 | 命令 |
| -------- | -------------------------- | -------------------------------------------------------- |
| 在线安装 | 有网络,装最新发行版 | `curl -fsSL .../scripts/install.sh \| sh -s -- --component web` |
| 包内安装 | 手里已有归档(离线、内网) | 解压后在包根跑 `./install.sh --component web` |
| 源码安装 | 没有对应平台资源,或要改代码 | `./install.sh --component web --from-source` |
Linux / macOS 用 `install.sh`,Windows 用 `install.ps1`;一个平台的发行包里 Web 管理端和命令行
客户端 `csql` 都有。`--component web` / `cli` / `both` 直接指定装哪几个;不写就**逐个问**
(英文提示,回答 `y` / `n`,直接回车取方括号里的默认值):
Install the command line client (csql)? [Y/n]
Install the web front end (browser UI)? [y/N]
默认装 `csql`、不装 Web;可以都装、可以只装一个,也可以两个都不选(那就只装存储库
`libchusql_core_storage.so` / `chusql_core_storage.dll` 和 `chusql-server`)。**没选的组件一个文件都不会释放**。选完再提示设置管理员的初始口令
(`--password` / `-RootPassword` 给了就不问)。没有终端、又在跑脚本(比如 `curl | sh`)时问不了,
那时必须显式给 `--component`。
## 一、发行包
归档由项目在打 tag 时按平台构建上传,名字是 `chusql-<os>-<arch>`,并附 `.sha256`。一个归档里
Web 和 cli 两部分都有,装哪几个由包内脚本当场问:
| 平台 | 资源名 |
| -------------- | ---------------------------------------------------------- |
| Linux x86_64 | `chusql-linux-x86_64.tar.gz` |
| Windows x86_64 | `chusql-windows-x86_64.zip` |
| macOS | `chusql-macos-x86_64.tar.gz`、`chusql-macos-arm64.tar.gz` |
### 在线安装
一行命令:脚本自己按 `uname` 挑资源、校验 sha256、解包、释放、写配置、加 PATH,最后清掉临时包:
curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh \
| sh -s -- --component web
仓库与版本可以改:
sh -s -- --component cli --repo OWNER/NAME --version v0.3.0
`--version` 不写就是 `latest`:脚本先问 GitHub API 要 release 列表,挑**最新的、正式版、且确实带本平台归档**
的那个;列表里一个都不合适就不猜。预发布版(prerelease)不会自动选中——要装就显式写 tag。先看有哪些版本:
sh -s -- --list-versions
自建站点(GitHub Enterprise、镜像)用环境变量换基地址,取包和查版本都跟着走:
CHUSQL_GITHUB_BASE=https://git.example.com sh -s -- --component web
查版本用的接口未认证时限制 60 次/小时,超了会自动退回 GitHub 的 `latest` 重定向(还能装,但挑不了"最新正式版")。
CI 里或装得频繁时给个 token,两个脚本都认(`GITHUB_TOKEN` 也可以):
CHUSQL_GITHUB_TOKEN=ghp_xxx sh -s -- --list-versions
Windows 是同一套玩法,`install.ps1` 自己下 zip、校验 sha256、解包:
irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile install.ps1
.\install.ps1 -Component web
.\install.ps1 -ListVersions
.\install.ps1 -Component cli -Repo OWNER/NAME -Version v0.3.0
在线模式只在脚本旁边没有包时才走:`bin\chusql_core_storage.dll` 在脚本旁边就是包内安装,不碰网络。
### 指定归档
不碰网络下载逻辑,直接指一个归档(本地路径、`file://` 或任意 URL):
./install.sh --component web --url dist/chusql-linux-x86_64.tar.gz
./install.sh --component cli --url https://example.com/chusql-linux-x86_64.tar.gz
### 包内安装
解压发行包后在包根目录直接跑安装脚本,就是最常见的本地安装:
./install.sh --component web --user root --password '...' # Linux / macOS
./install.ps1 -Component web -RootUser root -RootPassword '...' # Windows
不给 `--component` 就是交互模式,脚本一个个问:
./install.sh
.\install.ps1
Windows 的 `install.ps1` 两种模式都支持(包内 + 在线),只有源码模式没有——要改代码就在仓库里编。
## 二、安装选项
| `install.sh` | `install.ps1` | 默认 | 说明 |
| ----------------------- | ---------------- | --------------- | ---- |
| `--component web\|cli\|both` | `-Component` | 逐个问(没有终端时必填) | 装哪个前端 |
| `--interactive` | `-Interactive` | 有终端就问 | 强制从标准输入收答案(`curl \| sh`、自动化里用) |
| `--install-dir DIR` | `-InstallDir` | Linux/macOS `$HOME/.local/share/chusql`;Windows `%LOCALAPPDATA%\ChuSQL` | 程序装到哪 |
| `--data-dir DIR` | `-DataDir` | `<install-dir>/data` | 数据落哪 |
| `--user NAME` | `-RootUser` | `root` | 管理员账号名 |
| `--password PW` | `-RootPassword` | 空 | 管理员口令;留空=只允许管理员免密登录 |
| `--keep-package` | `-KeepPackage` | 否 | 装完不删安装包 |
| `--url URL\|PATH` | — | — | 从这个归档装(只有 `install.sh` 有;Windows 直接解压 zip 走包内安装) |
| `--repo OWNER/NAME` | `-Repo` | `TheBadRoger/ChuSQL` | 从哪个仓库取发行包 |
| `--version TAG` | `-Version` | `latest` | 下载模式是 release tag(`latest`=最新的、带本平台包的正式版),源码模式是 git ref |
| `--list-versions` | `-ListVersions` | — | 列出仓库里的发行 tag(预发布带标记),然后退出 |
| `--from-source` | — | — | 从源码编译安装 |
| `--source-dir DIR` | — | — | 用本地 checkout 编译,不克隆 |
## 三、从源码安装
需要 `git` + `cargo` + `stack` + `ghc`;Linux 上还要 zlib 开发头(`apt-get install zlib1g-dev`):
./install.sh --component web --from-source # 克隆仓库再编
./install.sh --component web --from-source --source-dir ../ChuSQL # 用本地 checkout
编完之后的释放、写配置、加 PATH 与包内安装完全相同,启动方式也一样。
## 四、装完是什么样
以 Linux、`--component web`、默认目录为例(选了 cli 就多一份 `bin/csql` 和一个 `csql` 命令入口):
| 位置 | 内容 |
| ---- | ---- |
| `~/.local/share/chusql/bin/` | `libchusql_core_storage.so`(一定装)、`chusql-server`(一定装,TCP 数据库服务)、`chusql-web`(选了 Web 才有)、`csql`(选了 cli 才有) |
| `~/.local/share/chusql/static/` | Web 前端静态资源(选 Web 才有) |
| `~/.local/share/chusql/csql-web`、`csql-web.sh` | 启动器与命令入口(选 Web 才有;cli 则是 `csql`) |
| `~/.local/share/chusql/init.sql` | 初始化脚本 |
| `~/.local/share/chusql/logs/` | 日志 |
| `~/.local/share/chusql/data/` | 数据目录(Windows 是 `%LOCALAPPDATA%\ChuSQL\data`;可在 `[storage] data_dir` 改) |
| `~/.config/ChuSQL/chusql.toml` | 全局配置(Windows:`%APPDATA%\ChuSQL\chusql.toml`) |
| `~/.profile` | 追加一段 `# ChuSQL` 标记 + `PATH` 输出(Windows 改的是用户级 PATH) |
装完开新终端:
csql-web # 起 Web 前端,默认 http://127.0.0.1:7778
csql # 进命令行
chusql-server # 起 TCP 数据库服务,默认 127.0.0.1:7777(客户端连接方式见 commands.md)
口令留空时只有管理员能进。账号与权限见 [commands.md](commands.md),配置项见 [config.md](config.md)。
## 五、卸载
没有卸载脚本,手工三步(位置按上面的表):
rm -rf ~/.local/share/chusql # 程序与数据(数据另存过就只删程序目录)
rm -f ~/.config/ChuSQL/chusql.toml # 全局配置
# 再编辑 ~/.profile,删掉 "# ChuSQL" 那三行
Windows:删 `%LOCALAPPDATA%\ChuSQL` 与 `%APPDATA%\ChuSQL\chusql.toml`,再到「环境变量」里把安装目录
从用户 PATH 移除。
+52
View File
@@ -0,0 +1,52 @@
# 架构与组件
ChuSQL 采用客户端 / 服务端架构。数据库文件仅由 `chusql-server` 直接访问,其他组件通过网络接口与数据库服务通信。
## 主要组件
| 组件 | 作用 |
| --- | --- |
| `chusql-server` | 数据库服务,负责 SQL 执行、权限检查、事务与数据访问 |
| `chusql-web` | Web 管理端,通过数据库服务访问数据 |
| `csql` | 命令行客户端,通过数据库服务执行 SQL |
| `chusql-core/engine` | SQL 解析、语义检查、优化与执行 |
| `chusql-core/storage` | 页面、索引、日志与持久化存储 |
## 数据流
典型访问路径为:
```text
Web / CLI / 其他客户端
↓
TCP
↓
chusql-server
↓
SQL 引擎与存储层
↓
磁盘
```
所有 SQL 和权限检查均由数据库服务统一处理。Web 和 CLI 不直接访问数据目录,因此多个客户端可以同时连接同一数据库服务。
## 数据目录
数据保存在 `[storage] data_dir` 指定的位置,主要包含:
| 目录 | 内容 |
| --- | --- |
| `system/` | 系统数据库,包括账号和权限等系统信息 |
| `databases/<数据库名>/` | 用户创建的数据库 |
安装完成后只有系统数据库,不自动创建业务数据库。业务数据库需通过 `CREATE DATABASE` 创建。
## 数据库服务
`chusql-server` 默认监听 `127.0.0.1:7777`,客户端建立连接后完成登录、数据库选择和 SQL 执行。
每条连接拥有独立会话状态,例如当前数据库选择不会影响其他连接。
系统数据库及部分管理操作仅允许管理员访问。
服务监听地址、端口和请求限制可在 `chusql.toml` 的 `[server]` 分区中配置。
+127
View File
@@ -0,0 +1,127 @@
# 命令与选项
ChuSQL 的主要用户命令如下:
| 命令 | 作用 |
| --- | --- |
| `chusql-server` | 启动数据库服务 |
| `chusql-web` | 启动 Web 管理端 |
| `csql` | 启动命令行客户端 |
| `csql-web` | 按配置启动 Web 管理端 |
各组件默认使用同一份 `chusql.toml`。需要临时使用其他配置时,可通过 `--config FILE` 指定。
## csql
基本用法:
```sh
csql [options]
```
常用选项:
| 选项 | 说明 |
| --- | --- |
| `-u, --user USER` | 指定登录账号 |
| `-d, --database DB` | 登录后选择数据库 |
| `-f, --format FORMAT` | 输出格式:`table`、`json` 或 `csv` |
| `-e, --execute SQL` | 执行一条 SQL 后退出 |
| `--history FILE` | 指定历史记录文件 |
| `--config FILE` | 指定配置文件 |
| `-h, --help` | 显示帮助 |
示例:
```sh
csql -d sales -e "SELECT * FROM orders LIMIT 5"
csql -f json -e "SELECT count(*) FROM orders"
```
### 交互模式
SQL 语句以分号结束,可跨多行输入。
常用元命令:
| 命令 | 作用 |
| --- | --- |
| `\q` | 退出 |
| `\?` | 查看帮助 |
| `\l` | 列出数据库 |
| `\dt` | 列出当前数据库中的表 |
| `\d <表>` | 查看表结构 |
| `\c <库>` | 切换数据库 |
| `\f <格式>` | 修改输出格式 |
| `\dr` | 查看角色与授权信息(管理员) |
## 账号与权限
默认管理员账号为 `root`。普通账号创建后默认不拥有数据访问权限,需要管理员通过角色进行授权。
常用账号命令:
```sql
CREATE USER alice IDENTIFIED BY 'password';
ALTER USER alice IDENTIFIED BY 'new-password';
DROP USER alice;
```
常用角色和授权命令:
```sql
CREATE ROLE analyst;
GRANT SELECT ON orders TO analyst;
GRANT analyst TO alice;
REVOKE SELECT ON orders FROM analyst;
REVOKE analyst FROM alice;
DROP ROLE analyst;
```
当前表级权限包括:`SELECT`、`INSERT`、`UPDATE`、`DELETE` 和 `ALL`。
管理员拥有完整权限;数据库、表、索引等结构管理操作仅允许管理员执行。
系统数据库 `system` 仅允许管理员访问。
## chusql-web
基本用法:
```sh
chusql-web [options]
```
常用选项:
| 选项 | 说明 |
| --- | --- |
| `--host H` | 监听地址 |
| `--port N` | 监听端口 |
| `--static DIR` | 静态资源目录 |
| `--user NAME` | 管理员账号名 |
| `--config FILE` | 指定配置文件 |
| `-h, --help` | 显示帮助 |
其余请求大小、会话、登录限制、分页等参数通常通过 `chusql.toml` 配置即可。
## chusql-server
基本用法:
```sh
chusql-server [options]
```
常用选项:
| 选项 | 说明 |
| --- | --- |
| `--host H` | 数据库服务监听地址 |
| `--port N` | 数据库服务监听端口 |
| `--max-message N` | 单条请求大小上限 |
| `--max-rows N` | 单次查询返回行数上限 |
| `--config FILE` | 指定配置文件 |
| `-h, --help` | 显示帮助 |
`chusql-server` 是数据目录的唯一直接访问者。Web、CLI 及其他客户端均通过数据库服务访问数据。
+76
View File
@@ -0,0 +1,76 @@
# 配置选项
ChuSQL 使用统一配置文件 `chusql.toml`。默认位置:
| 平台 | 路径 |
| --- | --- |
| Windows | `%APPDATA%\ChuSQL\chusql.toml` |
| Linux / macOS | `$XDG_CONFIG_HOME/ChuSQL/chusql.toml`;未设置时为 `~/.config/ChuSQL/chusql.toml` |
`chusql-server`、`chusql-web` 和 `csql` 均可通过 `--config <path>` 临时指定其他配置文件。配置优先级为:**命令行参数 > 配置文件 > 内置默认值**。
## 存储配置
| 配置项 | 默认值 | 说明 |
| --- | --- | --- |
| `[page] size` | `4096` | 数据页大小(字节) |
| `[btree] order` | `4` | B+ 树阶数 |
| `[buffer] pool_size` | `1024` | 缓冲池页数 |
| `[storage] data_dir` | 平台默认数据目录 | 数据文件保存位置 |
| `[log] level` | `info` | 日志级别 |
数据目录仅由 `chusql-server` 访问。生产环境建议使用绝对路径。
## Web 配置
| 配置项 | 默认值 | 说明 |
| --- | --- | --- |
| `host` | `127.0.0.1` | Web 服务监听地址 |
| `port` | `7778` | Web 服务端口 |
| `static_dir` | `static` | 静态资源目录 |
| `user` | `root` | 管理员账号名 |
| `cookie_secure` | `false` | HTTPS 部署时应启用 |
| `body_limit` | `65536` | 请求体大小上限(字节) |
| `session_idle` | `28800` | 会话空闲超时(秒) |
| `session_max` | `86400` | 会话最大存活时间(秒) |
| `login_max_attempts` | `5` | 登录失败限制阈值 |
| `login_window` | `300` | 登录限制统计窗口(秒) |
| `rows_per_page` | `25` | 默认分页大小 |
| `max_page_size` | `500` | 最大分页大小 |
| `max_rows` | `1000` | 单次查询最大返回行数 |
| `max_sql_length` | `20000` | SQL 最大字符数 |
| `seed` | `false` | 空库时是否写入演示数据 |
| `password_min_length` | `12` | 普通账号最短口令长度 |
| `password_classes` | `2` | 口令至少包含的字符类别数 |
## Server 配置
| 配置项 | 默认值 | 说明 |
| --- | --- | --- |
| `host` | `127.0.0.1` | 数据库服务监听地址 |
| `port` | `7777` | 数据库服务端口 |
| `max_message` | `1048576` | 单条请求最大大小(字节) |
| `max_rows` | `1000` | 单次查询最大返回行数 |
修改 Server 相关配置后需要重启 `chusql-server`。
## 账号与安全
账号口令不保存在配置文件中,而保存在系统数据库中。管理员口令在安装或系统引导时设置,之后可通过 SQL 或 Web 管理界面修改。
系统目录未完成初始化时,`chusql-server` 将拒绝启动并提示运行 `csql-bootstrap`。
对外部署时建议:
- 数据库服务仅监听受控网络接口;
- Web 服务通过 HTTPS 或反向代理提供;
- HTTPS 环境启用 `cookie_secure`。
## 修改配置
配置可通过以下方式修改:
1. 直接编辑 `chusql.toml`;
2. 通过 Web 设置页面修改。
大多数配置在相关服务下次启动时生效。
+110
View File
@@ -0,0 +1,110 @@
# 安装与卸载
发行包已经包含编译后的程序,普通用户安装时无需安装 GHC 或 Rust 工具链。
## 在线安装
Linux / macOS:
```sh
curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web
```
Windows PowerShell:
```powershell
irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1"
& "$env:TEMP\install.ps1" -Component web
```
## 安装方式
ChuSQL 支持三种安装方式:
| 方式 | 适用场景 |
| --- | --- |
| 在线安装 | 有网络,希望安装发行版本 |
| 包内安装 | 已下载发行包,或处于离线环境 |
| 源码安装 | 当前平台没有发行包,或需要自行修改源码 |
安装时可以选择 Web 管理端、命令行客户端,或同时安装两者。数据库服务及核心组件会按需安装。
安装过程中必须为管理员账号设置口令。口令不会以明文写入配置文件。
完成系统目录初始化后,安装程序默认会启动 `chusql-server`;如不希望自动启动,可使用 `--no-start`(Windows 为 `-NoStart`)。
## 包内安装
解压发行包后,在包根目录执行:
```sh
./install.sh --component web
```
Windows:
```powershell
.\install.ps1 -Component web
```
## 常用安装选项
| Linux / macOS | Windows | 说明 |
| --- | --- | --- |
| `--component web\|cli\|both` | `-Component` | 选择安装组件 |
| `--install-dir DIR` | `-InstallDir` | 指定安装目录 |
| `--data-dir DIR` | `-DataDir` | 指定数据目录 |
| `--user NAME` | `-RootUser` | 指定管理员账号名 |
| `--no-start` | `-NoStart` | 安装后不自动启动服务 |
| `--version TAG` | `-Version` | 指定发行版本 |
| `--list-versions` | `-ListVersions` | 列出可安装版本 |
| `--from-source` | — | 从源码构建并安装 |
自动化安装时建议通过环境变量提供管理员口令,避免口令出现在 shell 历史中。
## 从源码安装
源码安装需要 `git`、`cargo`、`stack` 和 `ghc`;部分 Linux 环境还需要 zlib 开发包。
```sh
./install.sh --component web --from-source
```
源码构建完成后的配置、初始化和启动流程与发行包安装一致。
## 安装完成后
默认安装包含以下主要内容:
- `chusql-server`:数据库服务;
- `csql`:命令行客户端;
- `chusql-web`:Web 管理端;
- `csql-bootstrap`:系统目录初始化工具;
- `chusql.toml`:全局配置文件;
- 数据目录与日志目录。
常用命令:
```sh
chusql-server
csql
csql-web
```
管理员使用安装时设置的口令登录。
## 卸载
Linux / macOS:
```sh
./uninstall.sh --yes
```
Windows:
```powershell
.\uninstall.ps1 -Yes
```
如需保留数据,可使用 `--keep-data`(Windows 为 `-KeepData`);如需保留配置,可使用 `--keep-config`(Windows 为 `-KeepConfig`)。
+3 -3
View File
@@ -3,7 +3,7 @@
# 整条链路共用这一份文件,按分区各管各的,互不影响:
# 数据库服务:[server](TCP 监听地址、端口、单行上限、单次结果行数上限)
# —— 只有它装入 chusql_core_storage 动态库并独占数据目录
# Web / 命令行:[web](账号口令、会话、分页上限、静态目录),都经 [server] 走
# Web / 命令行:[web](账号名、会话、分页上限、静态目录),都经 [server] 走
# 数据目录在 [storage] data_dir;这一行是安装时会替换的占位:
# 不写就按平台惯例(Windows %LOCALAPPDATA%\ChuSQL\data,
# Unix ${XDG_DATA_HOME:-$HOME/.local/share}/chusql/data)。
@@ -41,9 +41,9 @@ level = "info"
host = "127.0.0.1"
port = 7778
static_dir = "static"
# 管理员账号与口令。口令留空表示"只允许管理员免密登录",普通账号一律不能登录。
# 管理员账号名。口令存在系统表 __system_users 里,不写进这份文件;
# 首启为空口令,登录后用 ALTER USER 或在 Web 账号页设置。
user = "root"
password = ""
# 会话与登录限流
session_idle = 28800
session_max = 86400
-16
View File
@@ -1,16 +0,0 @@
-- ChuSQL 系统库 schema。
--
-- 系统库(system)不存在就自动建,里面的表都是系统表;这份脚本是它们唯一的定义,
-- 存储进程启动时按它声明表结构(见 chusql-core/storage/src/initsql.rs)。
-- 这里只描述"应该长什么样",不包含任何历史数据搬迁。
CREATE TABLE __chusql_users (
id int NOT NULL AUTO_INCREMENT PRIMARY KEY,
user varchar(64) NOT NULL UNIQUE,
password_hash varchar(256) NOT NULL,
registered_at timestamp NOT NULL,
last_login_at timestamp,
revision int NOT NULL
);
CREATE INDEX __chusql_users (user);
+78 -22
View File
@@ -4,18 +4,19 @@ param(
[string]$InstallDir = '',
[string]$DataDir = '',
[string]$RootUser = 'root',
[string]$RootPassword = '',
[string]$Password = '',
[string]$Version = 'latest',
[string]$Repo = 'TheBadRoger/ChuSQL',
[switch]$ListVersions,
[switch]$Interactive,
[switch]$KeepPackage
[switch]$KeepPackage,
[switch]$NoStart
)
$ErrorActionPreference = 'Stop'
# Windows 安装脚本:从包内或 GitHub 发行版装 cli/web,
# 写全局配置、改用户 PATH,装完删除安装包。
# Windows 安装脚本:装 cli/web、写全局配置、改用户 PATH、
# 跑 csql-bootstrap 建系统目录、最后拉起服务。
$script:tempDir = ''
@@ -131,13 +132,18 @@ function Ask-YesNo([string]$prompt, [bool]$defaultYes) {
}
}
# 读取隐藏输入的密码。
# 读口令:终端里不回显;-Interactive 时从 stdin 逐行读。
function Ask-Secret([string]$prompt) {
if ($askFromStdin) { return (Ask-Line $prompt) }
if ($askFromStdin) {
Write-Host $prompt -NoNewline
$line = [Console]::In.ReadLine()
if ($null -eq $line) { return '' }
return $line
}
$secure = Read-Host $prompt -AsSecureString
$bstr = [System.Runtime.InteropServices.Marshal]::SecureStringToBSTR($secure)
try { return [System.Runtime.InteropServices.Marshal]::PtrToStringBSTR($bstr) }
finally { [System.Runtime.InteropServices.Marshal]::ZeroFreeBSTR($bstr) }
$ptr = [System.Runtime.InteropServices.Marshal]::SecureStringToBSTR($secure)
try { return [System.Runtime.InteropServices.Marshal]::PtrToStringBSTR($ptr) }
finally { [System.Runtime.InteropServices.Marshal]::ZeroFreeBSTR($ptr) }
}
$wantWeb = $false
@@ -159,18 +165,30 @@ if (-not $Component) {
}
}
if (-not $PSBoundParameters.ContainsKey('RootPassword') -and $canPrompt) {
# 管理员口令是装机必答项:交互时当场设,非交互时给 -Password 或
# CHUSQL_ADMIN_PASSWORD。口令只经 stdin 传给 csql-bootstrap,不落 chusql.toml。
$adminPassword = "$env:CHUSQL_ADMIN_PASSWORD"
if ($Password) { $adminPassword = $Password }
if ($canPrompt) {
Write-Host ''
Write-Host ('The administrator account is "{0}".' -f $RootUser)
$firstPassword = Ask-Secret ('Root password for {0} (empty means no password) []:' -f $RootUser)
if ($firstPassword) {
$againPassword = Ask-Secret 'Repeat the root password:'
if ($firstPassword -ne $againPassword) { Fail 'the two passwords do not match' }
Write-Host 'root password set'
} else {
Write-Host 'no root password: administrator-only sign-in'
while ($true) {
$first = Ask-Secret ' Password: '
if ($first.Length -eq 0) {
Write-Host ' the password cannot be empty'
continue
}
$second = Ask-Secret ' Repeat it: '
if ($first -ne $second) {
Write-Host ' the two entries differ, try again'
continue
}
$adminPassword = $first
break
}
$RootPassword = $firstPassword
}
if ($adminPassword.Length -eq 0) {
Fail 'no administrator password: pass -Password or set CHUSQL_ADMIN_PASSWORD'
}
$wanted = @()
@@ -263,6 +281,7 @@ if (-not (Test-Path (Join-Path $pack 'bin\chusql_core_storage.dll'))) {
$storageLib = Join-Path $pack 'bin\chusql_core_storage.dll'
if (-not (Test-Path $storageLib)) { Fail "package is incomplete: bin\chusql_core_storage.dll not found in $pack" }
if (-not (Test-Path (Join-Path $pack 'bin\chusql-server.exe'))) { Fail 'package is incomplete: bin\chusql-server.exe not found' }
if (-not (Test-Path (Join-Path $pack 'bin\csql-bootstrap.exe'))) { Fail 'package is incomplete: bin\csql-bootstrap.exe not found' }
if ($wantWeb) {
if (-not (Test-Path (Join-Path $pack 'bin\chusql-web.exe'))) { Fail 'package is incomplete: bin\chusql-web.exe not found' }
if (-not (Test-Path (Join-Path $pack 'static'))) { Fail 'package is incomplete: static\ not found' }
@@ -279,7 +298,7 @@ Say (" components {0}" -f $componentLabel)
if ($downloaded) { Say (" release {0}" -f $Version) }
Say (" install to {0}" -f $InstallDir)
Say (" data dir {0}" -f $DataDir)
Say (" root user {0}{1}" -f $RootUser, $(if ($RootPassword) { '' } else { ' (no password: administrator-only sign-in)' }))
Say (" root user {0} (password asked above, kept out of chusql.toml)" -f $RootUser)
# ---- 释放文件 ----
# 包是合在一起的(web 和 cli 都在),这里按这次的选择逐个释放:没选的组件不落地
@@ -287,6 +306,7 @@ Step 'Installing files'
New-Item -ItemType Directory -Force -Path (Join-Path $InstallDir 'bin'), (Join-Path $InstallDir 'logs'), $DataDir | Out-Null
Copy-Item $storageLib (Join-Path $InstallDir 'bin') -Force
Copy-Item (Join-Path $pack 'bin\chusql-server.exe') (Join-Path $InstallDir 'bin') -Force
Copy-Item (Join-Path $pack 'bin\csql-bootstrap.exe') (Join-Path $InstallDir 'bin') -Force
Get-ChildItem (Join-Path $pack 'bin') -Filter '*.dll' -File -ErrorAction SilentlyContinue |
ForEach-Object { Copy-Item $_.FullName (Join-Path $InstallDir 'bin') -Force }
if ($wantCli) {
@@ -310,12 +330,22 @@ $configDir = if ($env:APPDATA) { Join-Path $env:APPDATA 'ChuSQL' } else { Join-P
$configFile = Join-Path $configDir 'chusql.toml'
$toml = Get-Content -Path $template -Raw -Encoding UTF8
$toml = $toml -replace '(?m)^(\s*user\s*=\s*).*$', "`$1`"$RootUser`""
$toml = $toml -replace '(?m)^(\s*password\s*=\s*).*$', "`$1`"$RootPassword`""
$toml = $toml -replace '(?m)^(\s*data_dir\s*=\s*).*$', "`$1`"$($DataDir -replace '\\', '/')`""
New-Item -ItemType Directory -Force -Path $configDir | Out-Null
Set-Content -Path $configFile -Value $toml -Encoding UTF8
Say (" config file {0}" -f $configFile)
Copy-Item (Join-Path $pack 'scripts\init.sql') $InstallDir -Force -ErrorAction SilentlyContinue
# ---- 引导系统目录 ----
# csql-bootstrap 建 system 数据库和 __system_users 表,口令只走 stdin,不进 chusql.toml
Step 'Creating the system catalog'
$bootstrap = Join-Path $InstallDir 'bin\csql-bootstrap.exe'
$bootstrapArgs = @('--config', $configFile, '--user', $RootUser)
$bootstrapArgs += '--password-stdin'
$bootstrapOutput = $adminPassword | & $bootstrap @bootstrapArgs 2>&1
$bootstrapOutput | ForEach-Object { Say (" {0}" -f $_) }
if ($LASTEXITCODE -ne 0) {
Fail ("the bootstrap program failed (exit {0}); the system catalog is not ready" -f $LASTEXITCODE)
}
# ---- 命令入口 ----
Step 'Creating commands'
@@ -365,6 +395,27 @@ if (-not $KeepPackage) {
Say ("kept the downloaded package: {0}" -f $tempDir)
}
Step 'Starting the server'
$serverPath = Join-Path $InstallDir 'bin\chusql-server.exe'
$serverPid = 0
if ($NoStart) {
Say ' -NoStart: the server was not started'
} else {
$serverLog = Join-Path $InstallDir 'logs\server.err.log'
$serverProc = Start-Process -FilePath $serverPath `
-ArgumentList @('--config', $configFile) `
-WorkingDirectory $InstallDir -WindowStyle Hidden -PassThru `
-RedirectStandardOutput (Join-Path $InstallDir 'logs\server.log') `
-RedirectStandardError $serverLog
Start-Sleep -Milliseconds 1200
if ($serverProc.HasExited) {
Fail ("the server stopped right away (exit {0}); look at {1}" -f $serverProc.ExitCode, $serverLog)
}
$serverPid = $serverProc.Id
Say (" server running, pid {0}" -f $serverPid)
Say (" log {0}" -f $serverLog)
}
Step 'Done'
Say (" chusql.toml {0}" -f $configFile)
Say (" data {0}" -f $DataDir)
@@ -372,4 +423,9 @@ $startWith = @()
if ($wantWeb) { $startWith += 'csql-web' }
if ($wantCli) { $startWith += 'csql' }
Say (" start with {0}" -f ($startWith -join ', '))
Say (" tcp server {0} (listens on [server] host/port, defaults 127.0.0.1:7777)" -f (Join-Path $InstallDir 'bin\chusql-server.exe'))
Say (" tcp server {0} (listens on [server] host/port, defaults 127.0.0.1:7777)" -f $serverPath)
if ($serverPid -gt 0) {
Say (" running pid {0} (stop it with: Stop-Process -Id {0})" -f $serverPid)
} else {
Say (" start it {0} --config `"{1}`"" -f $serverPath, $configFile)
}
+106 -49
View File
@@ -1,8 +1,8 @@
#!/bin/sh
set -eu
# ChuSQL 安装脚本(Linux/macOS):从包内、发行版或源码装 cli/web,
# 写全局配置、改 PATH,装完删除安装包。
# ChuSQL 安装脚本(Linux/macOS):装 cli/web、写全局配置、
# 改 PATH、跑 csql-bootstrap 建系统目录、最后拉起服务。
default_repo='TheBadRoger/ChuSQL'
@@ -28,16 +28,20 @@ usage: ./install.sh [--component web|cli|both] [options]
asks (English, y/n), command line client first:
command line client (csql)? default yes [Y/n]
web front end (browser UI)? default no [y/N]
it then asks whether to give the administrator account a
password (default no); that password goes straight into the
system catalog and is never written to chusql.toml
--interactive ask even when there is no terminal; the answers are
read from stdin (one per line)
--install-dir DIR where to install (default: $HOME/.local/share/chusql)
--data-dir DIR where to keep data (default: <install-dir>/data)
--user NAME administrator name (default: root)
--password PW administrator password, empty means no password
(administrator-only sign-in). Leave it out and the
installer asks for it, twice, with the echo off.
--keep-package do not delete the downloaded/extracted package
--password VALUE password of the administrator account (required when
there is no terminal to ask on; shows up in the shell
history, so CHUSQL_ADMIN_PASSWORD is safer)
--no-start do not start the server after installing
where the files come from:
(default) a package next to this script, else the newest GitHub release
@@ -51,6 +55,8 @@ where the files come from:
-h, --help this text
environment:
CHUSQL_ADMIN_PASSWORD password of the administrator account, same as
--password
CHUSQL_GITHUB_BASE GitHub base URL: GitHub Enterprise, a mirror, or a
local test fixture (default: https://github.com)
CHUSQL_GITHUB_TOKEN token for the version API (or GITHUB_TOKEN); without
@@ -62,8 +68,9 @@ component=''
install_dir=''
data_dir=''
root_user='root'
root_password=''
keep_package='no'
password_arg=''
no_start='no'
repo="$default_repo"
version='latest'
url_arg=''
@@ -71,7 +78,6 @@ from_source='no'
source_dir=''
list_versions='no'
interactive_flag='no'
password_given='no'
want_web='no'
want_cli='no'
@@ -81,8 +87,9 @@ while [ $# -gt 0 ]; do
--install-dir) install_dir="${2:-}"; shift 2 ;;
--data-dir) data_dir="${2:-}"; shift 2 ;;
--user) root_user="${2:-}"; shift 2 ;;
--password) root_password="${2:-}"; password_given='yes'; shift 2 ;;
--keep-package) keep_package='yes'; shift ;;
--password) password_arg="${2:-}"; shift 2 ;;
--no-start) no_start='yes'; shift ;;
--url) url_arg="${2:-}"; shift 2 ;;
--repo) repo="${2:-}"; shift 2 ;;
--version) version="${2:-}"; shift 2 ;;
@@ -148,27 +155,6 @@ read_line() { # -> $line(读到空行也算成功)
fi
}
read_secret() { # read_secret PROMPT -> 值写到 stdout(提示和换行都走 stderr,回显关掉)
printf '%s' "$1" >&2
if [ "$answers" = 'stdin' ]; then
IFS= read -r secret_line || secret_line=''
else
saved=''
if command -v stty >/dev/null 2>&1; then
saved=$(stty -g < "$answers" 2>/dev/null) || saved=''
stty -echo < "$answers" 2>/dev/null || true
fi
IFS= read -r secret_line < "$answers" || secret_line=''
if [ -n "$saved" ]; then
stty "$saved" < "$answers" 2>/dev/null || true
elif command -v stty >/dev/null 2>&1; then
stty echo < "$answers" 2>/dev/null || true
fi
fi
printf '\n' >&2
printf '%s' "$secret_line"
}
ask_yes_no() { # ask_yes_no PROMPT DEFAULT(y|n) -> $reply = yes|no
while :; do
printf '%s ' "$1" >&2
@@ -183,6 +169,24 @@ ask_yes_no() { # ask_yes_no PROMPT DEFAULT(y|n) -> $reply = yes|no
done
}
# 读一行口令 -> $line;从终端读时关掉回显(-interactive 从 stdin 读,没法关)。
read_secret() {
if [ "$answers" = 'stdin' ]; then
read_line
return 0
fi
_saved=$(stty -g < "$answers" 2>/dev/null) || _saved=''
stty -echo < "$answers" 2>/dev/null || true
read_line
if [ -n "$_saved" ]; then
stty "$_saved" < "$answers" 2>/dev/null || true
else
stty echo < "$answers" 2>/dev/null || true
fi
printf '\n' >&2
return 0
}
if [ "$component" = '' ] && [ "$list_versions" = 'no' ]; then
if [ "$can_prompt" = 'no' ]; then
fail '--component is required (web, cli or both) when there is no terminal to ask on'
@@ -198,18 +202,36 @@ if [ "$component" = '' ] && [ "$list_versions" = 'no' ]; then
fi
fi
if [ "$list_versions" = 'no' ] && [ "$password_given" = 'no' ] && [ "$can_prompt" = 'yes' ]; then
echo
echo "The administrator account is $root_user."
first=$(read_secret "Root password for $root_user (empty means no password) []: ")
if [ -n "$first" ]; then
again=$(read_secret 'Repeat the root password: ')
[ "$first" = "$again" ] || fail 'the two passwords do not match'
echo 'root password set' >&2
else
echo 'no root password: administrator-only sign-in' >&2
# 管理员口令是装机必答项:交互时当场设,非交互时给 --password 或
# CHUSQL_ADMIN_PASSWORD。口令只经 stdin 传给 csql-bootstrap,不落 chusql.toml。
admin_password="${CHUSQL_ADMIN_PASSWORD:-}"
if [ "$list_versions" = 'no' ]; then
if [ -n "$password_arg" ]; then
admin_password="$password_arg"
fi
if [ "$can_prompt" = 'yes' ]; then
echo
echo "The administrator account is $root_user."
while :; do
printf ' Password: ' >&2
read_secret
admin_password="$line"
if [ -z "$admin_password" ]; then
echo ' the password cannot be empty' >&2
continue
fi
printf ' Repeat it: ' >&2
read_secret
if [ "$line" != "$admin_password" ]; then
echo ' the two entries differ, try again' >&2
continue
fi
break
done
fi
if [ -z "$admin_password" ]; then
fail 'no administrator password: pass --password PASSWORD or set CHUSQL_ADMIN_PASSWORD'
fi
root_password="$first"
fi
# 选中的组件:空格分隔的清单,外加一个显示名(cli 或 web,两个就是 cli+web)
@@ -484,7 +506,7 @@ if [ "$from_source" = 'yes' ]; then
pack="$tmp/stage"
mkdir -p "$pack/bin" "$pack/scripts"
cp "$storage_lib" "$pack/bin/"
cp "$src/scripts/chusql.toml" "$src/scripts/init.sql" "$pack/scripts/"
cp "$src/scripts/chusql.toml" "$pack/scripts/"
cp "$src/scripts/install.sh" "$pack/"
for comp in $wanted; do
if [ "$comp" = 'web' ]; then
@@ -518,6 +540,14 @@ if [ "$from_source" = 'yes' ]; then
[ -n "$server_root" ] || fail 'cannot ask stack for --local-install-root'
[ -f "$server_root/bin/chusql-server" ] || fail "chusql-server not found after the build: $server_root/bin/chusql-server"
cp "$server_root/bin/chusql-server" "$pack/bin/"
# 引导程序独立成工程:建 system 目录不依赖服务本身,坏了还能单独重跑
step 'Building the bootstrap program (stack build --fast chusql-bootstrap:exe:csql-bootstrap)'
( cd "$src/chusql-bootstrap" && stack build --fast chusql-bootstrap:exe:csql-bootstrap ) || fail 'stack build failed in chusql-bootstrap'
bootstrap_root=$( cd "$src/chusql-bootstrap" && stack path --local-install-root 2>/dev/null | tr -d '\r' )
[ -n "$bootstrap_root" ] || fail 'cannot ask stack for --local-install-root'
[ -f "$bootstrap_root/bin/csql-bootstrap" ] || fail "csql-bootstrap not found after the build: $bootstrap_root/bin/csql-bootstrap"
cp "$bootstrap_root/bin/csql-bootstrap" "$pack/bin/"
elif [ -n "$url_arg" ]; then
# ---------- 指定 URL / 本地归档 ----------
new_tmp
@@ -567,6 +597,7 @@ fi
# ---- 校验包内容 ----
ls "$pack/bin/"libchusql_core_storage.* >/dev/null 2>&1 || fail "package is incomplete: bin/libchusql_core_storage.* not found in $pack"
[ -f "$pack/bin/chusql-server" ] || fail "package is incomplete: bin/chusql-server not found in $pack"
[ -f "$pack/bin/csql-bootstrap" ] || fail "package is incomplete: bin/csql-bootstrap not found in $pack"
if [ "$want_web" = 'yes' ]; then
[ -f "$pack/bin/chusql-web" ] || fail 'package is incomplete: bin/chusql-web not found'
[ -d "$pack/static" ] || fail 'package is incomplete: static/ not found'
@@ -581,17 +612,14 @@ echo " version $version"
echo " components $component_label"
echo " install to $install_dir"
echo " data dir $data_dir"
if [ -n "$root_password" ]; then
echo " root user $root_user"
else
echo " root user $root_user (no password: administrator-only sign-in)"
fi
echo " root user $root_user (password asked above, kept out of chusql.toml)"
# ---- 释放文件 ----
# 包是合在一起的(web 和 cli 都在),这里按这次的选择逐个释放:没选的组件不落地
step 'Installing files'
mkdir -p "$install_dir/bin" "$install_dir/logs" "$data_dir"
cp "$pack/bin/chusql-server" "$install_dir/bin/"
cp "$pack/bin/csql-bootstrap" "$install_dir/bin/"
for lib in "$pack/bin/"libchusql_core_storage.*; do
if [ -f "$lib" ]; then cp "$lib" "$install_dir/bin/"; fi
done
@@ -618,11 +646,17 @@ config_dir="${XDG_CONFIG_HOME:-$HOME/.config}/ChuSQL"
config_file="$config_dir/chusql.toml"
mkdir -p "$config_dir"
sed -e "s|^\(user[[:space:]]*=[[:space:]]*\).*|\1\"$root_user\"|" \
-e "s|^\(password[[:space:]]*=[[:space:]]*\).*|\1\"$root_password\"|" \
-e "s|^\(data_dir[[:space:]]*=[[:space:]]*\).*|\1\"$data_dir\"|" \
"$pack/scripts/chusql.toml" > "$config_file"
echo " config file $config_file"
if [ -f "$pack/scripts/init.sql" ]; then cp "$pack/scripts/init.sql" "$install_dir/"; fi
# ---- 引导系统目录 ----
# csql-bootstrap 建 system 数据库和 __system_users 表;口令只走 stdin,不进 chusql.toml
step 'Creating the system catalog'
bootstrap="$install_dir/bin/csql-bootstrap"
[ -n "$admin_password" ] || fail 'the administrator password is required'
printf '%s\n' "$admin_password" | "$bootstrap" --config "$config_file" --user "$root_user" --password-stdin ||
fail 'the bootstrap program failed; the system catalog is not ready'
# ---- 命令入口 ----
step 'Creating commands'
@@ -676,6 +710,24 @@ else
echo " package kept at $pack"
fi
# ---- 拉起服务 ----
server_bin="$install_dir/bin/chusql-server"
server_pid=''
if [ "$no_start" = 'yes' ]; then
note '--no-start: the server was not started'
else
step 'Starting the server'
mkdir -p "$install_dir/logs"
nohup "$server_bin" --config "$config_file" > "$install_dir/logs/server.log" 2> "$install_dir/logs/server.err.log" &
server_pid=$!
sleep 1
if ! kill -0 "$server_pid" 2>/dev/null; then
fail "the server stopped right away; look at $install_dir/logs/server.err.log"
fi
note "server running, pid $server_pid"
note "log $install_dir/logs/server.err.log"
fi
step 'Done'
echo " chusql.toml $config_file"
echo " data $data_dir"
@@ -685,4 +737,9 @@ if [ "$want_cli" = 'yes' ]; then
if [ -n "$start_with" ]; then start_with="$start_with, csql"; else start_with='csql'; fi
fi
echo " start with $start_with"
echo " tcp server $install_dir/bin/chusql-server (listens on [server] host/port, defaults 127.0.0.1:7777)"
echo " tcp server $server_bin (listens on [server] host/port, defaults 127.0.0.1:7777)"
if [ -n "$server_pid" ]; then
echo " running pid $server_pid (stop it with: kill $server_pid)"
else
echo " start it $server_bin --config \"$config_file\""
fi
+29 -5
View File
@@ -49,11 +49,14 @@ function Assert-Stage([string]$stage) {
'bin\csql.exe',
'bin\chusql-web.exe',
'bin\chusql-server.exe',
'bin\csql-bootstrap.exe',
'static\index.html',
'csql-web.ps1',
'scripts\chusql.toml',
'install.ps1',
'install.sh'
'install.sh',
'uninstall.ps1',
'uninstall.sh'
)
foreach ($rel in $must) {
if (-not (Test-Path (Join-Path $stage $rel))) {
@@ -61,7 +64,7 @@ function Assert-Stage([string]$stage) {
}
}
# bin 里带 chusql 名字的文件只能是已知产物;改名前的残留或别的垃圾都算装配错误
$known = @('chusql_core_storage.dll', 'chusql-server.exe', 'chusql-web.exe')
$known = @('chusql_core_storage.dll', 'chusql-server.exe', 'chusql-web.exe', 'csql-bootstrap.exe')
$unknown = @(Get-ChildItem (Join-Path $stage 'bin') -Filter 'chusql*' -File -ErrorAction SilentlyContinue |
Where-Object { $known -notcontains $_.Name })
if ($unknown.Count -gt 0) {
@@ -91,7 +94,7 @@ function Test-Installed([string]$name, [string]$comp) {
$pwsh = Join-Path $PSHOME 'pwsh.exe'
if (-not (Test-Path $pwsh)) { $pwsh = 'powershell' }
& $pwsh -NoProfile -File (Join-Path $pkg 'install.ps1') -Component $comp -InstallDir $opt `
-DataDir $data -RootUser root -RootPassword package-check *>&1 | Out-File -FilePath $log -Encoding UTF8
-DataDir $data -RootUser root -Password 'verify-package' -NoStart *>&1 | Out-File -FilePath $log -Encoding UTF8
if ($LASTEXITCODE -ne 0) {
Get-Content $log | Select-Object -First 120 | Write-Host
Fail "$name`: installing the $comp part from the package failed (log above)"
@@ -100,7 +103,8 @@ function Test-Installed([string]$name, [string]$comp) {
$checks = @(
(Join-Path $opt 'bin\chusql_core_storage.dll'),
(Join-Path $opt 'bin\chusql-server.exe'),
(Join-Path $opt 'init.sql'),
(Join-Path $opt 'bin\csql-bootstrap.exe'),
(Join-Path $data 'system\catalog.json'),
(Join-Path $appdata 'ChuSQL\chusql.toml')
)
$forbidden = @()
@@ -162,6 +166,13 @@ if (-not $NoBuild) {
if ($LASTEXITCODE -ne 0) { Fail "stack build --fast $target failed" }
} finally { Pop-Location }
}
Step 'Building chusql-bootstrap:exe:csql-bootstrap (Haskell)'
Push-Location (Join-Path $repoRoot 'chusql-bootstrap')
try {
& stack build --fast chusql-bootstrap:exe:csql-bootstrap
if ($LASTEXITCODE -ne 0) { Fail 'stack build --fast csql-bootstrap failed' }
} finally { Pop-Location }
}
# ---------- 装配 + 打归档 ----------
@@ -194,13 +205,26 @@ try {
Copy-Item $front (Join-Path $stage 'bin')
}
# 引导程序住在自己的工程里,安装根也单独问它要
Push-Location (Join-Path $repoRoot 'chusql-bootstrap')
try { $bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim() } finally { Pop-Location }
$bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe'
if (-not (Test-Path $bootstrapExe)) {
$bootstrapExe = Get-ChildItem -Path (Join-Path $repoRoot 'chusql-bootstrap\.stack-work') `
-Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue |
Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
}
if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { Fail 'csql-bootstrap.exe is not built (run without -NoBuild)' }
Copy-Item $bootstrapExe (Join-Path $stage 'bin')
# 第三方 dll 才要连带上:名字带 chusql 的是本 crate 产物或改名前的残留,上面已按名拷过
Get-ChildItem (Join-Path $repoRoot 'chusql-core\storage\target\release') -Filter '*.dll' -File -ErrorAction SilentlyContinue |
Where-Object { $_.Name -notlike 'chusql*' } |
ForEach-Object { Copy-Item $_.FullName (Join-Path $stage 'bin') }
Copy-Item (Join-Path $repoRoot 'scripts\chusql.toml'), (Join-Path $repoRoot 'scripts\init.sql') (Join-Path $stage 'scripts')
Copy-Item (Join-Path $repoRoot 'scripts\chusql.toml') (Join-Path $stage 'scripts')
Copy-Item (Join-Path $repoRoot 'scripts\install.ps1'), (Join-Path $repoRoot 'scripts\install.sh') $stage
Copy-Item (Join-Path $repoRoot 'scripts\uninstall.ps1'), (Join-Path $repoRoot 'scripts\uninstall.sh') $stage
New-Item -ItemType Directory -Force -Path (Join-Path $stage 'static') | Out-Null
Copy-Item (Join-Path $repoRoot 'chusql-web\static\*') (Join-Path $stage 'static') -Recurse
Copy-Item (Join-Path $repoRoot 'scripts\csql-web.sh') $stage
+24 -7
View File
@@ -90,16 +90,19 @@ check_stage() {
[ -f "$stage/bin/csql" ] || Fail 'bin/csql is missing from the package'
[ -f "$stage/bin/chusql-web" ] || Fail 'bin/chusql-web is missing from the package'
[ -f "$stage/bin/chusql-server" ] || Fail 'bin/chusql-server is missing from the package'
[ -f "$stage/bin/csql-bootstrap" ] || Fail 'bin/csql-bootstrap is missing from the package'
[ -f "$stage/static/index.html" ] || Fail 'static/index.html is missing from the package'
[ -f "$stage/csql-web.sh" ] || Fail 'csql-web.sh is missing from the package'
[ -f "$stage/scripts/chusql.toml" ] || Fail 'scripts/chusql.toml is missing from the package'
[ -f "$stage/install.sh" ] || Fail 'install.sh is missing from the package'
[ -f "$stage/install.ps1" ] || Fail 'install.ps1 is missing from the package'
[ -f "$stage/uninstall.sh" ] || Fail 'uninstall.sh is missing from the package'
[ -f "$stage/uninstall.ps1" ] || Fail 'uninstall.ps1 is missing from the package'
# bin 里带 chusql 名字的文件只能是已知产物;改名前的残留或别的垃圾都算装配错误
for f in "$stage"/bin/chusql* "$stage"/bin/libchusql*; do
[ -e "$f" ] || continue
case "$(basename "$f")" in
libchusql_core_storage.so|libchusql_core_storage.dylib|libchusql_core_storage.dll|chusql-server|chusql-web) ;;
libchusql_core_storage.so|libchusql_core_storage.dylib|libchusql_core_storage.dll|chusql-server|chusql-web|csql-bootstrap) ;;
*) Fail "unexpected artifact in bin/: $(basename "$f")" ;;
esac
done
@@ -116,8 +119,10 @@ verify_package() {
rm -rf "$vtmp"
Fail "$name: the archive does not unpack"
fi
if ! ( cd "$vtmp/pkg" && HOME="$vtmp/home" sh install.sh --component "$comp" \
--install-dir "$vtmp/opt" --data-dir "$vtmp/data" --user root --password package-check ) \
if ! ( cd "$vtmp/pkg" && HOME="$vtmp/home" CHUSQL_ADMIN_PASSWORD='verify-package' \
sh install.sh --component "$comp" \
--install-dir "$vtmp/opt" --data-dir "$vtmp/data" --user root \
--no-start ) \
>"$vtmp/log" 2>&1; then
sed -n '1,120p' "$vtmp/log" >&2
rm -rf "$vtmp"
@@ -126,7 +131,8 @@ verify_package() {
ok=yes
ls "$vtmp/opt/bin/"libchusql_core_storage.* >/dev/null 2>&1 || ok=no
[ -f "$vtmp/opt/bin/chusql-server" ] || ok=no
[ -f "$vtmp/opt/init.sql" ] || ok=no
[ -f "$vtmp/opt/bin/csql-bootstrap" ] || ok=no
[ -f "$vtmp/data/system/catalog.json" ] || ok=no
[ -f "$vtmp/home/.config/ChuSQL/chusql.toml" ] || ok=no
grep -q "data_dir = \"$vtmp/data\"" "$vtmp/home/.config/ChuSQL/chusql.toml" || ok=no
if [ "$comp" = web ]; then
@@ -164,6 +170,8 @@ if [ "$build" = yes ]; then
( cd "$repo_root/chusql-cli" && stack build --fast chusql-cli:exe:csql )
Step 'Building the TCP database server (Haskell)'
( cd "$repo_root/chusql-cli" && stack build --fast chusql-server:exe:chusql-server )
Step 'Building the bootstrap program (Haskell)'
( cd "$repo_root/chusql-bootstrap" && stack build --fast chusql-bootstrap:exe:csql-bootstrap )
fi
# ---------- 装配 + 打归档 ----------
@@ -191,6 +199,15 @@ for front_name in chusql-web chusql-server csql; do
cp "$front" "$stage/bin/"
done
# 引导程序住在自己的工程里,安装根也单独问它要
bootstrap_root=$(cd "$repo_root/chusql-bootstrap" && stack path --local-install-root | tail -n 1 | tr -d '\r')
bootstrap_bin="$bootstrap_root/bin/csql-bootstrap"
if [ ! -f "$bootstrap_bin" ]; then
bootstrap_bin=$(find "$repo_root/chusql-bootstrap/.stack-work" -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true)
fi
[ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || Fail 'csql-bootstrap is not built (run without --no-build)'
cp "$bootstrap_bin" "$stage/bin/"
# Haskell 一般静态链接,靶目录里真有共享库就一起带上;改名前的旧库(libchusql_storage.*)不能进包
for lib in "$repo_root"/chusql-core/storage/target/release/*.so "$repo_root"/chusql-core/storage/target/release/*.dylib; do
[ -f "$lib" ] || continue
@@ -200,13 +217,13 @@ for lib in "$repo_root"/chusql-core/storage/target/release/*.so "$repo_root"/chu
cp "$lib" "$stage/bin/"
done
cp "$repo_root/scripts/chusql.toml" "$repo_root/scripts/init.sql" "$stage/scripts/"
cp "$repo_root/scripts/install.sh" "$repo_root/scripts/install.ps1" "$stage/"
cp "$repo_root/scripts/chusql.toml" "$stage/scripts/"
cp "$repo_root/scripts/install.sh" "$repo_root/scripts/install.ps1" "$repo_root/scripts/uninstall.sh" "$repo_root/scripts/uninstall.ps1" "$stage/"
mkdir -p "$stage/static"
cp -R "$repo_root"/chusql-web/static/. "$stage/static/"
cp "$repo_root/scripts/csql-web.sh" "$stage/"
if [ -f "$repo_root/scripts/csql-web.ps1" ]; then cp "$repo_root/scripts/csql-web.ps1" "$stage/"; fi
chmod +x "$stage/install.sh" "$stage/csql-web.sh"
chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh"
check_stage "$stage"
+102
View File
@@ -0,0 +1,102 @@
[CmdletBinding()]
param(
[string]$InstallDir = '',
[string]$DataDir = '',
[switch]$KeepData,
[switch]$KeepConfig,
[switch]$Yes
)
$ErrorActionPreference = 'Stop'
# Windows 卸载脚本:停服务、删程序与配置、从用户 PATH 摘掉安装目录。
# 数据目录默认一起删,-KeepData 保留。
# 打印步骤标题。
function Step([string]$msg) { Write-Host ''; Write-Host "==> $msg" -ForegroundColor Cyan }
# 打印一行输出。
function Say([string]$msg) { Write-Host $msg }
# 报错退出。
function Fail([string]$msg) { Write-Host "!! $msg" -ForegroundColor Red; exit 1 }
if (-not $InstallDir) { $InstallDir = Join-Path $env:LOCALAPPDATA 'ChuSQL' }
if (-not $DataDir) { $DataDir = Join-Path $InstallDir 'data' }
$InstallDir = [System.IO.Path]::GetFullPath($InstallDir)
$DataDir = [System.IO.Path]::GetFullPath($DataDir)
$configDir = if ($env:APPDATA) { Join-Path $env:APPDATA 'ChuSQL' } else { Join-Path $InstallDir 'config' }
$configFile = Join-Path $configDir 'chusql.toml'
if (-not $Yes) {
if ([Console]::IsInputRedirected) {
Fail 'no terminal: rerun with -Yes to confirm'
}
Say 'ChuSQL uninstaller'
Say (" install dir {0}" -f $InstallDir)
Say (" data dir {0}" -f $DataDir)
if ($KeepData) { Say ' data kept' }
$answer = (Read-Host 'Remove it? [y/N]').Trim()
if ($answer -notmatch '^(y|yes)$') {
Say 'nothing was removed'
exit 0
}
}
Step 'Stopping the service'
$running = @(Get-Process -Name 'chusql-server', 'chusql-web' -ErrorAction SilentlyContinue |
Where-Object {
try { $_.Path -and $_.Path.StartsWith($InstallDir, [StringComparison]::OrdinalIgnoreCase) }
catch { $false }
})
foreach ($proc in $running) {
Stop-Process -Id $proc.Id -Force -ErrorAction SilentlyContinue
Say (" stopped {0} (pid {1})" -f $proc.ProcessName, $proc.Id)
}
if ($running.Count -eq 0) { Say ' nothing was running' }
Step 'Removing files'
if (-not (Test-Path $InstallDir)) {
Say (" not found: {0}" -f $InstallDir)
} elseif ($KeepData) {
Get-ChildItem -LiteralPath $InstallDir -Force | ForEach-Object {
if ($_.FullName -eq $DataDir) {
Say (" kept data: {0}" -f $_.FullName)
} else {
Remove-Item -LiteralPath $_.FullName -Recurse -Force -ErrorAction SilentlyContinue
}
}
Say (" kept {0} (data only)" -f $InstallDir)
} else {
Remove-Item -LiteralPath $InstallDir -Recurse -Force
if (-not $DataDir.StartsWith($InstallDir, [StringComparison]::OrdinalIgnoreCase)) {
Remove-Item -LiteralPath $DataDir -Recurse -Force -ErrorAction SilentlyContinue
}
Say (" removed {0}" -f $InstallDir)
}
Step 'Removing chusql.toml'
if ($KeepConfig) {
Say (" kept config: {0}" -f $configFile)
} else {
if (Test-Path $configFile) {
Remove-Item -LiteralPath $configFile -Force
Say (" removed config: {0}" -f $configFile)
} else {
Say (" no config file: {0}" -f $configFile)
}
if (Test-Path $configDir) { Remove-Item -LiteralPath $configDir -Force -ErrorAction SilentlyContinue }
}
Step 'Removing the PATH entry'
$userPath = [Environment]::GetEnvironmentVariable('Path', 'User')
if (-not $userPath) { $userPath = '' }
$entries = @($userPath -split ';' | Where-Object { $_ })
$updated = @($entries | Where-Object { $_ -ne $InstallDir })
if ($updated.Count -ne $entries.Count) {
[Environment]::SetEnvironmentVariable('Path', ($updated -join ';'), 'User')
Say (" removed {0} from the user PATH" -f $InstallDir)
} else {
Say ' the user PATH has no install directory'
}
Step 'Done'
Say ' open a new terminal: the old PATH stays in the current one'
+148
View File
@@ -0,0 +1,148 @@
#!/bin/sh
set -eu
# ChuSQL 卸载脚本(Linux/macOS):停服务、删程序与配置、
# 从 .profile 摘掉 PATH 段。数据目录默认一起删。
install_dir=''
data_dir=''
keep_data='no'
keep_config='no'
assume_yes='no'
usage() {
cat <<'EOF'
Uninstall ChuSQL (Linux/macOS).
Usage: uninstall.sh [options]
--install-dir DIR program directory (default: $HOME/.local/share/chusql)
--data-dir DIR data directory (default: <install-dir>/data)
--keep-data keep the data directory, remove programs only
--keep-config keep chusql.toml
--yes do not ask (required when there is no terminal)
-h, --help show this help
EOF
}
step() { echo "== $1"; }
note() { echo " $1"; }
fail() {
echo "!! $1" >&2
exit 1
}
# 停掉命令行里带这个路径的进程
stop_by_path() {
target=$1
[ -n "$target" ] || return 0
pids=$(ps -eo pid=,args= 2>/dev/null |
awk -v t="$target" '{ pid = $1; $1 = ""; sub(/^ +/, ""); if (index($0, t) == 1) print pid }' || true)
[ -n "$pids" ] || return 0
for pid in $pids; do
kill "$pid" 2>/dev/null || true
done
note "stopped: $pids"
sleep 1
for pid in $pids; do
kill -9 "$pid" 2>/dev/null || true
done
}
# 问一句 y/n,不是 y 就当没同意
ask_yes_no() {
printf '%s ' "$1" >&2
answer=''
IFS= read -r answer || answer=''
case "$answer" in
y | Y | yes | YES | Yes) return 0 ;;
*) return 1 ;;
esac
}
while [ $# -gt 0 ]; do
case "$1" in
-h | --help) usage; exit 0 ;;
--install-dir) install_dir="${2:-}"; shift 2 ;;
--data-dir) data_dir="${2:-}"; shift 2 ;;
--keep-data) keep_data='yes'; shift ;;
--keep-config) keep_config='yes'; shift ;;
--yes) assume_yes='yes'; shift ;;
*) fail "unknown option: $1 (try --help)" ;;
esac
done
install_dir=${install_dir:-$HOME/.local/share/chusql}
data_dir=${data_dir:-$install_dir/data}
config_dir="${XDG_CONFIG_HOME:-$HOME/.config}/ChuSQL"
config_file="$config_dir/chusql.toml"
profile="$HOME/.profile"
if [ "$assume_yes" = 'no' ]; then
echo 'ChuSQL uninstaller'
echo " install dir $install_dir"
echo " data dir $data_dir"
if [ "$keep_data" = 'yes' ]; then echo ' data kept'; fi
if [ -t 0 ]; then
ask_yes_no 'Remove it? [y/N]' || {
echo 'nothing was removed'
exit 0
}
else
fail 'no terminal: rerun with --yes to confirm'
fi
fi
step 'Stopping the service'
stop_by_path "$install_dir/bin/chusql-server"
stop_by_path "$install_dir/bin/chusql-web"
step 'Removing files'
if [ ! -d "$install_dir" ]; then
note "not found: $install_dir"
elif [ "$keep_data" = 'yes' ]; then
for entry in "$install_dir"/*; do
[ -e "$entry" ] || continue
if [ "$entry" = "$data_dir" ]; then
note "kept data: $entry"
continue
fi
rm -rf "$entry"
done
note "kept $install_dir (data only)"
else
rm -rf "$install_dir"
case "$data_dir" in
"$install_dir" | "$install_dir"/*) ;;
*) rm -rf "$data_dir" ;;
esac
note "removed $install_dir"
fi
step 'Removing chusql.toml'
if [ "$keep_config" = 'yes' ]; then
note "kept config: $config_file"
else
rm -f "$config_file"
rmdir "$config_dir" 2>/dev/null || true
note "removed config: $config_file"
fi
step 'Removing the PATH entry'
marker='# ChuSQL'
if [ ! -f "$profile" ]; then
note "no $profile"
elif grep -q "^$marker" "$profile"; then
tmp="$profile.chusql-uninstall"
awk -v m="$marker" '
skip > 0 { skip--; next }
index($0, m) == 1 { skip = 2; next }
{ print }
' "$profile" >"$tmp" && mv "$tmp" "$profile"
note "removed the $marker block from $profile"
else
note "no $marker block in $profile"
fi
step 'Done'
note 'open a new terminal: the old PATH stays in the current one'