trunk/testsuite/Test22.pas

unit Test22;

{$mode objfpc}{$H+}

{Test 22: TIBUpdate Tests}

{ This test uses TIBUpdate to allow a list of database users to be presented
  as a table and edited using normal insert/edit/delete/post methods.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, DB, IB, IBSQL, IBUpdate,
  IBQuery, IBCustomDataset;

const
  aTestID    = '22';
  aTestTitle = 'TIBUpdate Tests';

type

{ TTest22 }

  TTest22 = class(TIBXTestBase)
  private
    FIBUpdate: TIBUpdate;
    ExecDDL: TIBSQL;
    procedure UserListAfterInsert(DataSet: TDataSet);
    procedure UpdateUsersApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
      Params: ISQLParams);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
    function SkipTest: boolean; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

uses IBUtils;

const
  UsersQuery =
    'Select A.SEC$DESCRIPTION, Trim(A.SEC$PLUGIN) as SEC$PLUGIN, A.SEC$ADMIN, '+
    'A.SEC$ACTIVE, Trim(A.SEC$USER_NAME) as SEC$USER_NAME, '+
    'Trim(A.SEC$FIRST_NAME) as SEC$FIRST_NAME, '+
    'Trim(A.SEC$MIDDLE_NAME) as SEC$MIDDLE_NAME, '+
    'Trim(A.SEC$LAST_NAME) as SEC$LAST_NAME, '+
    'cast(NULL as VarChar(32)) as SEC$PASSWORD, '+
    'case when Count(B.MON$ATTACHMENT_ID) > 0 then true else false end as LoggedIn, '+
    'case When C.SEC$USER is not null then true else false end as DBCreator '+
    'From SEC$USERS A '+
    'Left Outer Join MON$ATTACHMENTS B '+
    'On A.SEC$USER_NAME = B.MON$USER '+
    'Left Outer Join SEC$DB_CREATORS  C on C.SEC$USER = A.SEC$USER_NAME';
  UsersQueryGroupBy =
    'Group By A.SEC$DESCRIPTION, A.SEC$PLUGIN, A.SEC$ADMIN, '+
    'A.SEC$ACTIVE, A.SEC$USER_NAME, A.SEC$MIDDLE_NAME, '+
    'A.SEC$FIRST_NAME, A.SEC$LAST_NAME, C.SEC$USER';

{ TTest22 }

procedure TTest22.UserListAfterInsert(DataSet: TDataSet);
begin
  DataSet.FieldByName('SEC$ADMIN').AsBoolean := false;
  DataSet.FieldByName('SEC$ACTIVE').AsBoolean := false;
  DataSet.FieldByName('DBCreator').AsBoolean := false;
  DataSet.FieldByName('SEC$PLUGIN').AsString := 'Srp';
  DataSet.FieldByName('SEC$PASSWORD').Clear;
end;

procedure TTest22.UpdateUsersApplyUpdates(Sender: TObject;
  UpdateKind: TUpdateKind; Params: ISQLParams);

var UserName: string;

  function FormatStmtOptions: string;
  var Param: ISQLParam;
  begin
    Result := UserName;
    Param := Params.ByName('SEC$PASSWORD');
    if (Param <> nil) and not Param.IsNull  then
      Result += ' PASSWORD ''' + SQLSafeString(Param.AsString) + '''';
    Param := Params.ByName('SEC$FIRST_NAME');
    if Param <> nil then
      Result += ' FIRSTNAME ''' + SQLSafeString(Param.AsString) + '''';
    Param := Params.ByName('SEC$MIDDLE_NAME');
    if Param <> nil then
      Result += ' MIDDLENAME ''' + SQLSafeString(Param.AsString) + '''';
    Param := Params.ByName('SEC$LAST_NAME');
    if Param <> nil then
      Result += ' LASTNAME ''' + SQLSafeString(Param.AsString) + '''';
    Param := Params.ByName('SEC$ACTIVE');
    if Param <> nil then
    begin
      if Param.AsBoolean then
        Result += ' ACTIVE'
      else
        Result += ' INACTIVE';
    end;
    Param := Params.ByName('SEC$PLUGIN');
    if Param <> nil then
      Result += ' USING PLUGIN ' + QuoteIdentifierIfNeeded((Sender as TIBUpdate).DataSet.Database.SQLDialect,Param.AsString);
  end;

  function GetAlterPasswordStmt: string;
  var Param: ISQLParam;
  begin
    Result := '';
    Param := Params.ByName('SEC$PASSWORD');
    if (UpdateKind = ukModify) and not Param.IsNull then
    begin
      Result := 'ALTER USER ' + UserName +
          ' PASSWORD ''' + SQLSafeString(Param.AsString) + '''';
      Param := Params.ByName('SEC$PLUGIN');
     if Param <> nil then
       Result += ' USING PLUGIN ' + QuoteIdentifierIfNeeded((Sender as TIBUpdate).DataSet.Database.SQLDialect,Param.AsString);
    end;
  end;

begin
  UserName := Trim(Params.ByName('SEC$USER_NAME').AsString);
  {non SYSDBA user not an RDB$ADMIN can only change their password}
  if (Owner.GetUserName <> 'SYSDBA') and (RoleName <> 'RDB$ADMIN') then
  begin
   ExecDDL.SQL.Text := GetAlterPasswordStmt;
   if ExecDDL.SQL.Text <> '' then
     ExecDDL.ExecQuery;
   Exit;
  end;

  case UpdateKind of
  ukInsert:
      ExecDDL.SQL.Text := 'CREATE USER ' + FormatStmtOptions;
  ukModify:
      ExecDDL.SQL.Text := 'ALTER USER ' + FormatStmtOptions;
  ukDelete:
    ExecDDL.SQL.Text := 'DROP USER ' + UserName;
  end;
  ExecDDL.ExecQuery;

  if UpdateKind = ukInsert then
  begin
    {if new user is also given the admin role then we need to add this}
    if Params.ByName('SEC$ADMIN').AsBoolean then
    begin
      ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE';
      ExecDDL.ExecQuery;
    end;
  end
  else
  if UpdateKind = ukModify then
  {Update Admin Role if allowed}
  begin
    if Params.ByName('SEC$ADMIN').AsBoolean and not Params.ByName('OLD_SEC$ADMIN').AsBoolean then
    begin
      ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE';
      ExecDDL.ExecQuery;
    end
    else
    if not Params.ByName('SEC$ADMIN').AsBoolean and Params.ByName('OLD_SEC$ADMIN').AsBoolean then
    begin
      ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' REVOKE ADMIN ROLE';
      ExecDDL.ExecQuery;
    end
  end;

  {Update DB Creator Role}
  if Params.ByName('DBCreator').AsBoolean and not Params.ByName('OLD_DBCreator').AsBoolean then
  begin
    ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + UserName;
    ExecDDL.ExecQuery;
  end
  else
  if not Params.ByName('DBCreator').AsBoolean and Params.ByName('OLD_DBCreator').AsBoolean then
  begin
    ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + UserName;
    ExecDDL.ExecQuery;
  end
end;

procedure TTest22.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBUpdate := TIBUpdate.Create(Application);
  FIBUpdate.RefreshSQL.Text := UsersQuery + ' Where  A.SEC$USER_NAME = :SEC$USER_NAME ' + UsersQueryGroupBy;
  FIBUpdate.OnApplyUpdates := @UpdateUsersApplyUpdates;
  IBQuery.SQL.Text := UsersQuery + ' ' + UsersQueryGroupBy;
  IBQuery.AfterInsert:= @UserListAfterInsert;
  IBQuery.UpdateObject := FIBUpdate;
  IBQuery.AutoCommit := acCommitRetaining;
  ExecDDL := TIBSQL.Create(Application);
  ExecDDL.Database := IBDatabase;
  ExecDDL.Transaction := IBTransaction;
end;

function TTest22.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest22.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest22.InitTest;
begin
  inherited InitTest;
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  ReadWriteTransaction;
end;

function TTest22.SkipTest: boolean;
begin
  Result := FirebirdAPI.GetClientMajor < 3;
  if Result then
    writeln(OutFile,'Skipping ',TestTitle);
end;

procedure TTest22.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  IBTransaction.Active := true;
  try
     writeln(Outfile,'RoleName = ',RoleName);
     IBQuery.Active := true;
     writeln(Outfile,'User List');
     PrintDataSet(IBQuery);
     writeln(Outfile,'Add a user');
     with IBQuery do
     begin
       Append;
       FieldByName('SEC$USER_NAME').AsString := 'TESTER';
       FieldByName('SEC$FIRST_NAME').AsString := 'Chief';
       FieldByName('SEC$LAST_NAME').AsString := 'Tester';
       FieldByName('SEC$PASSWORD').AsString := 'LetMeIn';
       Post;
       IBTransaction.Commit;
       IBTransaction.Active := true;
       Active := true;
     end;
     writeln(Outfile,'Updated User List');
     PrintDataSet(IBQuery);
     writeln(Outfile,'Modify a User');
     with IBQuery do
     if Locate('SEC$USER_NAME','TESTER',[]) then
     begin
       Edit;
       FieldByName('SEC$MIDDLE_NAME').AsString := 'Database';
       FieldByName('DBCreator').AsBoolean := true;
       Post;
       IBTransaction.Commit;
       IBTransaction.Active := true;
       Active := true;
     end
     else
       writeln(Outfile,'Error: unable to located new user');
     writeln(Outfile,'Updated User List');
     PrintDataSet(IBQuery);
     writeln(Outfile,'Delete a user');
     with IBQuery do
       if Locate('SEC$USER_NAME','TESTER',[]) then
         Delete;
     IBTransaction.Commit;
     IBTransaction.Active := true;
     IBQuery.Active := true;
     writeln(Outfile,'Updated User List');
     PrintDataSet(IBQuery);
  finally
    IBDatabase.ReConnect;
    IBTransaction.Active := true;
    with IBQuery do
    begin {make sure user is removed}
      Active := true;
      if Locate('SEC$USER_NAME','TESTER',[]) then
        Delete;
      IBTransaction.Commit;
    end;
    IBDatabase.Connected := false;
  end;
end;

initialization
  RegisterTest(TTest22);

end.

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