1 |
(* |
2 |
* IBX Test suite. This program is used to test the IBX non-visual |
3 |
* components and provides a semi-automated pass/fail check for each test. |
4 |
* |
5 |
* The contents of this file are subject to the Initial Developer's |
6 |
* Public License Version 1.0 (the "License"); you may not use this |
7 |
* file except in compliance with the License. You may obtain a copy |
8 |
* of the License here: |
9 |
* |
10 |
* http://www.firebirdsql.org/index.php?op=doc&id=idpl |
11 |
* |
12 |
* Software distributed under the License is distributed on an "AS |
13 |
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or |
14 |
* implied. See the License for the specific language governing rights |
15 |
* and limitations under the License. |
16 |
* |
17 |
* The Initial Developer of the Original Code is Tony Whyman. |
18 |
* |
19 |
* The Original Code is (C) 2021 Tony Whyman, MWA Software |
20 |
* (http://www.mwasoftware.co.uk). |
21 |
* |
22 |
* All Rights Reserved. |
23 |
* |
24 |
* Contributor(s): ______________________________________. |
25 |
* |
26 |
*) |
27 |
unit Test22; |
28 |
|
29 |
{$mode objfpc}{$H+} |
30 |
|
31 |
{Test 22: TIBUpdate Tests} |
32 |
|
33 |
{ This test uses TIBUpdate to allow a list of database users to be presented |
34 |
as a table and edited using normal insert/edit/delete/post methods. |
35 |
} |
36 |
|
37 |
interface |
38 |
|
39 |
uses |
40 |
Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBSQL, IBUpdate, |
41 |
IBQuery, IBCustomDataset; |
42 |
|
43 |
const |
44 |
aTestID = '22'; |
45 |
aTestTitle = 'TIBUpdate Tests'; |
46 |
|
47 |
type |
48 |
|
49 |
{ TTest22 } |
50 |
|
51 |
TTest22 = class(TIBXTestBase) |
52 |
private |
53 |
FIBUpdate: TIBUpdate; |
54 |
ExecDDL: TIBSQL; |
55 |
procedure UserListAfterInsert(DataSet: TDataSet); |
56 |
procedure UpdateUsersApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind; |
57 |
Params: ISQLParams); |
58 |
protected |
59 |
procedure CreateObjects(Application: TTestApplication); override; |
60 |
function GetTestID: AnsiString; override; |
61 |
function GetTestTitle: AnsiString; override; |
62 |
procedure InitTest; override; |
63 |
function SkipTest: boolean; override; |
64 |
public |
65 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override; |
66 |
end; |
67 |
|
68 |
|
69 |
implementation |
70 |
|
71 |
uses IBUtils; |
72 |
|
73 |
const |
74 |
UsersQuery = |
75 |
'Select A.SEC$DESCRIPTION, Trim(A.SEC$PLUGIN) as SEC$PLUGIN, A.SEC$ADMIN, '+ |
76 |
'A.SEC$ACTIVE, Trim(A.SEC$USER_NAME) as SEC$USER_NAME, '+ |
77 |
'Trim(A.SEC$FIRST_NAME) as SEC$FIRST_NAME, '+ |
78 |
'Trim(A.SEC$MIDDLE_NAME) as SEC$MIDDLE_NAME, '+ |
79 |
'Trim(A.SEC$LAST_NAME) as SEC$LAST_NAME, '+ |
80 |
'cast(NULL as VarChar(32)) as SEC$PASSWORD, '+ |
81 |
'case when Count(B.MON$ATTACHMENT_ID) > 0 then true else false end as LoggedIn, '+ |
82 |
'case When C.SEC$USER is not null then true else false end as DBCreator '+ |
83 |
'From SEC$USERS A '+ |
84 |
'Left Outer Join MON$ATTACHMENTS B '+ |
85 |
'On A.SEC$USER_NAME = B.MON$USER '+ |
86 |
'Left Outer Join SEC$DB_CREATORS C on C.SEC$USER = A.SEC$USER_NAME'; |
87 |
UsersQueryGroupBy = |
88 |
'Group By A.SEC$DESCRIPTION, A.SEC$PLUGIN, A.SEC$ADMIN, '+ |
89 |
'A.SEC$ACTIVE, A.SEC$USER_NAME, A.SEC$MIDDLE_NAME, '+ |
90 |
'A.SEC$FIRST_NAME, A.SEC$LAST_NAME, C.SEC$USER'; |
91 |
|
92 |
{ TTest22 } |
93 |
|
94 |
procedure TTest22.UserListAfterInsert(DataSet: TDataSet); |
95 |
begin |
96 |
DataSet.FieldByName('SEC$ADMIN').AsBoolean := false; |
97 |
DataSet.FieldByName('SEC$ACTIVE').AsBoolean := false; |
98 |
DataSet.FieldByName('DBCreator').AsBoolean := false; |
99 |
DataSet.FieldByName('SEC$PLUGIN').AsString := 'Srp'; |
100 |
DataSet.FieldByName('SEC$PASSWORD').Clear; |
101 |
end; |
102 |
|
103 |
procedure TTest22.UpdateUsersApplyUpdates(Sender: TObject; |
104 |
UpdateKind: TUpdateKind; Params: ISQLParams); |
105 |
|
106 |
var UserName: string; |
107 |
|
108 |
function FormatStmtOptions: string; |
109 |
var Param: ISQLParam; |
110 |
begin |
111 |
Result := UserName; |
112 |
Param := Params.ByName('SEC$PASSWORD'); |
113 |
if (Param <> nil) and not Param.IsNull then |
114 |
Result += ' PASSWORD ''' + SQLSafeString(Param.AsString) + ''''; |
115 |
Param := Params.ByName('SEC$FIRST_NAME'); |
116 |
if Param <> nil then |
117 |
Result += ' FIRSTNAME ''' + SQLSafeString(Param.AsString) + ''''; |
118 |
Param := Params.ByName('SEC$MIDDLE_NAME'); |
119 |
if Param <> nil then |
120 |
Result += ' MIDDLENAME ''' + SQLSafeString(Param.AsString) + ''''; |
121 |
Param := Params.ByName('SEC$LAST_NAME'); |
122 |
if Param <> nil then |
123 |
Result += ' LASTNAME ''' + SQLSafeString(Param.AsString) + ''''; |
124 |
Param := Params.ByName('SEC$ACTIVE'); |
125 |
if Param <> nil then |
126 |
begin |
127 |
if Param.AsBoolean then |
128 |
Result += ' ACTIVE' |
129 |
else |
130 |
Result += ' INACTIVE'; |
131 |
end; |
132 |
Param := Params.ByName('SEC$PLUGIN'); |
133 |
if Param <> nil then |
134 |
Result += ' USING PLUGIN ' + QuoteIdentifierIfNeeded((Sender as TIBUpdate).DataSet.Database.SQLDialect,Param.AsString); |
135 |
end; |
136 |
|
137 |
function GetAlterPasswordStmt: string; |
138 |
var Param: ISQLParam; |
139 |
begin |
140 |
Result := ''; |
141 |
Param := Params.ByName('SEC$PASSWORD'); |
142 |
if (UpdateKind = ukModify) and not Param.IsNull then |
143 |
begin |
144 |
Result := 'ALTER USER ' + UserName + |
145 |
' PASSWORD ''' + SQLSafeString(Param.AsString) + ''''; |
146 |
Param := Params.ByName('SEC$PLUGIN'); |
147 |
if Param <> nil then |
148 |
Result += ' USING PLUGIN ' + QuoteIdentifierIfNeeded((Sender as TIBUpdate).DataSet.Database.SQLDialect,Param.AsString); |
149 |
end; |
150 |
end; |
151 |
|
152 |
begin |
153 |
UserName := Trim(Params.ByName('SEC$USER_NAME').AsString); |
154 |
{non SYSDBA user not an RDB$ADMIN can only change their password} |
155 |
if (Owner.GetUserName <> 'SYSDBA') and (RoleName <> 'RDB$ADMIN') then |
156 |
begin |
157 |
ExecDDL.SQL.Text := GetAlterPasswordStmt; |
158 |
if ExecDDL.SQL.Text <> '' then |
159 |
ExecDDL.ExecQuery; |
160 |
Exit; |
161 |
end; |
162 |
|
163 |
case UpdateKind of |
164 |
ukInsert: |
165 |
ExecDDL.SQL.Text := 'CREATE USER ' + FormatStmtOptions; |
166 |
ukModify: |
167 |
ExecDDL.SQL.Text := 'ALTER USER ' + FormatStmtOptions; |
168 |
ukDelete: |
169 |
ExecDDL.SQL.Text := 'DROP USER ' + UserName; |
170 |
end; |
171 |
// writeln(OutFile,'Query Text = ',ExecDDL.SQL.Text); |
172 |
ExecDDL.ExecQuery; |
173 |
|
174 |
if UpdateKind = ukInsert then |
175 |
begin |
176 |
{if new user is also given the admin role then we need to add this} |
177 |
if Params.ByName('SEC$ADMIN').AsBoolean then |
178 |
begin |
179 |
ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE'; |
180 |
ExecDDL.ExecQuery; |
181 |
end; |
182 |
if Params.ByName('DBCreator').AsBoolean then |
183 |
begin |
184 |
ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + UserName; |
185 |
ExecDDL.ExecQuery; |
186 |
end |
187 |
else |
188 |
begin |
189 |
ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + UserName; |
190 |
ExecDDL.ExecQuery; |
191 |
end; |
192 |
end |
193 |
else |
194 |
if UpdateKind = ukModify then |
195 |
{Update Admin Role if allowed} |
196 |
begin |
197 |
if Params.ByName('SEC$ADMIN').AsBoolean and not Params.ByName('OLD_SEC$ADMIN').AsBoolean then |
198 |
begin |
199 |
ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE'; |
200 |
ExecDDL.ExecQuery; |
201 |
end |
202 |
else |
203 |
if not Params.ByName('SEC$ADMIN').AsBoolean and Params.ByName('OLD_SEC$ADMIN').AsBoolean then |
204 |
begin |
205 |
ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' REVOKE ADMIN ROLE'; |
206 |
ExecDDL.ExecQuery; |
207 |
end; |
208 |
|
209 |
{Update DB Creator Role} |
210 |
if Params.ByName('DBCreator').AsBoolean and not Params.ByName('OLD_DBCreator').AsBoolean then |
211 |
begin |
212 |
ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + UserName; |
213 |
ExecDDL.ExecQuery; |
214 |
end |
215 |
else |
216 |
if not Params.ByName('DBCreator').AsBoolean and Params.ByName('OLD_DBCreator').AsBoolean then |
217 |
begin |
218 |
ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + UserName; |
219 |
ExecDDL.ExecQuery; |
220 |
end; |
221 |
end; |
222 |
end; |
223 |
|
224 |
procedure TTest22.CreateObjects(Application: TTestApplication); |
225 |
begin |
226 |
inherited CreateObjects(Application); |
227 |
FIBUpdate := TIBUpdate.Create(Application); |
228 |
FIBUpdate.RefreshSQL.Text := UsersQuery + ' Where A.SEC$USER_NAME = :SEC$USER_NAME ' + UsersQueryGroupBy; |
229 |
FIBUpdate.OnApplyUpdates := @UpdateUsersApplyUpdates; |
230 |
IBQuery.SQL.Text := UsersQuery + ' ' + UsersQueryGroupBy; |
231 |
IBQuery.AfterInsert:= @UserListAfterInsert; |
232 |
IBQuery.UpdateObject := FIBUpdate; |
233 |
IBQuery.AutoCommit := acCommitRetaining; |
234 |
ExecDDL := TIBSQL.Create(Application); |
235 |
ExecDDL.Database := IBDatabase; |
236 |
ExecDDL.Transaction := IBTransaction; |
237 |
end; |
238 |
|
239 |
function TTest22.GetTestID: AnsiString; |
240 |
begin |
241 |
Result := aTestID; |
242 |
end; |
243 |
|
244 |
function TTest22.GetTestTitle: AnsiString; |
245 |
begin |
246 |
Result := aTestTitle; |
247 |
end; |
248 |
|
249 |
procedure TTest22.InitTest; |
250 |
begin |
251 |
inherited InitTest; |
252 |
IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName; |
253 |
ReadWriteTransaction; |
254 |
end; |
255 |
|
256 |
function TTest22.SkipTest: boolean; |
257 |
begin |
258 |
Result := FirebirdAPI.GetClientMajor < 3; |
259 |
if Result then |
260 |
writeln(OutFile,'Skipping ',TestTitle); |
261 |
end; |
262 |
|
263 |
procedure TTest22.RunTest(CharSet: AnsiString; SQLDialect: integer); |
264 |
begin |
265 |
IBDatabase.Connected := true; |
266 |
IBTransaction.Active := true; |
267 |
try |
268 |
writeln(Outfile,'RoleName = ',RoleName); |
269 |
IBQuery.Active := true; |
270 |
writeln(Outfile,'User List'); |
271 |
PrintDataSet(IBQuery); |
272 |
writeln(Outfile,'Add a user'); |
273 |
with IBQuery do |
274 |
begin |
275 |
Append; |
276 |
FieldByName('SEC$USER_NAME').AsString := 'TESTER'; |
277 |
FieldByName('SEC$FIRST_NAME').AsString := 'Chief'; |
278 |
FieldByName('SEC$LAST_NAME').AsString := 'Tester'; |
279 |
FieldByName('SEC$PASSWORD').AsString := 'LetMeIn'; |
280 |
Post; |
281 |
IBTransaction.Commit; |
282 |
IBTransaction.Active := true; |
283 |
Active := true; |
284 |
end; |
285 |
writeln(Outfile,'Updated User List'); |
286 |
PrintDataSet(IBQuery); |
287 |
writeln(Outfile,'Modify a User'); |
288 |
with IBQuery do |
289 |
if Locate('SEC$USER_NAME','TESTER',[]) then |
290 |
begin |
291 |
Edit; |
292 |
FieldByName('SEC$MIDDLE_NAME').AsString := 'Database'; |
293 |
FieldByName('DBCreator').AsBoolean := true; |
294 |
Post; |
295 |
IBTransaction.Commit; |
296 |
IBTransaction.Active := true; |
297 |
Active := true; |
298 |
end |
299 |
else |
300 |
writeln(Outfile,'Error: unable to located new user'); |
301 |
writeln(Outfile,'Updated User List'); |
302 |
PrintDataSet(IBQuery); |
303 |
writeln(Outfile,'Delete a user'); |
304 |
with IBQuery do |
305 |
if Locate('SEC$USER_NAME','TESTER',[]) then |
306 |
Delete; |
307 |
IBTransaction.Commit; |
308 |
IBTransaction.Active := true; |
309 |
IBQuery.Active := true; |
310 |
writeln(Outfile,'Updated User List'); |
311 |
PrintDataSet(IBQuery); |
312 |
finally |
313 |
IBDatabase.ReConnect; |
314 |
IBTransaction.Active := true; |
315 |
with IBQuery do |
316 |
begin {make sure user is removed} |
317 |
Active := true; |
318 |
if Locate('SEC$USER_NAME','TESTER',[]) then |
319 |
Delete; |
320 |
IBTransaction.Commit; |
321 |
end; |
322 |
IBDatabase.Connected := false; |
323 |
end; |
324 |
end; |
325 |
|
326 |
initialization |
327 |
RegisterTest(TTest22); |
328 |
|
329 |
end. |
330 |
|