unit usermanager;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,

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

dbconnection, dbstructures, dbstructures.mysql, apphelpers, VirtualTrees.BaseTree, VirtualTrees.Types, VirtualTrees, VirtualTrees.EditLink, Vcl.Menus, gnugettext,

VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL, StrUtils, Vcl.Grids,

Vcl.ValEdit;

{$I const.inc}

type

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;

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

TUser = class(TObject)

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

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

Problem: TUserProblem;

IsRole: Boolean;

Roles: TStringList;

public

class var RoleNo: String;

class var RoleYes: String;

class var RoleYesAdmin: String;

constructor Create;

destructor Destroy; override;

function HostRequiresNameResolve: Boolean;

procedure ParseSettings(GrantOrCreate: String; Priv: TPrivObj);

function IsUser: Boolean;

function AssignedRolesCount: Integer;

end;

PUser = ^TUser;

TUserList = class(TObjectList<TUser>)

public

function GetRoleNames: TStringList; overload;

procedure GetRoleNames(Strings: TStrings); overload;

function GetDefaultRoles(ExcludeRole: TUser): TStringList;

end;

EInputError = class(Exception);

TUserManagerForm = class(TExtForm)

btnCancel: TButton;

btnSave: TButton;

comboPlugins: TComboBox;

lblPasswordHint: TLabel;

lblPlugin: TLabel;

pnlLeft: TPanel;

listUsers: TVirtualStringTree;

Splitter1: TSplitter;

pnlRight: TPanel;

btnDiscard: TButton;

lblUsers: TLabel;

ToolBar1: TToolBar;

btnAddUser: TToolButton;

btnDeleteUser: TToolButton;

btnCloneUser: TToolButton;

lblWarning: 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;

editFilterUsers: TButtonedEdit;

menuAdd: TPopupMenu;

menuItemUser: TMenuItem;

menuItemRole: TMenuItem;

PageControlAccess: TPageControl;

tabPrivileges: TTabSheet;

tabRoles: TTabSheet;

treePrivs: TVirtualStringTree;

tlbObjects: TToolBar;

btnAddObject: TToolButton;

ValueListEditorRoles: TValueListEditor;

lblDefaultRole: TLabel;

comboDefaultRole: TComboBox;

procedure comboPluginsChange(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure menuItemUserClick(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 editFilterUsersRightButtonClick(Sender: TObject);

procedure editFilterUsersChange(Sender: TObject);

procedure menuItemRoleClick(Sender: TObject);

procedure menuAddPopup(Sender: TObject);

procedure ValueListEditorRolesGetPickList(Sender: TObject;

const KeyName: string; Values: TStrings);

procedure ValueListEditorRolesSetEditText(Sender: TObject; ACol,

ARow: LongInt; const Value: string);

private

{ Private declarations }

FUsers: TUserList;

FModified, FAdded, FPluginModified: Boolean;

FHasIsRole, FHasDefaultRole: Boolean;

FHasPlugin: Boolean;

FPlugins: TStringList;

FCloneGrants: TStringList;

FPrivObjects: TPrivObjList;

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

FConnection: TDBConnection;

FColorReadPriv, FColorWritePriv, FColorAdminPriv: TColor;

FSQLPluginPrefix, FSQLPluginPassPrefix: String;

procedure SetModified(Value: Boolean);

procedure SetPluginModified(Value: Boolean);

property Modified: Boolean read FModified write SetModified;

property PluginModified: Boolean read FPluginModified write SetPluginModified;

function GetPrivByNode(Node: PVirtualNode): TPrivObj;

function SelectUserNode(User: TUser): Boolean;

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,DELETE HISTORY');

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,SLAVE MONITOR');

FixVT(listUsers);

FixVT(treePrivs);

FHasIsRole := False;

FHasDefaultRole := False;

menuItemUser.ImageIndex := ICONINDEX_USER;

menuItemRole.ImageIndex := ICONINDEX_ROLE;

end;

procedure TUserManagerForm.comboPluginsChange(Sender: TObject);

begin

PluginModified := True;

Modification(Sender);

end;

procedure TUserManagerForm.FormShow(Sender: TObject);

var

Version, i: Integer;

Users: TDBQuery;

U: TUser;

tmp, PasswordExpr, IsRoleExpr, DefaultRoleExpr, PluginExpr: String;

SkipNameResolve,

HasPassword, HasAuthString: Boolean;

PasswordLengthMatters, PasswordLengthValid: 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);

RestoreListSetup(listUsers);

FColorReadPriv := clGreen;

FColorWritePriv := clMaroon;

FColorAdminPriv := clNavy;

if ThemeIsDark then begin

FColorReadPriv := ColorAdjustBrightness(FColorReadPriv, 128);

FColorWritePriv := ColorAdjustBrightness(FColorWritePriv, 128);

FColorAdminPriv := ColorAdjustBrightness(FColorAdminPriv, 128);

end;

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');

FSQLPluginPrefix := IfThen(FConnection.Parameters.IsMariaDB, 'VIA', 'WITH');

FSQLPluginPassPrefix := IfThen(FConnection.Parameters.IsMariaDB, 'USING', 'BY');

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;

}

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

if FConnection.Parameters.IsMariaDB then begin

if 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;

if Version >= 100509 then begin

FPrivsGlobal.Add('SLAVE MONITOR');

end;

if Version >= 100304 then begin

FPrivsGlobal.Add('DELETE HISTORY');

end;

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';

// 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;

FHasIsRole := UserTableColumns.IndexOf('is_role') > -1;

FHasDefaultRole := UserTableColumns.IndexOf('default_role') > -1;

FHasPlugin := UserTableColumns.IndexOf('plugin') > -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');

IsRoleExpr := IfThen(FHasIsRole, 'is_role', FConnection.EscapeString('N')+' AS is_role');

DefaultRoleExpr := IfThen(FHasDefaultRole, 'default_role', FConnection.EscapeString('')+' AS default_role');

PluginExpr := IfThen(FHasPlugin, 'plugin', FConnection.EscapeString('')+' AS plugin');

if FConnection.SqlProvider.Has(qGetAuthPlugins) then

FPlugins := FConnection.GetCol(FConnection.SqlProvider.GetSql(qGetAuthPlugins))

else

FPlugins := TStringList.Create;

Users := FConnection.GetResults(

'SELECT '+

FConnection.QuoteIdent('user') + ', ' +

FConnection.QuoteIdent('host') + ', ' +

PasswordExpr + ', ' +

IsRoleExpr + ', ' +

DefaultRoleExpr + ', ' +

PluginExpr + ' ' +

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

);

FUsers := TUserList.Create(True);

ValueListEditorRoles.Strings.Clear;

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.IsRole := UpperCase(Users.Col('is_role')) = 'Y';

U.DefaultRole := Users.Col('default_role');

U.Plugin := Users.Col('plugin');

U.Problem := upNone;

if U.IsUser then begin

if Length(U.Password) = 0 then

U.Problem := upEmptyPassword;

PasswordLengthMatters := ExecRegExpr('(mysql_native_password|mysql_old_password)', U.Plugin) or (not FHasPlugin);

PasswordLengthValid := Byte(Length(U.Password)) in [0, 16, 41];

if PasswordLengthMatters and (not PasswordLengthValid) then

U.Problem := upInvalidPasswordLen

else if SkipNameResolve and U.HostRequiresNameResolve then

U.Problem := upSkipNameResolve;

end;

FUsers.Add(U);

Users.Next;

end;

listUsers.Clear;

InvalidateVT(listUsers, VTREE_NOTLOADED, False);

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

Modified := False;

PluginModified := False;

FAdded := False;

tabRoles.TabVisible := FHasIsRole;

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.SetPluginModified(Value: Boolean);

var

User: PUser;

begin

if not Assigned(listUsers.FocusedNode) then

Exit;

FPluginModified := Value;

if not FAdded then begin

lblPasswordHint.Visible := FPluginModified;

if Value then begin

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

User.Password := '';

editPassword.TextHint := '';

end;

end;

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.ValueListEditorRolesGetPickList(Sender: TObject;

const KeyName: string; Values: TStrings);

begin

Values.Add(TUser.RoleNo);

Values.Add(TUser.RoleYes);

Values.Add(TUser.RoleYesAdmin);

end;

procedure TUserManagerForm.ValueListEditorRolesSetEditText(Sender: TObject;

ACol, ARow: LongInt; const Value: string);

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;

Modified := False;

PluginModified := False;

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, UserHostRx, Msg, CreateUser, RxQuotes: String;

Grants, AllPNames, Cols, RoleNames, DefaultRoles: TStringList;

rxTemp, rxGrant: TRegExpr;

i, j: Integer;

UserSelected: Boolean;

Obj: TDBObject;

begin

// Parse and display privileges of focused user

listUsers.TrySetFocus; // Steal focus from roles, prevents empty cell bug

UserSelected := Assigned(Node);

User := nil;

FPrivObjects.Clear;

Caption := MainForm.actUserManager.Caption;

// Credentials tab

editUsername.Clear;

editFromHost.Clear;

editPassword.Clear;

editPassword.TextHint := '';

editRepeatPassword.Clear;

comboPlugins.Items.Clear;

comboPlugins.Items.Add(_('None'));

comboPlugins.Items.AddStrings(FPlugins);

comboPlugins.ItemIndex := 0;

comboDefaultRole.Items.Clear;

comboDefaultRole.Items.Add(_('None'));

FUsers.GetRoleNames(comboDefaultRole.Items);

comboDefaultRole.ItemIndex := 0;

// Limitations tab

udMaxQueries.Position := 0;

udMaxUpdates.Position := 0;

udMaxConnections.Position := 0;

udMaxUserConnections.Position := 0;

// SSL tab

comboSSL.ItemIndex := 0;

comboSSL.OnChange(Sender);

editCipher.Clear;

editIssuer.Clear;

editSubject.Clear;

// Page control

tabPrivileges.Caption := _('Privileges');

tabRoles.Caption := _('Roles');

// All possible quote chars, escaped for RegExpr. Todo: use in all relevant expressions.

RxQuotes := '['+QuoteRegExprMetaChars(FConnection.QuoteChars + FConnection.StringQuoteChar)+']';

if UserSelected then begin

User := Sender.GetNodeData(Node);

UserHost := FConnection.EscapeString(User.Username);

UserHostRx := RxQuotes + '?' + QuoteRegExprMetaChars(User.Username) + RxQuotes + '?';

if User.IsUser then begin

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

UserHostRx := UserHostRx + '@' + RxQuotes + '?' + QuoteRegExprMetaChars(User.Host) + RxQuotes + '?';

end;

editUsername.Text := User.Username;

editFromHost.Text := User.Host;

i := comboPlugins.Items.IndexOf(User.Plugin);

if i > -1 then

comboPlugins.ItemIndex := i;

i := comboDefaultRole.Items.IndexOf(User.DefaultRole);

if i > -1 then

comboDefaultRole.ItemIndex := i;

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 '+UserHost);

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;

FPluginModified := 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 := FConnection.DeQuoteIdent(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;

User.ParseSettings(rxGrant.Match[11], P);

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

FPrivObjects.Remove(P);

end;

end;

// Find roles assigned to user or role:

// GRANT role_admin TO 'root'@'127.0.0.1';

// GRANT 'role space' TO 'root'@'127.0.0.1';

// GRANT role_space to 'role_admin' WITH ADMIN OPTION;

DefaultRoles := FUsers.GetDefaultRoles(User^);

User.Roles.Assign(DefaultRoles);

RoleNames := FUsers.GetRoleNames;

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

RoleNames[i] := QuoteRegExprMetaChars(RoleNames[i]);

end;

rxGrant.Expression := '^GRANT\s+'+RxQuotes+'?('+Implode('|', RoleNames)+')'+RxQuotes+'?\s+'+

'TO\s+'+UserHostRx+'(\s+WITH ADMIN OPTION)?$';

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

// Find selected priv objects via regular expression

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

Continue;

end;

j := User.Roles.IndexOfName(rxGrant.Match[1]);

if j > -1 then begin

if rxGrant.MatchLen[2] > 0 then

User.Roles.ValueFromIndex[j] := User.RoleYesAdmin

else

User.Roles.ValueFromIndex[j] := User.RoleYes;

end;

end;

ValueListEditorRoles.BeginUpdate;

ValueListEditorRoles.Strings.Assign(User.Roles);

ValueListEditorRoles.EndUpdate;

DefaultRoles.Free;

// Parse general user options

CreateUser := '';

if User.IsUser then try

CreateUser := FConnection.GetVar('SHOW CREATE USER '+UserHost);

User.ParseSettings(CreateUser, nil);

except

on E:EDbError do;

end;

udMaxQueries.Position := User.MaxQueries;

udMaxUpdates.Position := User.MaxUpdates;

udMaxConnections.Position := User.MaxConnections;

udMaxUserConnections.Position := User.MaxUserConnections;

comboSSL.ItemIndex := User.SSL;

comboSSL.OnChange(comboSSL);

editCipher.Text := User.Cipher;

editIssuer.Text := User.Issuer;

editSubject.Text := User.Subject;

tabPrivileges.Caption := _('Privileges') + ' (' + FPrivObjects.Count.ToString + ')';

tabRoles.Caption := _('Roles') + ' (' + User.AssignedRolesCount.ToString + ')';

// 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;

PluginModified := False;

treePrivs.FocusedNode := nil;

treePrivs.Clear;

treePrivs.RootNodeCount := FPrivObjects.Count;

treePrivs.InvalidateChildren(nil, True);

treePrivs.Invalidate;

// Enable input boxes

lblUsername.Enabled := UserSelected and User.IsUser;

editUsername.Enabled := UserSelected and User.IsUser;

lblFromHost.Enabled := UserSelected and User.IsUser;

editFromHost.Enabled := UserSelected and User.IsUser;

lblPassword.Enabled := UserSelected and User.IsUser;

editPassword.Enabled := UserSelected and User.IsUser;

lblRepeatPassword.Enabled := UserSelected and User.IsUser;

editRepeatPassword.Enabled := UserSelected and User.IsUser;

comboPlugins.Enabled := UserSelected and User.IsUser and FHasPlugin;

lblPlugin.Enabled := comboPlugins.Enabled;

comboDefaultRole.Enabled := UserSelected and User.IsUser and FHasDefaultRole;

lblDefaultRole.Enabled := comboDefaultRole.Enabled;

tabCredentials.Enabled := UserSelected;

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

tabLimitations.Enabled := UserSelected and User.IsUser;

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 User.IsUser and (FConnection.ServerVersionInt >= 50003);

editMaxUserConnections.Enabled := lblMaxUserConnections.Enabled;

udMaxUserConnections.Enabled := lblMaxUserConnections.Enabled;

tabSSL.Enabled := UserSelected and User.IsUser;

comboSSL.Enabled := UserSelected and User.IsUser;

btnAddObject.Enabled := UserSelected;

btnDeleteUser.Enabled := UserSelected;

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

// 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;

User := Sender.GetNodeData(Node);

case Kind of

ikNormal, ikSelected: begin

if User.IsUser then

ImageIndex := ICONINDEX_USER

else

ImageIndex := ICONINDEX_ROLE;

end;

ikOverlay: begin

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);