From a8e85b7ac087f651f7909aaa774989c6f9ad36ee Mon Sep 17 00:00:00 2001 From: LIm1tZz7 <36764786+TheBadRoger@users.noreply.github.com> Date: Sat, 3 Oct 2026 19:35:30 +0800 Subject: [PATCH] =?UTF-8?q?=E8=BD=AC=E6=8E=88=E6=9D=83?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- AGENTS.md | 2 +- chusql-cli/app/Repl.hs | 4 +- .../engine/src/ChuSQL/Core/Engine/Semantic.hs | 2 +- .../src/ChuSQL/Core/Engine/Syntax/AST.hs | 4 +- .../src/ChuSQL/Core/Engine/Syntax/Parser.hs | 6 +- chusql-core/engine/test/Spec.hs | 20 +++- chusql-core/storage/src/protocol.rs | 7 +- chusql-core/storage/tests/runtime_test.rs | 4 + .../src/ChuSQL/Interface/Actions.hs | 14 ++- .../src/ChuSQL/Interface/Protocol.hs | 10 +- chusql-server/src/ChuSQL/Server/Backend.hs | 7 +- chusql-server/src/ChuSQL/Server/Catalog.hs | 40 +++++-- chusql-server/src/ChuSQL/Server/Privileges.hs | 103 +++++++++++++++--- chusql-server/test/Spec.hs | 70 ++++++++++-- chusql-web/src/ChuSQL/Web/API.hs | 16 ++- chusql-web/test/Spec.hs | 27 +++++ docs/architecture.md | 2 +- docs/commands.md | 3 + 18 files changed, 284 insertions(+), 57 deletions(-) diff --git a/AGENTS.md b/AGENTS.md index 3b638ca..42bd2bb 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -28,5 +28,5 @@ - 改动说明只在交流中记录。 ## 当前重点 -- 主线已完成:高级优化器 → 并行查询 → M1 会话隔离 → M2 快照事务 → M3 WAL 与崩溃恢复 → M4 表结构进 WAL → M5 系统表统一命名 → M6 检查点按 LSN 部分截断 → M7 事务写写冲突检测 → M8 事务保存点 → M9 角色继承。 +- 主线已完成:高级优化器 → 并行查询 → M1 会话隔离 → M2 快照事务 → M3 WAL 与崩溃恢复 → M4 表结构进 WAL → M5 系统表统一命名 → M6 检查点按 LSN 部分截断 → M7 事务写写冲突检测 → M8 事务保存点 → M9 角色继承 → M10 转授权。 - 进度与计数见 `agent_credientials/project-plan.txt`,限制与风险见 `agent_credientials/known-issues.txt`。 diff --git a/chusql-cli/app/Repl.hs b/chusql-cli/app/Repl.hs index 2fc667a..eee1c7b 100644 --- a/chusql-cli/app/Repl.hs +++ b/chusql-cli/app/Repl.hs @@ -182,7 +182,9 @@ listRoles session = do , if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view) ] -- | 拼一条授权说明 - grantText grant = grantPrivilege grant <> " on " <> grantObject grant + grantText grant = grantPrivilege grant <> " on " <> grantObject grant <> optionText grant + -- | 带转授权时补一段说明 + optionText grant = if grantable grant then " with grant option" else "" -- | 用 show 转成 Text tshow :: Show a => a -> Text diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs index 1fef105..6f6d6ca 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs @@ -415,7 +415,7 @@ checkResolvedWith db outer q = case q of DropUser name -> checkUserName name CreateRole name -> checkRoleName name DropRole name -> checkRoleName name - GrantPrivileges privs obj role -> do + GrantPrivileges privs obj role _ -> do mapM_ checkPrivilege privs checkGrantObject obj checkRoleName role diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/AST.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/AST.hs index 1e5201f..20da5cf 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/AST.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/AST.hs @@ -41,8 +41,8 @@ data Statement | CreateRole String -- | 删角色:连同它的授权与成员一起删 | DropRole String - -- | GRANT 权限 ON 表 TO 角色 - | GrantPrivileges [String] String String + -- | GRANT 权限 ON 表 TO 角色,末位表示带 WITH GRANT OPTION + | GrantPrivileges [String] String String Bool -- | REVOKE 权限 ON 表 FROM 角色 | RevokePrivileges [String] String String -- | GRANT 角色 TO 用户:给用户加角色 diff --git a/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs b/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs index f6b38fc..c58a54e 100644 --- a/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs +++ b/chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs @@ -464,6 +464,10 @@ privilegeName = grantObject :: Parser String grantObject = ("*" <$ symbol "*") <|> tableName +-- | 可选的 WITH GRANT OPTION +grantOption :: Parser Bool +grantOption = (True <$ try (keyword "with" *> keyword "grant" *> keyword "option")) <|> pure False + -- | 读 GRANT:带 ON 的授权限,不带的加角色 grantStatement :: Parser Statement grantStatement = do @@ -474,7 +478,7 @@ grantStatement = do keyword "on" obj <- grantObject keyword "to" - GrantPrivileges privs obj <$> userName + GrantPrivileges privs obj <$> userName <*> grantOption , GrantRole <$> userName <*> (keyword "to" *> sepBy1 userName (symbol ",")) ] diff --git a/chusql-core/engine/test/Spec.hs b/chusql-core/engine/test/Spec.hs index 0dff7d5..8be38fb 100644 --- a/chusql-core/engine/test/Spec.hs +++ b/chusql-core/engine/test/Spec.hs @@ -683,13 +683,21 @@ main = hspec $ do it "parses privilege grants on one table, on another database's table or on everything" $ do parseStatement "GRANT SELECT ON users TO analyst" - `shouldBe` Right (GrantPrivileges ["SELECT"] "users" "analyst") + `shouldBe` Right (GrantPrivileges ["SELECT"] "users" "analyst" False) parseStatement "grant select, insert on users to analyst" - `shouldBe` Right (GrantPrivileges ["SELECT", "INSERT"] "users" "analyst") + `shouldBe` Right (GrantPrivileges ["SELECT", "INSERT"] "users" "analyst" False) parseStatement "GRANT ALL ON sales.orders TO analyst" - `shouldBe` Right (GrantPrivileges ["ALL"] "sales.orders" "analyst") + `shouldBe` Right (GrantPrivileges ["ALL"] "sales.orders" "analyst" False) parseStatement "GRANT DELETE ON * TO analyst" - `shouldBe` Right (GrantPrivileges ["DELETE"] "*" "analyst") + `shouldBe` Right (GrantPrivileges ["DELETE"] "*" "analyst" False) + + it "parses WITH GRANT OPTION on a privilege grant" $ do + parseStatement "GRANT SELECT ON users TO analyst WITH GRANT OPTION" + `shouldBe` Right (GrantPrivileges ["SELECT"] "users" "analyst" True) + parseStatement "grant select, insert on * to analyst with grant option" + `shouldBe` Right (GrantPrivileges ["SELECT", "INSERT"] "*" "analyst" True) + parseStatement "GRANT SELECT ON users TO analyst WITH" + `shouldSatisfy` isLeft it "parses REVOKE symmetrically" $ do parseStatement "REVOKE SELECT ON users FROM analyst" @@ -717,7 +725,9 @@ main = hspec $ do (parseStatement "CREATE ROLE select" >>= prepare testDB) `shouldSatisfy` isLeft (parseStatement "DROP ROLE insert" >>= prepare testDB) `shouldSatisfy` isLeft (parseStatement "GRANT SELECT ON users TO analyst" >>= prepare testDB) - `shouldBe` Right (GrantPrivileges ["SELECT"] "users" "analyst") + `shouldBe` Right (GrantPrivileges ["SELECT"] "users" "analyst" False) + (parseStatement "GRANT SELECT ON users TO analyst WITH GRANT OPTION" >>= prepare testDB) + `shouldBe` Right (GrantPrivileges ["SELECT"] "users" "analyst" True) (parseStatement "GRANT SELECT ON users TO select" >>= prepare testDB) `shouldSatisfy` isLeft (parseStatement "REVOKE SELECT ON users FROM analyst" >>= prepare testDB) `shouldBe` Right (RevokePrivileges ["SELECT"] "users" "analyst") diff --git a/chusql-core/storage/src/protocol.rs b/chusql-core/storage/src/protocol.rs index 0910dfc..4529d21 100644 --- a/chusql-core/storage/src/protocol.rs +++ b/chusql-core/storage/src/protocol.rs @@ -230,7 +230,12 @@ pub fn reserved_table(table: &str) -> bool { } /// 服务自己的角色与授权表名 -pub const PRIVILEGE_TABLES: [&str; 3] = ["__system_roles", "__system_grants", "__system_members"]; +pub const PRIVILEGE_TABLES: [&str; 4] = [ + "__system_roles", + "__system_grants", + "__system_grant_options", + "__system_members", +]; /// 是不是服务自己经请求通道读写的系统表 pub fn internal_table(table: &str) -> bool { diff --git a/chusql-core/storage/tests/runtime_test.rs b/chusql-core/storage/tests/runtime_test.rs index 86020a9..8d57231 100644 --- a/chusql-core/storage/tests/runtime_test.rs +++ b/chusql-core/storage/tests/runtime_test.rs @@ -1756,8 +1756,11 @@ fn privilege_tables_are_reachable_but_account_table_is_not() -> Result<(), Box Result<(), Box Text -> Text -> Either String String -grantPrivilegesSql privileges object role = do +grantPrivilegesSql :: [Text] -> Text -> Text -> Bool -> Either String String +grantPrivilegesSql privileges object role withOption = do words' <- privilegeWords privileges target <- grantObject object who <- roleName role - pure ("GRANT " ++ T.unpack (T.intercalate ", " words') ++ " ON " ++ T.unpack target ++ " TO " ++ T.unpack who) + pure + ( "GRANT " ++ T.unpack (T.intercalate ", " words') ++ " ON " ++ T.unpack target + ++ " TO " ++ T.unpack who ++ tailText + ) + where + -- | 转授权后缀 + tailText + | withOption = " WITH GRANT OPTION" + | otherwise = "" -- | 构造 REVOKE 权限 ON 对象 FROM 角色 revokePrivilegesSql :: [Text] -> Text -> Text -> Either String String diff --git a/chusql-interface/src/ChuSQL/Interface/Protocol.hs b/chusql-interface/src/ChuSQL/Interface/Protocol.hs index 83230d6..8471004 100644 --- a/chusql-interface/src/ChuSQL/Interface/Protocol.hs +++ b/chusql-interface/src/ChuSQL/Interface/Protocol.hs @@ -26,11 +26,12 @@ import qualified Data.Text as T -- server 线上协议的编解码:一行一条 JSON(UTF-8)。 --- | 一条角色授权:角色 + 具体权限 + 对象 +-- | 一条角色授权:角色 + 具体权限 + 对象,可带转授权 data Grant = Grant { grantRole :: Text , grantPrivilege :: Text , grantObject :: Text + , grantable :: Bool } deriving (Show, Eq, Ord) @@ -49,12 +50,17 @@ instance ToJSON Grant where [ "role" .= grantRole grant , "privilege" .= grantPrivilege grant , "object" .= grantObject grant + , "grantable" .= grantable grant ] -- | 从 JSON 读一条授权 instance FromJSON Grant where parseJSON = withObject "Grant" $ \o -> - Grant <$> o .: "role" <*> o .: "privilege" <*> o .: "object" + Grant + <$> o .: "role" + <*> o .: "privilege" + <*> o .: "object" + <*> o .:? "grantable" .!= False -- | 一个角色转成 JSON instance ToJSON RoleView where diff --git a/chusql-server/src/ChuSQL/Server/Backend.hs b/chusql-server/src/ChuSQL/Server/Backend.hs index a9ba9ab..a8aa8df 100644 --- a/chusql-server/src/ChuSQL/Server/Backend.hs +++ b/chusql-server/src/ChuSQL/Server/Backend.hs @@ -11,6 +11,7 @@ module ChuSQL.Server.Backend ( ipcBackend, memoryBackend, membersTable, + optionsTable, rolesTable, statementNeedsDatabase, statementTables, @@ -359,11 +360,15 @@ rolesTable = "__system_roles" grantsTable :: String grantsTable = "__system_grants" +-- | 带 grant option 的授权单独一张表 +optionsTable :: String +optionsTable = "__system_grant_options" + membersTable :: String membersTable = "__system_members" internalNames :: [String] -internalNames = [rolesTable, grantsTable, membersTable] +internalNames = [rolesTable, grantsTable, optionsTable, membersTable] -- | 名字是否带内部表前缀 reserved :: String -> Bool diff --git a/chusql-server/src/ChuSQL/Server/Catalog.hs b/chusql-server/src/ChuSQL/Server/Catalog.hs index 34193c1..ad52687 100644 --- a/chusql-server/src/ChuSQL/Server/Catalog.hs +++ b/chusql-server/src/ChuSQL/Server/Catalog.hs @@ -14,6 +14,9 @@ module ChuSQL.Server.Catalog , readGrants , addGrant , removeGrant + , readGrantOptions + , addGrantOption + , removeGrantOption , readMembers , addMember , removeMember @@ -22,7 +25,7 @@ module ChuSQL.Server.Catalog 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 ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, optionsTable, rolesTable) import Control.Concurrent.MVar (MVar, newMVar, withMVar) import Data.List (intercalate, isInfixOf) import Data.Text (Text) @@ -75,6 +78,7 @@ ensureCatalog catalog = eachAction tableDefs (createTable catalog) tableDefs = [ (rolesTable, "(name VARCHAR(64))") , (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))") + , (optionsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))") , (membersTable, "(role VARCHAR(64), member VARCHAR(64))") ] @@ -111,9 +115,10 @@ dropRole catalog role = do second <- exec catalog ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role) third <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role) fourth <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE member = " ++ roleLiteral role) - pure (sequence_ [first, second, third, fourth]) + fifth <- exec catalog ("DELETE FROM " ++ optionsTable ++ " WHERE role = " ++ roleLiteral role) + pure (sequence_ [first, second, third, fourth, fifth]) --- | 全部授权 +-- | 全部授权,都不带 grant option readGrants :: Catalog -> IO (Either String [Grant]) readGrants catalog = fmap (fmap (map grantOf)) (readRows catalog grantsTable) @@ -127,7 +132,23 @@ addGrant catalog role privilege object = do -- | 取消一条授权 removeGrant :: Catalog -> Text -> Text -> Text -> IO (Either String ()) -removeGrant catalog role privilege object = exec catalog (deleteGrantSql role privilege object) +removeGrant catalog role privilege object = exec catalog (deleteGrantSql grantsTable role privilege object) + +-- | 全部带 grant option 的授权 +readGrantOptions :: Catalog -> IO (Either String [Grant]) +readGrantOptions catalog = fmap (fmap (map optionOf)) (readRows catalog optionsTable) + +-- | 记一条带 grant option 的授权,同名的先清掉 +addGrantOption :: Catalog -> Text -> Text -> Text -> IO (Either String ()) +addGrantOption catalog role privilege object = do + cleared <- removeGrantOption catalog role privilege object + case cleared of + Left err -> pure (Left err) + Right () -> exec catalog (insertSql optionsTable ["role", "privilege", "object"] [normalizeRole role, privilege, object]) + +-- | 取消一条带 grant option 的授权 +removeGrantOption :: Catalog -> Text -> Text -> Text -> IO (Either String ()) +removeGrantOption catalog role privilege object = exec catalog (deleteGrantSql optionsTable role privilege object) -- | 全部成员关系 readMembers :: Catalog -> IO (Either String [(Text, Text)]) @@ -164,16 +185,21 @@ grantOf row = { grantRole = normalizeRole (cell "role" row) , grantPrivilege = T.toLower (T.strip (cell "privilege" row)) , grantObject = T.toLower (T.strip (cell "object" row)) + , grantable = False } +-- | 一行带 grant option 的授权记录 +optionOf :: Row -> Grant +optionOf row = (grantOf row) {grantable = True} + -- | 一行成员关系 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 +deleteGrantSql :: String -> Text -> Text -> Text -> String +deleteGrantSql table role privilege object = + "DELETE FROM " ++ table ++ " WHERE role = " ++ roleLiteral role ++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object -- | 拼一条插入语句 diff --git a/chusql-server/src/ChuSQL/Server/Privileges.hs b/chusql-server/src/ChuSQL/Server/Privileges.hs index be4f6d2..a2c2221 100644 --- a/chusql-server/src/ChuSQL/Server/Privileges.hs +++ b/chusql-server/src/ChuSQL/Server/Privileges.hs @@ -29,6 +29,7 @@ import ChuSQL.Server.Backend ( import ChuSQL.Server.Catalog ( Catalog, addGrant, + addGrantOption, addMember, dropRole, eachAction, @@ -37,10 +38,12 @@ import ChuSQL.Server.Catalog ( normalizeObject, normalizeRole, normalizeUser, + readGrantOptions, readGrants, readMembers, readRoleNames, removeGrant, + removeGrantOption, removeMember, withCatalogLock, ensureCatalog, @@ -68,7 +71,7 @@ data Membership = Membership data PrivilegeCommand = CreateRoleCommand Text | DropRoleCommand Text - | GrantPrivilegesCommand [Text] Text Text + | GrantPrivilegesCommand [Text] Text Text Bool | RevokePrivilegesCommand [Text] Text Text | GrantRoleCommand Text [Text] | RevokeRoleCommand Text [Text] @@ -87,24 +90,24 @@ privilegeCommand :: Statement -> Maybe PrivilegeCommand privilegeCommand stmt = case stmt of CreateRole name -> Just (CreateRoleCommand (T.pack name)) DropRole name -> Just (DropRoleCommand (T.pack name)) - GrantPrivileges privs obj role -> - Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role)) + GrantPrivileges privs obj role withOption -> + Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role) withOption) RevokePrivileges privs obj role -> Just (RevokePrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role)) GrantRole role members -> Just (GrantRoleCommand (T.pack role) (map T.pack members)) RevokeRole role members -> Just (RevokeRoleCommand (T.pack role) (map T.pack members)) _ -> Nothing --- | 执行管理命令:只有管理员能跑,命令提到的角色必须已经存在 +-- | 执行管理命令:管理员全通,普通身份只能转授自己拿到的权限 runPrivilegeCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ()) runPrivilegeCommand service principal database command - | not (principalIsRoot principal) = pure (Left forbidden) | needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected")) - | otherwise = withTables service (applyCommand service database command) + | principalIsRoot principal = withTables service (applyCommand service database command) + | otherwise = withTables service (delegateCommand service principal database command) where -- | 授权到具体对象时需要先选库 needsDatabase = T.null database && case command of - GrantPrivilegesCommand _ object _ -> T.strip object /= "*" + GrantPrivilegesCommand _ object _ _ -> T.strip object /= "*" RevokePrivilegesCommand _ object _ -> T.strip object /= "*" _ -> False @@ -164,10 +167,18 @@ requiredActions stmt = case stmt of -- | 每项 (表, 权限) 都要被某条授权覆盖 checkAll :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError () -checkAll database grants needed = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of +checkAll database grants needed = checkCovered database grants needed "permission denied: " + +-- | 转授权要查 grant option,报错口径与普通鉴权分开 +checkOptions :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError () +checkOptions database grants needed = checkCovered database grants needed "grant option required: " + +-- | 覆盖检查的公共实现 +checkCovered :: Text -> [Grant] -> [(Text, Text)] -> Text -> Either PrivilegeError () +checkCovered database grants needed prefix = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of [] -> Right () ((table, privilege) : _) -> - Left (PrivilegeError "forbidden" ("permission denied: " <> T.toUpper privilege <> " ON " <> table)) + Left (PrivilegeError "forbidden" (prefix <> T.toUpper privilege <> " ON " <> table)) where -- | 某一项是否被授权覆盖 covered table privilege = @@ -176,19 +187,25 @@ checkAll database grants needed = case [pair | pair@(table, privilege) <- needed (\grant -> (grantObject grant == "*" || grantObject grant == target) && grantPrivilege grant == privilege) grants --- | 一个用户实际能用的授权:所属角色加上继承来的 +-- | 一个用户实际能用的授权:含角色继承 grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant]) grantsOfUser service user = do members <- catalog (readMembers (pvCatalog service)) grants <- catalog (readGrants (pvCatalog service)) + options <- catalog (readGrantOptions (pvCatalog service)) roles <- roleNames service pure $ do memberRows <- members grantRows <- grants + optionRows <- options known <- roles let edges = roleEdges memberRows known mine = closureUp edges [role | (role, member) <- memberRows, member == normalizeUser user] - pure [grant | grant <- grantRows, grantRole grant `elem` mine] + pure [grant | grant <- grantRows ++ optionRows, grantRole grant `elem` mine] + +-- | 一个用户手里的 grant option,只有这些能再转授 +optionsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant]) +optionsOfUser service user = fmap (fmap (filter grantable)) (grantsOfUser service user) -- | 角色到角色的成员边:父角色在前 roleEdges :: [(Text, Text)] -> [Text] -> [(Text, Text)] @@ -203,11 +220,28 @@ closureUp edges = go let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known] in if null more then known else go (known ++ more) --- | 一个角色挂着的授权 +-- | 一个角色挂着的授权,带 grant option 的会标出来 roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant]) roleGrantsOf service role = do grants <- catalog (readGrants (pvCatalog service)) - pure (filter (\grant -> grantRole grant == normalizeRole role) <$> grants) + options <- catalog (readGrantOptions (pvCatalog service)) + pure (do + rows <- grants + optionRows <- options + let mine = filter (\grant -> grantRole grant == normalizeRole role) rows + pure (markOptions mine optionRows)) + +-- | 给授权标上有没有对应的 grant option +markOptions :: [Grant] -> [Grant] -> [Grant] +markOptions grants options = [grant {grantable = hasOption grant} | grant <- grants] + where + -- | 有没有一条同角色同权限同对象的 option + hasOption grant = any (same grant) options + -- | 两条授权指向同一处 + same one other = + grantRole one == grantRole other + && grantPrivilege one == grantPrivilege other + && grantObject one == grantObject other -- | 角色名清单(统一小写) roleNames :: Privileges -> IO (Either PrivilegeError [Text]) @@ -244,20 +278,20 @@ applyCommand service database command = case command of case allowed of Left err -> pure (Left err) Right () -> catalog (dropRole (pvCatalog service) role) - GrantPrivilegesCommand privileges object role -> do + GrantPrivilegesCommand privileges object role withOption -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) Right () -> eachAction (expandPrivileges privileges) $ \privilege -> - catalog (addGrant (pvCatalog service) role privilege (normalizeObject database object)) + grantOne service withOption role privilege (normalizeObject database object) RevokePrivilegesCommand privileges object role -> do allowed <- requireRole service role case allowed of Left err -> pure (Left err) Right () -> eachAction (expandPrivileges privileges) $ \privilege -> - catalog (removeGrant (pvCatalog service) role privilege (normalizeObject database object)) + revokeOne service role privilege (normalizeObject database object) GrantRoleCommand role members -> do allowed <- requireRole service role case allowed of @@ -273,6 +307,43 @@ applyCommand service database command = case command of Left err -> pure (Left err) Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user) +-- | 落一条授权,带 grant option 的再落一条转授权 +grantOne :: Privileges -> Bool -> Text -> Text -> Text -> IO (Either PrivilegeError ()) +grantOne service withOption role privilege object = do + written <- catalog (addGrant (pvCatalog service) role privilege object) + case written of + Left err -> pure (Left err) + Right () + | withOption -> catalog (addGrantOption (pvCatalog service) role privilege object) + | otherwise -> pure (Right ()) + +-- | 收一条授权,连同它的 grant option +revokeOne :: Privileges -> Text -> Text -> Text -> IO (Either PrivilegeError ()) +revokeOne service role privilege object = do + dropped <- catalog (removeGrant (pvCatalog service) role privilege object) + case dropped of + Left err -> pure (Left err) + Right () -> catalog (removeGrantOption (pvCatalog service) role privilege object) + +-- | 普通身份转授权:只放行 GRANT +delegateCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ()) +delegateCommand service principal database command = case command of + GrantPrivilegesCommand privileges object role _ -> do + allowed <- requireRole service role + case allowed of + Left err -> pure (Left err) + Right () -> do + owned <- optionsOfUser service (principalName principal) + case owned >>= \found -> checkOptions database found needed of + Left err -> pure (Left err) + Right () -> applyCommand service database command + _ -> pure (Left forbidden) + where + -- | 命令里每个 (对象, 权限) 都要对得上 + needed = case command of + GrantPrivilegesCommand privileges object _ _ -> [(object, privilege) | privilege <- expandPrivileges privileges] + _ -> [] + -- | 加一条成员边:名字是角色就查环,否则当用户加 grantMember :: Privileges -> [Text] -> Text -> Text -> IO (Either PrivilegeError ()) grantMember service roles role member = do diff --git a/chusql-server/test/Spec.hs b/chusql-server/test/Spec.hs index 2bb9fd2..fddc648 100644 --- a/chusql-server/test/Spec.hs +++ b/chusql-server/test/Spec.hs @@ -507,14 +507,14 @@ privilegeSpec = describe "server privileges" $ do 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 <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False) granted `shouldBe` Right () views <- listRoleViews service - fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users"]] + fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" False]] 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") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["all"] "*" "reader" False) views <- listRoleViews service fmap (concatMap (map grantPrivilege) . map roleGrants) views `shouldBe` Right ["select", "insert", "update", "delete"] @@ -522,11 +522,47 @@ privilegeSpec = describe "server privileges" $ do 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 (GrantPrivilegesCommand ["select"] "users" "reader" False) _ <- runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "reader") views <- listRoleViews service fmap (map roleGrants) views `shouldBe` Right [[]] + it "marks a grant that carries the grant option" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True) + views <- listRoleViews service + fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" True]] + + it "refuses a non-administrator without the grant option" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False) + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"]) + refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False) + refused `shouldBe` Left (PrivilegeError "forbidden" "grant option required: SELECT ON users") + + it "lets a grant option holder pass the privilege on" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True) + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"]) + passed <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False) + passed `shouldBe` Right () + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["bob"]) + views <- listRoleViews service + fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" True], [Grant "writer" "select" "test.users" False]] + + it "stops the pass-on once the grant option is revoked" $ withPrivileges $ \service root -> do + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True) + _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"]) + _ <- runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "reader") + refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False) + refused `shouldBe` Left (PrivilegeError "forbidden" "grant option required: SELECT ON users") + 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"]) @@ -539,7 +575,7 @@ privilegeSpec = describe "server privileges" $ do 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 (GrantPrivilegesCommand ["select"] "users" "reader" False) _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"]) dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader") dropped `shouldBe` Right () @@ -549,7 +585,7 @@ privilegeSpec = describe "server privileges" $ do it "inherits the grants of another role" $ withPrivileges $ \service root -> do _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer") - _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False) _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"]) linked <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["alice"]) linked `shouldBe` Right () @@ -579,7 +615,7 @@ privilegeSpec = describe "server privileges" $ do it "drops the inherited edge together with the role" $ withPrivileges $ \service root -> do _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader") _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer") - _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader") + _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False) _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"]) _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["alice"]) dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader") @@ -590,12 +626,12 @@ privilegeSpec = describe "server privileges" $ do fmap (map roleMembers) views `shouldBe` Right [["alice"]] 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 <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "ghost" False) 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 <- runPrivilegeCommand service root "" (GrantPrivilegesCommand ["select"] "users" "reader" False) refused `shouldBe` Left (PrivilegeError "no_database" "no database selected") it "refuses a non-administrator" $ withPrivileges $ \service _ -> do @@ -631,12 +667,26 @@ privilegeSpec = describe "server privileges" $ do service <- newPrivileges base _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader") _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer") - _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader") + _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False) _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "reader" ["writer"]) linked <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "writer" ["alice"]) linked `shouldBe` Right () authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right () + it "keeps a grant option on the real storage" $ withIpcStorage $ do + base <- ipcBackend + service <- newPrivileges base + _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader") + _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer") + _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True) + _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "reader" ["alice"]) + views <- listRoleViews service + fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" True], []] + passed <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False) + passed `shouldBe` Right () + after <- listRoleViews service + fmap (map roleGrants) after `shouldBe` Right [[Grant "reader" "select" "test.users" True], [Grant "writer" "select" "test.users" False]] + -- 真存储夹具:一个用例一份数据目录,跑完关链路删干净 -- | 本次用例的数据目录(用例串行跑,固定名够用) diff --git a/chusql-web/src/ChuSQL/Web/API.hs b/chusql-web/src/ChuSQL/Web/API.hs index 9530b75..ef8d8b8 100644 --- a/chusql-web/src/ChuSQL/Web/API.hs +++ b/chusql-web/src/ChuSQL/Web/API.hs @@ -1212,6 +1212,7 @@ grantJson grant = object [ "privilege" .= grantPrivilege grant , "object" .= grantObject grant + , "grantable" .= grantable grant ] -- | 建角色 @@ -1236,7 +1237,8 @@ grantRoleH env = do role <- pathParam "name" withJsonObject env $ \o -> case grantFields o of Left err -> reply400 "bad_request" err - Right (privileges, objectName) -> runPrivilegeSql ws (grantPrivilegesSql privileges objectName role) + Right (privileges, objectName, withOption) -> + runPrivilegeSql ws (grantPrivilegesSql privileges objectName role withOption) -- | 收角色的权限 revokeRoleH :: AppEnv -> ActionM () @@ -1245,7 +1247,7 @@ revokeRoleH env = do role <- pathParam "name" withJsonObject env $ \o -> case grantFields o of Left err -> reply400 "bad_request" err - Right (privileges, objectName) -> runPrivilegeSql ws (revokePrivilegesSql privileges objectName role) + Right (privileges, objectName, _) -> runPrivilegeSql ws (revokePrivilegesSql privileges objectName role) -- | 把用户加进角色 addRoleMemberH :: AppEnv -> ActionM () @@ -1264,14 +1266,18 @@ removeRoleMemberH env = do user <- pathParam "user" runPrivilegeSql ws (revokeRoleSql role [user]) --- | 权限(一条或一串)与对象 -grantFields :: A.Object -> Either Text ([Text], Text) +-- | 权限(一条或一串)、对象与是否带转授权 +grantFields :: A.Object -> Either Text ([Text], Text, Bool) grantFields o = do objectName <- textField "object" o privileges <- case KM.lookup "privileges" o of Just (A.Array xs) -> mapM stringValue (V.toList xs) _ -> Left "missing or non-array field: privileges" - if null privileges then Left "at least one privilege is required" else pure (privileges, objectName) + withOption <- case KM.lookup "grantOption" o of + Nothing -> Right False + Just (A.Bool flag) -> Right flag + _ -> Left "grantOption must be a boolean" + if null privileges then Left "at least one privilege is required" else pure (privileges, objectName, withOption) -- | 成员(一条或一串) memberFields :: A.Object -> Either Text [Text] diff --git a/chusql-web/test/Spec.hs b/chusql-web/test/Spec.hs index 154a7ad..f2af048 100644 --- a/chusql-web/test/Spec.hs +++ b/chusql-web/test/Spec.hs @@ -262,6 +262,11 @@ asInt :: A.Value -> Int asInt (A.Number n) = round n asInt _ = -1 +-- | 当布尔看 +asBool :: A.Value -> Bool +asBool (A.Bool b) = b +asBool _ = False + -- | 第 i 个元素,越界给 Nothing nth :: Int -> [a] -> Maybe a nth i xs = case drop i xs of @@ -852,6 +857,28 @@ roleSpec env = describe "roles and grants" $ do dropped <- deleteAs hs "/api/roles/analyst" expectStatusWith "drop role" dropped 200 + it "carries the grant option through the API" $ do + hs <- adminHeaders + ensureDatabase hs testDatabaseName + created <- postAs hs "/api/roles" (encode (object ["name" .= ("passer" :: Text)])) + expectStatusWith "create passer" created 200 + granted <- + postAs + (withDb testDatabaseName hs) + "/api/roles/passer/grants" + (encode (object ["object" .= testDatabaseName, "privileges" .= (["select"] :: [Text]), "grantOption" .= True])) + expectStatusWith "grant with option" granted 200 + listed <- getAs hs "/api/roles" + expectStatusWith "list roles" listed 200 + let matching = [view | view <- items (jsonBody listed), asText (at "name" view) == "passer"] + check ((concatMap (map (asBool . at "grantable") . items . at "grants") matching) `shouldBe` [True]) + refused <- + postAs + hs + "/api/roles/passer/grants" + (encode (object ["object" .= testDatabaseName, "privileges" .= (["select"] :: [Text]), "grantOption" .= ("yes" :: Text)])) + expectStatusWith "non-boolean grant option" refused 400 + -- SQL 控制台 ----------------------------------------------------------------- -- | SQL 控制台用例 diff --git a/docs/architecture.md b/docs/architecture.md index fc5b639..a9db245 100644 --- a/docs/architecture.md +++ b/docs/architecture.md @@ -53,6 +53,6 @@ chusql-server WAL 负责崩溃恢复:每条记录带自增 LSN,一组写操作与一条提交标记一次落盘;每组提交在数据和字典都刷盘之后把 `wal.checkpoint` 推进到这条提交的 LSN,含义是「到此为止的改动都已落盘」,再按这个边界丢掉日志前缀——所以日志里通常只有当组在飞的记录。进程重启时只重放检查点之后的记录,按标记分组取已提交的组、丢弃没有标记的整组,重放前逐条做幂等检查作为第二道保险,结束后再把检查点推到最后一条提交。LSN 从检查点与文件尾里较大的那个续号,跨重启单调,`SystemStatus` 应答里的 `last_lsn` 报告该检查点 LSN。建表、删表、建索引、删索引与数据改动走同一条 WAL,恢复时一并重放。 -系统数据库及部分管理操作仅允许管理员访问。系统表统一用 `__system_` 前缀:账号表 `__system_users` 对语句通道隐藏,角色、授权、成员三张表(`__system_roles` / `__system_grants` / `__system_members`)只在 `system` 库里可见,权限服务自身也通过 SQL 读写它们;存储启动时把旧名 `sys_roles` / `sys_grants` / `sys_members` 连同数据与索引文件一起迁移过来。角色支持互相继承:`GRANT 角色 A TO 角色 B` 记一条 B 属于 A 的成员关系,判定权限时沿成员关系算出向上闭包再取并集;写入时拒绝成环与自继承,删角色会清掉它两个方向的成员关系。 +系统数据库及部分管理操作仅允许管理员访问。系统表统一用 `__system_` 前缀:账号表 `__system_users` 对语句通道隐藏,角色、授权、成员三张表(`__system_roles` / `__system_grants` / `__system_members`)只在 `system` 库里可见,权限服务自身也通过 SQL 读写它们;存储启动时把旧名 `sys_roles` / `sys_grants` / `sys_members` 连同数据与索引文件一起迁移过来。角色支持互相继承:`GRANT 角色 A TO 角色 B` 记一条 B 属于 A 的成员关系,判定权限时沿成员关系算出向上闭包再取并集;写入时拒绝成环与自继承,删角色会清掉它两个方向的成员关系。带 `WITH GRANT OPTION` 的授权记在第四张表 `__system_grant_options` 里(同样的角色、权限、对象三列,单独的列存不下就单独一张表,省掉系统表的结构迁移):普通身份只要手里那条授权带 grant option 就能把同一项权限转授给别的角色,`REVOKE` 仍然只允许管理员,收回授权时连它的 grant option 一起收掉,但不级联收回别人已经转授出去的授权。授权命令由权限服务在会话层之外直接执行,`GRANT` 命令会先按当前库把对象补全成 `库.表` 再落盘,因此判断转授权资格与实际写入用的是同一个对象名。 服务监听地址、端口和请求限制可在 `chusql.toml` 的 `[server]` 分区中配置。 diff --git a/docs/commands.md b/docs/commands.md index 8fb68b9..331fef3 100644 --- a/docs/commands.md +++ b/docs/commands.md @@ -91,6 +91,7 @@ DROP USER alice; CREATE ROLE analyst; CREATE ROLE reviewer; GRANT SELECT ON orders TO analyst; +GRANT SELECT ON orders TO reviewer WITH GRANT OPTION; GRANT analyst TO reviewer; GRANT reviewer TO alice; REVOKE SELECT ON orders FROM analyst; @@ -105,6 +106,8 @@ DROP ROLE analyst; 管理员拥有完整权限;数据库、表、索引等结构管理操作仅允许管理员执行。 +`GRANT ... WITH GRANT OPTION` 让拿到的授权可以再转授:普通身份只有手里那条授权带 grant option 时才能执行 `GRANT`,报错是 `grant option required: <权限> ON <表>`;`REVOKE` 仍然只允许管理员,收回授权会连它的 grant option 一起收掉,且不会级联收回别人转授出去的授权。转授权随角色继承一起传递。 + 系统数据库 `system` 仅允许管理员访问。 ## chusql-web