ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test22.pas
Revision: 410
Committed: Thu Jun 22 13:52:39 2023 UTC (16 months, 3 weeks ago) by tony
Content type: text/x-pascal
File size: 10209 byte(s)
Log Message:
Release 2.6.0 beta

File Contents

# Content
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

Properties

Name Value
svn:eol-style native