unit usermanager;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,

ExtCtrls, ToolWin, ClipBrd, Generics.Collections, Generics.Defaults, SynRegExpr, extra_controls,

dbconnection, dbstructures, dbstructures.mysql, apphelpers, VirtualTrees, Menus, gnugettext;

{$I const.inc}

type

TUserProblem = (upNone, upEmptyPassword, upInvalidPasswordLen, upSkipNameResolve, upUnknown);

TUser = class(TObject)

Username, Host, Password, Cipher, Issuer, Subject: String;

MaxQueries, MaxUpdates, MaxConnections, MaxUserConnections, SSL: Integer;

Problem: TUserProblem;

function HostRequiresNameResolve: Boolean;

end;

PUser = ^TUser;

TUserList = TObjectList<TUser>;

TPrivObj = class(TObject)

GrantCode: String;

DBObj: TDBObject;

OrgPrivs, AddedPrivs, DeletedPrivs: TStringList;

AllPrivileges: TStringList;

Added: Boolean;

public

constructor Create;

destructor Destroy; override;

end;

TPrivObjList = TObjectList<TPrivObj>;

TPrivComparer = class(TComparer<TPrivObj>)

function Compare(const Left, Right: TPrivObj): Integer; override;

end;

EInputError = class(Exception);

TUserManagerForm = class(TExtForm)

btnCancel: TButton;

btnSave: TButton;

pnlLeft: TPanel;

listUsers: TVirtualStringTree;

Splitter1: TSplitter;

pnlRight: TPanel;

tlbObjects: TToolBar;

btnAddObject: TToolButton;

treePrivs: TVirtualStringTree;

btnDiscard: TButton;

lblUsers: TLabel;

ToolBar1: TToolBar;

btnAddUser: TToolButton;

btnDeleteUser: TToolButton;

btnCloneUser: TToolButton;

lblWarning: TLabel;

lblAllowAccessTo: TLabel;

menuHost: TPopupMenu;

menuHost1: TMenuItem;

menuHostLocal4: TMenuItem;

menuHost2: TMenuItem;

menuHost3: TMenuItem;

N1: TMenuItem;

menuPassword: TPopupMenu;

menuPassword1: TMenuItem;

menuPassword2: TMenuItem;

menuPassword3: TMenuItem;

menuPassword4: TMenuItem;

menuPassword5: TMenuItem;

menuDummy1: TMenuItem;

menuDummy2: TMenuItem;

menuDummy3: TMenuItem;

menuDummy4: TMenuItem;

menuDummy5: TMenuItem;

PageControlSettings: TPageControl;

tabCredentials: TTabSheet;

tabLimitations: TTabSheet;

lblUsername: TLabel;

lblFromHost: TLabel;

lblPassword: TLabel;

lblRepeatPassword: TLabel;

editRepeatPassword: TEdit;

editPassword: TButtonedEdit;

editFromHost: TButtonedEdit;

editUsername: TEdit;

lblMaxQueries: TLabel;

lblMaxUpdates: TLabel;

lblMaxConnections: TLabel;

lblMaxUserConnections: TLabel;

editMaxQueries: TEdit;

editMaxUpdates: TEdit;

editMaxConnections: TEdit;

editMaxUserConnections: TEdit;

udMaxQueries: TUpDown;

udMaxUpdates: TUpDown;

udMaxConnections: TUpDown;

udMaxUserConnections: TUpDown;

tabSSL: TTabSheet;

lblCipher: TLabel;

editCipher: TEdit;

lblIssuer: TLabel;

lblSubject: TLabel;

editIssuer: TEdit;

editSubject: TEdit;

comboSSL: TComboBox;

lblSSL: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure btnAddUserClick(Sender: TObject);

procedure btnDeleteUserClick(Sender: TObject);

procedure listUsersFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;

Column: TColumnIndex);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure listUsersBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas);

procedure listUsersGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);

procedure listUsersInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;

var InitialStates: TVirtualNodeInitStates);

procedure listUsersGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;

TextType: TVSTTextType; var CellText: string);

procedure listUsersGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;

Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);

procedure listUsersFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode;

OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean);

procedure btnSaveClick(Sender: TObject);

procedure Modification(Sender: TObject);

procedure treePrivsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;

Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);

procedure treePrivsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;

var InitialStates: TVirtualNodeInitStates);

procedure treePrivsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;

TextType: TVSTTextType; var CellText: string);

procedure treePrivsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode;

var ChildCount: Cardinal);

procedure treePrivsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);

procedure btnDiscardClick(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure btnAddObjectClick(Sender: TObject);

procedure treePrivsExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode);

procedure treePrivsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas;

Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);

procedure listUsersHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);

procedure listUsersCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);

procedure listUsersAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas);

procedure menuHostClick(Sender: TObject);

procedure menuHostPopup(Sender: TObject);

procedure menuPasswordClick(Sender: TObject);

procedure menuPasswordInsert(Sender: TObject);

procedure editPasswordChange(Sender: TObject);

procedure listUsersHotChange(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode);

procedure udMaxQueriesClick(Sender: TObject; Button: TUDBtnType);

procedure comboSSLChange(Sender: TObject);

procedure FormResize(Sender: TObject);

private

{ Private declarations }

FUsers: TUserList;

FModified, FAdded: Boolean;

FCloneGrants: TStringList;

FPrivObjects: TPrivObjList;

FPrivsGlobal, FPrivsDb, FPrivsTable, FPrivsRoutine, FPrivsColumn: TStringList;

FConnection: TDBConnection;

procedure SetModified(Value: Boolean);

property Modified: Boolean read FModified write SetModified;

function GetPrivByNode(Node: PVirtualNode): TPrivObj;

public

{ Public declarations }

end;

function ComparePrivs(List: TStringList; Index1, Index2: Integer): Integer;

implementation

uses

main, selectdbobject;

var

PrivsRead, PrivsWrite, PrivsAdmin: TStringList;

{$R *.DFM}

function ComparePrivs(List: TStringList; Index1, Index2: Integer): Integer;

var

s1, s2: String;

s1val, s2val: Integer;

begin

s1 := List[Index1];

s2 := List[Index2];

s1val := 0;

s2val := 0;

if PrivsRead.IndexOf(s1) > -1 then s1val := 1

else if PrivsWrite.IndexOf(s1) > -1 then s1val := 2

else if PrivsAdmin.IndexOf(s1) > -1 then s1val := 3;

if PrivsRead.IndexOf(s2) > -1 then s2val := 1

else if PrivsWrite.IndexOf(s2) > -1 then s2val := 2

else if PrivsAdmin.IndexOf(s2) > -1 then s2val := 3;

if s1val > s2val then

Result := 1

else if s1val = s2val then

Result := CompareText(s1, s2)

else

Result := -1;

end;

procedure TUserManagerForm.FormCreate(Sender: TObject);

begin

// Restore GUI setup

HasSizeGrip := True;

lblWarning.Font.Color := clRed;

PrivsRead := Explode(',', 'SELECT,SHOW VIEW,SHOW DATABASES,PROCESS,EXECUTE');

PrivsWrite := Explode(',', 'ALTER,CREATE,DROP,DELETE,UPDATE,INSERT,ALTER ROUTINE,CREATE ROUTINE,CREATE TEMPORARY TABLES,'+

'CREATE VIEW,INDEX,TRIGGER,EVENT,REFERENCES,CREATE TABLESPACE');

PrivsAdmin := Explode(',', 'RELOAD,SHUTDOWN,REPLICATION CLIENT,REPLICATION SLAVE,SUPER,LOCK TABLES,GRANT,FILE,CREATE USER,'+

'BINLOG ADMIN,BINLOG REPLAY,CONNECTION ADMIN,FEDERATED ADMIN,READ_ONLY ADMIN,REPLICATION MASTER ADMIN,'+

'REPLICATION SLAVE ADMIN,SET USER');

end;

procedure TUserManagerForm.FormResize(Sender: TObject);

begin

// Manually right align "Add object" button

lblAllowAccessTo.Width := pnlRight.Width - btnAddObject.Width;

end;

procedure TUserManagerForm.FormShow(Sender: TObject);

var

Version, i: Integer;

Users: TDBQuery;

U: TUser;

tmp, PasswordExpr: String;

SkipNameResolve,

HasPassword,

HasAuthString,

PasswordLengthMatters: Boolean;

UserTableColumns: TStringList;

function InitPrivList(Values: String): TStringList;

begin

Result := Explode(',', Values);

Result.Sorted := True; // ensures dupIgnore works

Result.Duplicates := dupIgnore;

end;

begin

Width := AppSettings.ReadIntDpiAware(asUsermanagerWindowWidth, Self);

Height := AppSettings.ReadIntDpiAware(asUsermanagerWindowHeight, Self);

pnlLeft.Width := AppSettings.ReadIntDpiAware(asUsermanagerListWidth, Self);

FixVT(listUsers);

FixVT(treePrivs);

RestoreListSetup(listUsers);

FConnection := Mainform.ActiveConnection;

Version := FConnection.ServerVersionInt;

FPrivsGlobal := InitPrivList('FILE,PROCESS,RELOAD,SHUTDOWN');

FPrivsDb := InitPrivList('');

FPrivsTable := InitPrivList('ALTER,CREATE,DELETE,DROP,GRANT,INDEX');

FPrivsRoutine := InitPrivList('GRANT');

FPrivsColumn := InitPrivList('INSERT,SELECT,UPDATE,REFERENCES');

PasswordLengthMatters := True;

if Version >= 40002 then begin

FPrivsGlobal.Add('REPLICATION CLIENT');

FPrivsGlobal.Add('REPLICATION SLAVE');

FPrivsGlobal.Add('SHOW DATABASES');

FPrivsGlobal.Add('SUPER');

FPrivsDb.Add('CREATE TEMPORARY TABLES');

FPrivsDb.Add('LOCK TABLES');

FPrivsRoutine.Add('EXECUTE');

end;

if Version >= 50001 then begin

FPrivsTable.Add('CREATE VIEW');

FPrivsTable.Add('SHOW VIEW');

end;

if Version >= 50003 then begin

FPrivsGlobal.Add('CREATE USER');

FPrivsDb.Add('CREATE ROUTINE');

FPrivsRoutine.Add('ALTER ROUTINE');

end;

if Version >= 50106 then begin

FPrivsDb.Add('TRIGGER');

FPrivsDb.Add('EVENT');

end;

if Version >= 50404 then begin

FPrivsGlobal.Add('CREATE TABLESPACE');

end;

{ TODO: PROXY priv must be applied with another GRANT syntax:

GRANT PROXY ON 'employee'@'localhost' TO 'external_auth'@'localhost';

if Version >= 50507 then begin

PrivsDb.Add('PROXY');

end;

}

if Version >= 80000 then begin

// MySQL 8 has predefined length of hashed passwords only with

// mysql_native_password plugin enabled users

PasswordLengthMatters := False;

end;

// See https://mariadb.com/kb/en/changes-improvements-in-mariadb-105/#privileges-made-more-granular

if FConnection.Parameters.IsMariaDB and (Version > 100502) then begin

i := FPrivsGlobal.IndexOf('REPLICATION CLIENT');

if i > -1 then

FPrivsGlobal.Delete(i);

FPrivsGlobal.Add('BINLOG ADMIN'); // replaces REPLICATION CLIENT

FPrivsGlobal.Add('BINLOG REPLAY');

FPrivsGlobal.Add('CONNECTION ADMIN');

FPrivsGlobal.Add('FEDERATED ADMIN');

FPrivsGlobal.Add('READ_ONLY ADMIN');

FPrivsGlobal.Add('REPLICATION MASTER ADMIN');

FPrivsGlobal.Add('REPLICATION SLAVE ADMIN');

FPrivsGlobal.Add('SET USER');

end;

FPrivsTable.AddStrings(FPrivsColumn);

FPrivsDb.AddStrings(FPrivsTable);

FPrivsDb.AddStrings(FPrivsRoutine);

FPrivsGlobal.AddStrings(FPrivsDb);

FPrivsGlobal.Sorted := False;

FPrivsGlobal.CustomSort(ComparePrivs);

FPrivsDb.Sorted := False;

FPrivsDb.CustomSort(ComparePrivs);

FPrivsTable.Sorted := False;

FPrivsTable.CustomSort(ComparePrivs);

FPrivsRoutine.Sorted := False;

FPrivsRoutine.CustomSort(ComparePrivs);

FPrivsColumn.Sorted := False;

FPrivsColumn.CustomSort(ComparePrivs);

// Load user@host list

try

tmp := FConnection.GetSessionVariable('skip_name_resolve');

SkipNameResolve := LowerCase(tmp) = 'on';

FConnection.Query('FLUSH PRIVILEGES');

// Peek into user table structure, and find out where the password hash is stored

UserTableColumns := FConnection.GetCol('SHOW COLUMNS FROM '+FConnection.QuoteIdent('mysql')+'.'+FConnection.QuoteIdent('user'));

HasPassword := UserTableColumns.IndexOf('password') > -1;

HasAuthString := UserTableColumns.IndexOf('authentication_string') > -1;

if HasPassword and (not HasAuthString) then

PasswordExpr := 'password'

else if (not HasPassword) and HasAuthString then

PasswordExpr := 'authentication_string'

else if HasPassword and HasAuthString then

PasswordExpr := 'IF(LENGTH(password)>0, password, authentication_string)'

else

Raise Exception.Create(_('No password hash column available'));

PasswordExpr := PasswordExpr + ' AS ' + FConnection.QuoteIdent('password');

Users := FConnection.GetResults(

'SELECT '+FConnection.QuoteIdent('user')+', '+FConnection.QuoteIdent('host')+', '+PasswordExpr+' '+

'FROM '+FConnection.QuoteIdent('mysql')+'.'+FConnection.QuoteIdent('user')

);

FUsers := TUserList.Create(True);

while not Users.Eof do begin

U := TUser.Create;

U.Username := Users.Col('user');

U.Host := Users.Col('host');

U.Password := Users.Col('password');

U.Problem := upNone;

if Length(U.Password) = 0 then

U.Problem := upEmptyPassword;

if PasswordLengthMatters and (not (Length(U.Password) in [0, 16, 41])) then

U.Problem := upInvalidPasswordLen

else if SkipNameResolve and U.HostRequiresNameResolve then

U.Problem := upSkipNameResolve;

FUsers.Add(U);

Users.Next;

end;

listUsers.Clear;

InvalidateVT(listUsers, VTREE_NOTLOADED, False);

FPrivObjects := TPrivObjList.Create(TPrivComparer.Create, True);

Modified := False;

FAdded := False;

listUsers.OnFocusChanged(listUsers, listUsers.FocusedNode, listUsers.FocusedColumn);

except

on E:EDbError do begin

ErrorDialog(E.Message);

// Closing form in OnShow does not work. Instead, do that in listUsers.OnBeforePaint.

end;

end;

end;

procedure TUserManagerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

// Try to unfocus user item. If not done, user clicked "Cancel"

listUsers.FocusedNode := nil;

CanClose := not Assigned(listUsers.FocusedNode);

end;

procedure TUserManagerForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

// Free user list and list of available priv names

FreeAndNil(FUsers);

FreeAndNil(FPrivObjects);

FreeAndNil(FPrivsGlobal);

FreeAndNil(FPrivsDb);

FreeAndNil(FPrivsTable);

FreeAndNil(FPrivsRoutine);

FreeAndNil(FPrivsColumn);

// Save GUI setup

AppSettings.WriteIntDpiAware(asUsermanagerWindowWidth, Self, Width);

AppSettings.WriteIntDpiAware(asUsermanagerWindowHeight, Self, Height);

AppSettings.WriteIntDpiAware(asUsermanagerListWidth, Self, pnlLeft.Width);

SaveListSetup(listUsers);

end;

procedure TUserManagerForm.SetModified(Value: Boolean);

begin

FModified := Value;

btnSave.Enabled := FModified;

btnDiscard.Enabled := FModified and (not FAdded);

listUsers.Invalidate;

end;

procedure TUserManagerForm.Modification(Sender: TObject);

var

User: PUser;

begin

if not Assigned(listUsers.FocusedNode) then

Exit;

if TWinControl(Sender).Parent = tabLimitations then begin

// Any TUpDown triggers a OnChange event on its TEdit when the UpDown gets painted

User := listUsers.GetNodeData(listUsers.FocusedNode);

Modified := Modified

or (editMaxQueries.Text <> IntToStr(User.MaxQueries))

or (editMaxUpdates.Text <> IntToStr(User.MaxUpdates))

or (editMaxConnections.Text <> IntToStr(User.MaxConnections))

or (editMaxUserConnections.Text <> IntToStr(User.MaxUserConnections));

end else begin

Modified := True;

end;

end;

procedure TUserManagerForm.udMaxQueriesClick(Sender: TObject; Button: TUDBtnType);

begin

Modification(Sender);

end;

procedure TUserManagerForm.listUsersAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas);

begin

// Background painting for sorted column

MainForm.AnyGridAfterPaint(Sender, TargetCanvas);

end;

procedure TUserManagerForm.listUsersBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas);

var

VT: TVirtualStringTree;

begin

// Users may have got new or removed ones - reinit nodes.

// If Form.OnShow failed to get the list of users, close form from here.

if not Assigned(FUsers) then

Close

else begin

VT := Sender as TVirtualStringTree;

if VT.Tag = VTREE_NOTLOADED then begin

VT.RootNodeCount := FUsers.Count;

VT.FocusedNode := nil;

VT.ClearSelection;

VT.Tag := VTREE_LOADED;

end;

end;

end;

procedure TUserManagerForm.listUsersFocusChanging(Sender: TBaseVirtualTree; OldNode,

NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean);

begin

// Allow selecting a user? Also, set allowed to false if new node is the same as

// the old one, otherwise OnFocusChanged will be triggered.

Allowed := (NewNode <> OldNode) and (not Assigned(NewNode) or (not (vsDisabled in NewNode.States)));

if Allowed and FModified then begin

case MessageDialog(_('Save modified user?'), mtConfirmation, [mbYes, mbNo, mbCancel]) of

mrYes: begin

btnSave.Click;

Allowed := not FModified;

end;

mrNo: begin

Allowed := True;

if FAdded then

btnDeleteUser.Click;

end;

mrCancel: Allowed := False;

end;

end;

end;

procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;

Column: TColumnIndex);

var

P, Ptmp, PCol: TPrivObj;

User: PUser;

UserHost, RequireClause, WithClause, Msg: String;

Grants, AllPNames, Cols: TStringList;

rxTemp, rxGrant: TRegExpr;

i, j: Integer;

UserSelected: Boolean;

Obj: TDBObject;

begin

// Parse and display privileges of focused user

UserSelected := Assigned(Node);

FPrivObjects.Clear;

Caption := MainForm.actUserManager.Caption;

editUsername.Clear;

editFromHost.Clear;

editPassword.Clear;

editPassword.TextHint := '';

editRepeatPassword.Clear;

udMaxQueries.Position := 0;

udMaxUpdates.Position := 0;

udMaxConnections.Position := 0;

udMaxUserConnections.Position := 0;

comboSSL.ItemIndex := 0;

comboSSL.OnChange(Sender);

editCipher.Clear;

editIssuer.Clear;

editSubject.Clear;

if UserSelected then begin

User := Sender.GetNodeData(Node);

UserHost := FConnection.EscapeString(User.Username)+'@'+FConnection.EscapeString(User.Host);

editUsername.Text := User.Username;

editFromHost.Text := User.Host;

Caption := Caption + ' - ' + User.Username;

AllPNames := TStringList.Create;

AllPNames.AddStrings(FPrivsGlobal);

AllPNames.AddStrings(FPrivsDb);

AllPNames.AddStrings(FPrivsTable);

AllPNames.AddStrings(FPrivsRoutine);

AllPNames.AddStrings(FPrivsColumn);

// New or existing user mode

if FAdded then begin

if Assigned(FCloneGrants) then begin

Grants := TStringList.Create;

Grants.AddStrings(FCloneGrants);

end else begin

Grants := TStringList.Create;

Grants.Add('GRANT USAGE ON *.* TO '+UserHost);

end;

end else try

Grants := FConnection.GetCol('SHOW GRANTS FOR '+FConnection.EscapeString(User.Username)+'@'+FConnection.EscapeString(User.Host));

except

on E:EDbError do begin

Msg := E.Message;

if FConnection.LastErrorCode = ER_NONEXISTING_GRANT then begin

// Disable this user node lately, for old server which do not show skip-name-resolve variable

Msg := Msg + CRLF + CRLF + f_('Starting the server without %s may solve this issue.', ['--skip-name-resolve']);

User.Problem := upUnknown;

Node.States := Node.States + [vsDisabled];

end;

MessageDialog(Msg, mtError, [mbOK]);

FModified := False;

SelectNode(listUsers, nil);

Exit;

end;

end;

{ GRANT USAGE ON *.* TO 'newbie'@'%' IDENTIFIED BY PASSWORD '*99D8973ECC09819DF81624F051BFF4FC6695140B' REQUIRE (NONE | ssl_option [[AND] ssl_option] ...) WITH GRANT OPTION

GRANT SELECT ON `avtoserver`.* TO 'newbie'@'%'

GRANT SELECT, SELECT (Enter (column) name), INSERT, INSERT (Enter (column) name), UPDATE, UPDATE (Enter (column) name), DELETE, CREATE ON `avtoserver`.`avtomodel` TO 'newbie'@'%'

GRANT EXECUTE, ALTER ROUTINE ON PROCEDURE `pulle`.`f_procedure` TO 'newbie'@'%' }

rxTemp := TRegExpr.Create;

rxTemp.ModifierI := True;

rxGrant := TRegExpr.Create;

rxGrant.ModifierI := True;

rxGrant.Expression := '^GRANT\s+(.+)\s+ON\s+((TABLE|FUNCTION|PROCEDURE)\s+)?(\*|[`"]([^`"]+)[`"])\.(\*|[`"]([^`"]+)[`"])\s+TO\s+\S+(\s+IDENTIFIED\s+BY\s+(PASSWORD)?\s+''?([^'']+)''?)?(\s+.+)?$';

for i:=0 to Grants.Count-1 do begin

// Find selected priv objects via regular expression

if rxGrant.Exec(Grants[i]) then begin

P := TPrivObj.Create;

P.GrantCode := Grants[i];

P.Added := FAdded;

FPrivObjects.Add(P);

if (rxGrant.Match[4] = '*') and (rxGrant.Match[6] = '*') then begin

P.DBObj.NodeType := lntNone;

P.AllPrivileges := FPrivsGlobal;

// http://dev.mysql.com/doc/refman/5.7/en/show-grants.html

// As of MySQL 5.7.6, SHOW GRANTS output does not include IDENTIFIED BY PASSWORD clauses.

// Use the SHOW CREATE USER statement instead. See Section 14.7.5.12, "SHOW CREATE USER Syntax".

if (FConnection.Parameters.IsMySQL(False) and (FConnection.ServerVersionInt < 50706))

or (not FConnection.Parameters.IsMySQL(False)) then begin

if not FAdded then begin

editPassword.TextHint := FConnection.UnescapeString(rxGrant.Match[10]);

// Set password for changed user, to silence the error message about invalid length

User.Password := editPassword.TextHint;

end else begin

// Set password for cloned user

User.Password := FConnection.UnescapeString(rxGrant.Match[10]);

editPassword.Text := User.Password;

editRepeatPassword.Text := User.Password;

editPassword.Modified := True;

end;

end;

end else if (rxGrant.Match[6] = '*') then begin

P.DBObj.NodeType := lntDb;

P.DBObj.Database := rxGrant.Match[5];

P.AllPrivileges := FPrivsDb;

end else begin

P.DBObj.Database := rxGrant.Match[5];

P.DBObj.Name := rxGrant.Match[7];

if UpperCase(rxGrant.Match[3]) = 'FUNCTION' then begin

P.DBObj.NodeType := lntFunction;

P.AllPrivileges := FPrivsRoutine;

end else if (UpperCase(rxGrant.Match[3]) = 'PROCEDURE') then begin

P.DBObj.NodeType := lntProcedure;

P.AllPrivileges := FPrivsRoutine;

end else begin

Obj := P.DBObj.Connection.FindObject(P.DBObj.Database, P.DBObj.Name);

if (Obj <> nil) and (Obj.NodeType = lntView) then

P.DBObj.NodeType := lntView

else

P.DBObj.NodeType := lntTable;

P.AllPrivileges := FPrivsTable;

end;

end;

// Find selected privileges

{ USAGE

SELECT, SELECT (id, colname), INSERT, INSERT (id, colname), UPDATE, UPDATE (colname), DELETE, CREATE

EXECUTE, ALTER ROUTINE }

if rxGrant.Match[1] = 'ALL PRIVILEGES' then begin

P.OrgPrivs.AddStrings(P.AllPrivileges);

P.OrgPrivs.Delete(P.OrgPrivs.IndexOf('GRANT'));

end else begin

rxTemp.Expression := '\b('+Implode('|', AllPnames)+')(\s+\(([^\)]+)\))?,';

if rxTemp.Exec(rxGrant.Match[1]+',') then while True do begin

if rxTemp.Match[3] = '' then

P.OrgPrivs.Add(rxTemp.Match[1])

else begin

// Find previously created column priv or create new one

Cols := Explode(',', rxTemp.Match[3]);

for j:=0 to Cols.Count-1 do begin

PCol := nil;

for Ptmp in FPrivObjects do begin

if (Ptmp.DBObj.NodeType=lntColumn)

and (Ptmp.DBObj.Database=P.DBObj.Database)

and (Ptmp.DBObj.Name=P.DBObj.Name)

and (Ptmp.DBObj.Column=Trim(Cols[j])) then begin

PCol := Ptmp;

break;

end;

end;

if PCol = nil then begin

PCol := TPrivObj.Create;

PCol.DBObj.NodeType := lntColumn;

PCol.DBObj.Database := P.DBObj.Database;

PCol.DBObj.Name := P.DBObj.Name;

PCol.DBObj.Column := Trim(Cols[j]);

PCol.AllPrivileges := FPrivsColumn;

FPrivObjects.Add(PCol);

end;

PCol.OrgPrivs.Add(rxTemp.Match[1]);

PCol.GrantCode := PCol.GrantCode + rxTemp.Match[1] + ' ('+Trim(Cols[j])+')' + ', ';

end;

Cols.Free;

end;

if not rxTemp.ExecNext then

break;

end;

end;

// REQUIRE SSL X509 ISSUER '456' SUBJECT '789' CIPHER '123' NONE

rxTemp.Expression := '\sREQUIRE\s+(.+)';

if rxTemp.Exec(rxGrant.Match[11]) then begin

RequireClause := rxTemp.Match[1];

User.SSL := 0;

User.Cipher := '';

User.Issuer := '';

User.Subject := '';

rxTemp.Expression := '\bSSL\b';

if rxTemp.Exec(RequireClause) then

User.SSL := 1;

rxTemp.Expression := '\bX509\b';

if rxTemp.Exec(RequireClause) then

User.SSL := 2;

rxTemp.Expression := '\bCIPHER\s+''([^'']+)';

if rxTemp.Exec(RequireClause) then

User.Cipher := rxTemp.Match[1];

rxTemp.Expression := '\bISSUER\s+''([^'']+)';

if rxTemp.Exec(RequireClause) then

User.Issuer := rxTemp.Match[1];

rxTemp.Expression := '\bSUBJECT\s+''([^'']+)';

if rxTemp.Exec(RequireClause) then

User.Subject := rxTemp.Match[1];

if IsNotEmpty(User.Cipher) or IsNotEmpty(User.Issuer) or IsNotEmpty(User.Subject) then

User.SSL := 3;

comboSSL.ItemIndex := User.SSL;

comboSSL.OnChange(Sender);

editCipher.Text := User.Cipher;

editIssuer.Text := User.Issuer;

editSubject.Text := User.Subject;

end;

// WITH .. GRANT OPTION

// MAX_QUERIES_PER_HOUR 20 MAX_UPDATES_PER_HOUR 10 MAX_CONNECTIONS_PER_HOUR 5 MAX_USER_CONNECTIONS 2

rxTemp.Expression := '\sWITH\s+(.+)';

if rxTemp.Exec(rxGrant.Match[11]) then begin

WithClause := rxTemp.Match[1];

if ExecRegExpr('\bGRANT\s+OPTION\b', WithClause) then

P.OrgPrivs.Add('GRANT');

rxTemp.Expression := '\bMAX_QUERIES_PER_HOUR\s+(\d+)\b';

if rxTemp.Exec(WithClause) then

User.MaxQueries := MakeInt(rxTemp.Match[1]);

rxTemp.Expression := '\bMAX_UPDATES_PER_HOUR\s+(\d+)\b';

if rxTemp.Exec(WithClause) then

User.MaxUpdates := MakeInt(rxTemp.Match[1]);

rxTemp.Expression := '\bMAX_CONNECTIONS_PER_HOUR\s+(\d+)\b';

if rxTemp.Exec(WithClause) then

User.MaxConnections := MakeInt(rxTemp.Match[1]);

rxTemp.Expression := '\bMAX_USER_CONNECTIONS\s+(\d+)\b';

if rxTemp.Exec(WithClause) then

User.MaxUserConnections := MakeInt(rxTemp.Match[1]);

udMaxQueries.Position := User.MaxQueries;

udMaxUpdates.Position := User.MaxUpdates;

udMaxConnections.Position := User.MaxConnections;

udMaxUserConnections.Position := User.MaxUserConnections;

end;

if (P.OrgPrivs.Count = 0) and (P.DBObj.NodeType = lntTable) then

FPrivObjects.Remove(P);

end;

end;

// Generate grant code for column privs by hand

for Ptmp in FPrivObjects do begin

if Ptmp.DBObj.NodeType = lntColumn then begin

Ptmp.GrantCode := 'GRANT ' + Copy(Ptmp.GrantCode, 1, Length(Ptmp.GrantCode)-2) + ' ON ' +

Ptmp.DBObj.QuotedDatabase + '.' +

Ptmp.DBObj.QuotedName +

' TO ' + UserHost;

end;

// Flag all privs as added, so "Save" action applies them

if Assigned(FCloneGrants) then

Ptmp.AddedPrivs.AddStrings(Ptmp.OrgPrivs);

end;

FPrivObjects.Sort;

rxGrant.Free;

rxTemp.Free;

FreeAndNil(Grants);

FreeAndNil(FCloneGrants);

FreeAndNil(AllPnames);

end;

// Populate privilege tree

Modified := False;

treePrivs.FocusedNode := nil;

treePrivs.Clear;

treePrivs.RootNodeCount := FPrivObjects.Count;

treePrivs.ReinitNode(nil, True);

treePrivs.Invalidate;

// Enable input boxes

lblUsername.Enabled := UserSelected;

editUsername.Enabled := UserSelected;

lblFromHost.Enabled := UserSelected;

editFromHost.Enabled := UserSelected;

lblPassword.Enabled := UserSelected;

editPassword.Enabled := UserSelected;

lblRepeatPassword.Enabled := UserSelected;

editRepeatPassword.Enabled := UserSelected;

tabCredentials.Enabled := UserSelected;

lblMaxQueries.Enabled := UserSelected and (FConnection.ServerVersionInt >= 40002);

tabLimitations.Enabled := UserSelected;

editMaxQueries.Enabled := lblMaxQueries.Enabled;

udMaxQueries.Enabled := lblMaxQueries.Enabled;

lblMaxUpdates.Enabled := lblMaxQueries.Enabled;

editMaxUpdates.Enabled := lblMaxQueries.Enabled;

udMaxUpdates.Enabled := lblMaxQueries.Enabled;

lblMaxConnections.Enabled := lblMaxQueries.Enabled;

editMaxConnections.Enabled := lblMaxQueries.Enabled;

udMaxConnections.Enabled := lblMaxQueries.Enabled;

lblMaxUserConnections.Enabled := UserSelected and (FConnection.ServerVersionInt >= 50003);

editMaxUserConnections.Enabled := lblMaxUserConnections.Enabled;

udMaxUserConnections.Enabled := lblMaxUserConnections.Enabled;

tabSSL.Enabled := UserSelected;

comboSSL.Enabled := UserSelected;

btnAddObject.Enabled := UserSelected;

btnDeleteUser.Enabled := UserSelected;

btnCloneUser.Enabled := UserSelected and (not FAdded);

// Ensure the warning hint is displayed or cleared. This is not done when the dialog shows up.

listUsers.OnHotChange(Sender, nil, Node);

end;

procedure TUserManagerForm.listUsersGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;

Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);

var

User: PUser;

begin

if Column <> 0 then

Exit;

case Kind of

ikNormal, ikSelected: ImageIndex := 43;

ikOverlay: begin

User := Sender.GetNodeData(Node);

if User.Password = '' then

ImageIndex := 161;

if FModified and (Node = Sender.FocusedNode) then

ImageIndex := 162;

end;

end;

end;

procedure TUserManagerForm.listUsersGetNodeDataSize(Sender: TBaseVirtualTree;

var NodeDataSize: Integer);

begin

NodeDataSize := SizeOf(TUser);

end;

procedure TUserManagerForm.listUsersGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;

Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);

var

User: PUser;

begin

if not Assigned(FUsers) then

Exit;

User := Sender.GetNodeData(Node);

case Column of

0: CellText := User.Username;

1: CellText := User.Host;

end;

end;

procedure TUserManagerForm.listUsersHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);

begin

Mainform.AnyGridHeaderClick(Sender, HitInfo);

end;

procedure TUserManagerForm.listUsersHotChange(Sender: TBaseVirtualTree; OldNode,

NewNode: PVirtualNode);

var

Node: PVirtualNode;

User: PUser;

Msg: String;

begin

// Display warning hint for problematic stuff in the lower left corner.

Node := NewNode;

if not Assigned(Node) then

Node := Sender.FocusedNode;

Msg := '';

if Assigned(Node) then begin

User := Sender.GetNodeData(Node);

Msg := '';

case User.Problem of

upEmptyPassword:

Msg := _('This user has an empty password.');

upInvalidPasswordLen:

Msg := f_('This user is inactive due to an invalid length of its encrypted password. Please fix that in the %s table.', ['mysql.user']);

upSkipNameResolve:

Msg := f_('This user is inactive due to having a host name, while the server runs with %s.', ['--skip-name-resolve']);

upUnknown:

Msg := _('This user is inactive due to some unknown reason.');

end;

end;

lblWarning.Caption := Msg;

end;

procedure TUserManagerForm.listUsersCompareNodes(Sender: TBaseVirtualTree;

Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);

begin

Mainform.AnyGridCompareNodes(Sender, Node1, Node2, Column, Result);

end;

procedure TUserManagerForm.listUsersInitNode(Sender: TBaseVirtualTree; ParentNode,

Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);

var

User: PUser;

begin

User := Sender.GetNodeData(Node);

User^ := FUsers[Node.Index];

if not (User.Problem in [upNone, upEmptyPassword]) then

Include(InitialStates, ivsDisabled);

end;

function TUserManagerForm.GetPrivByNode(Node: PVirtualNode): TPrivObj;

begin

// Return priv object by node

if treePrivs.GetNodeLevel(Node) = 0 then

Result := FPrivObjects[Node.Index]

else

Result := FPrivObjects[Node.Parent.Index];

end;

procedure TUserManagerForm.treePrivsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);

var

P: TPrivObj;

idxO, idxA, idxD: Integer;

PrivName: String;

begin

// Checked some privilege check box

case Sender.GetNodeLevel(Node) of

0: begin

Sender.Expanded[Node] := True;

Sender.Invalidate;

end;

1: begin

Modification(Sender);

P := GetPrivByNode(Node);

PrivName := P.AllPrivileges[Node.Index];

idxO := P.OrgPrivs.IndexOf(PrivName);

idxA := P.AddedPrivs.IndexOf(PrivName);

idxD := P.DeletedPrivs.IndexOf(PrivName);

if idxA > -1 then

P.AddedPrivs.Delete(idxA);

if idxD > -1 then

P.DeletedPrivs.Delete(idxD);

if (Node.CheckState in CheckedStates) and (idxO = -1) then

P.AddedPrivs.Add(PrivName);

if (not (Node.CheckState in CheckedStates)) and (idxO > -1) then

P.DeletedPrivs.Add(PrivName);

end;

end;

end;

procedure TUserManagerForm.treePrivsExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode);

var

n: PVirtualNode;

begin

// Collapse all uninvolved tree nodes, keeping the tree usable

n := Sender.GetFirstChild(Node.Parent);

while Assigned(n) do begin

Sender.Expanded[n] := n = Node;

n := Sender.GetNextSibling(n);

end;

// Init out-of-view children of expanded node, to keep checked state in sync.

// Note that ReinitChildren is limited to visible nodes only, which we don't want here.

Sender.InitRecursive(Node, 1, False);

end;

procedure TUserManagerForm.treePrivsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;

Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);

begin

// Icon for privilege

if Sender.GetNodeLevel(Node) <> 0 then

Exit;

case Kind of

ikNormal, ikSelected:

ImageIndex := FPrivObjects[Node.Index].DBObj.ImageIndex;

ikOverlay: begin

if FPrivObjects[Node.Index].Added then

ImageIndex := 163;

end;

end;

end;

procedure TUserManagerForm.treePrivsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;

Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);

var

p: TPrivObj;

begin

// Display priv object text

p := GetPrivByNode(Node);

case Sender.GetNodeLevel(Node) of

0: begin

case p.DBObj.NodeType of

lntNone:

CellText := _('Global privileges');

lntDb:

CellText := _('Database')+': '+p.DBObj.Database;

lntTable, lntView, lntProcedure, lntFunction:

CellText := p.DBObj.ObjType+': '+p.DBObj.Database+'.'+p.DBObj.Name;

lntColumn:

CellText := p.DBObj.ObjType+': '+p.DBObj.Database+'.'+p.DBObj.Name+'.'+p.DBObj.Column;

end;

end;

1: CellText := p.AllPrivileges[Node.Index];

end;