source: trunk/Packages/CoolWeb/Modules/WebUser.pas

unit WebUser;

interface

uses
  Classes, SysUtils, synacode, SqlDatabase, Common, HTTPServer, Generics;

const
  AnonymousUserId = 1;

type
  EDuplicateItem = class(Exception);
  ENotFound = class(Exception);

  { TWebUser }

  TWebUser = class
    Id: Integer;
    Name: string;
    FullName: string;
    Email: string;
    Database: TSqlDatabase;
    HandlerData: THTTPHandlerData;
    procedure Save;
    procedure Delete(Id: Integer);
    procedure Add(Name, Password, Email: string);
    function GetIdByName(Name: string): Integer;
    function GetIdByNamePassword(Name: string; PassWord: string): Integer;
    procedure Load;
    function CheckPermission(Module, Operation: string; ItemType: string = '';
      ItemId: Integer = 0): Boolean;
    function CheckGroupPermission(Group, Operation: Integer): Boolean;
  end;

  { TWebOnlineUser }

  TWebOnlineUser = class
    Database: TSqlDatabase;
    HandlerData: THTTPHandlerData;
    Id: Integer;
    User: Integer;
    procedure Update;
    procedure Login(User: Integer);
    procedure Logout;
  end;


implementation

resourcestring
  SDuplicateUserItem = 'User name "%s" already used.';
  SEmptyUserParameters = 'Missing user parameters';
  SUserNotFound = 'User "%s" not found';

{ TOnlineUser }

procedure TWebOnlineUser.Update;
var
  DbRows: TDbRows;
  Id: Integer;
  Value: string;
begin
  try
    DbRows := TDbRows.Create;
    if HandlerData.Request.Cookies.TryGetValue('SessionId', Value) then begin
    Database.Query(DbRows, 'SELECT * FROM `UserOnline` WHERE `SessionId`="' +
      Value + '"');
    if DbRows.Count > 0 then begin
      // Update exited
      Id := StrToInt(DbRows[0].Items['Id']);
      User := StrToInt(DbRows[0].Items['User']);
      Database.Query(DbRows, 'UPDATE `UserOnline` SET `ActivityTime` = NOW() WHERE `Id`=' + IntToStr(Id));
    end else begin
      // Create new record
      Database.Query(DbRows, 'INSERT INTO `UserOnline` (`User`, `ActivityTime`, `SessionId`, `ScriptName`) ' +
        'VALUES (1, NOW(), "' + Value + '", "")');
      Id := Database.LastInsertId;
      User := 1;
    end;

    end;
  finally
    DbRows.Free;
  end;
end;

procedure TWebOnlineUser.Login(User: Integer);
var
  DbRows: TDbRows;
  SessionId: string;
begin
  Logout;
  if HandlerData.Request.Cookies.TryGetValue('SessionId', SessionId) then
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'UPDATE `UserOnline` SET `User` = ' + IntToStr(User) + ', `LoginTime` = NOW() WHERE `SessionId`="' +
      SessionId + '"');
  finally
    DbRows.Free;
  end;
  Self.User := User;
end;

procedure TWebOnlineUser.Logout;
var
  DbRows: TDbRows;
  SessionId: string;
begin
  if Id = AnonymousUserId then Update;
  if (User <> AnonymousUserId) and
    HandlerData.Request.Cookies.TryGetValue('SessionId', SessionId) then begin
    try
      DbRows := TDbRows.Create;
      Database.Query(DbRows, 'UPDATE `UserOnline` SET `User` = ' + IntToStr(AnonymousUserId) + ' WHERE `SessionId`="' +
        SessionId + '"');
    finally
      DbRows.Free;
    end;
    User := AnonymousUserId;
  end;
end;

{ TUser }

procedure TWebUser.Save;
var
  DbRows: TDbRows;
  Data: TDictionaryStringString;
begin
  try
    DbRows := TDbRows.Create;
    Data := TDictionaryStringString.Create;
    Data.Add('FullName', FullName);
    Data.Add('Email', Email);
    Data.Add('Name', Name);
    //Data.Add('Password', 'SHA1(CONCAT("' + Password + '", "' + Salt + '"))');
    Database.Update('User', Data, '`Id`=' + IntToStr(Id));
  finally
    Data.Free;
    DbRows.Free;
  end;
end;

procedure TWebUser.Delete(Id: Integer);
var
  DbRows: TDbRows;
begin
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'DELETE FROM `User` WHERE `Id`=' + IntToStr(Id));
  finally
    DbRows.Free;
  end;
end;

procedure TWebUser.Add(Name, Password, Email: string);
var
  Salt: string;
  DbRows: TDbRows;
begin
  if (Name = '') or (Password = '') or (Email = '') then
  raise Exception.Create(SEmptyUserParameters);
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'SELECT `Id` FROM `User` WHERE `Name`="' + Name + '"');
    if DbRows.Count = 0 then begin
      Salt := EncodeBase64(Copy(BinToHexString(SHA1(FloatToStr(Now))), 1, 8));
      Database.Query(DbRows, 'INSERT INTO `User` (`Name`, `Password`, `Salt`, `Email`, `RegistrationTime`, `FullName`) VALUES ("' +
        Name + '", SHA1(CONCAT("' + Password + '", "' + Salt + '")), "' + Salt +
        '", "' + Email + '", NOW(), "")');
    end else raise EDuplicateItem.Create(Format(SDuplicateUserItem, [Name]));
  finally
    DbRows.Free;
  end;
end;

function TWebUser.GetIdByName(Name: string): Integer;
var
  DbRows: TDbRows;
begin
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'SELECT `Id` FROM `User` WHERE `Name`="' + Name + '"');
    if DbRows.Count = 1 then Result := StrToInt(DbRows[0].Items['Id'])
      else Result := -1;
  finally
    DBRows.Free;
  end;
end;

function TWebUser.GetIdByNamePassword(Name: string; PassWord: string): Integer;
var
  DbRows: TDbRows;
begin
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'SELECT `Id` FROM `User` WHERE `Name`="' + Name + '" AND ' +
      '`Password` = SHA1(CONCAT("' + Password + '", Salt))');
    if DbRows.Count = 1 then Result := StrToInt(DbRows[0].Items['Id'])
      else Result := -1;
  finally
    DBRows.Free;
  end;
end;

procedure TWebUser.Load;
var
  DbRows: TDbRows;
begin
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'SELECT * FROM `User` WHERE `Id`="' + IntToStr(Id) + '"');
    if DbRows.Count = 1 then begin
      Name := DbRows[0].Items['Name'];
      FullName := DbRows[0].Items['FullName'];
      Email := DbRows[0].Items['Email'];
    end; // else raise ENotFound.Create(Format(SUserNotFound, [IntToStr(Id)]));
  finally
    DBRows.Free;
  end;
end;

function TWebUser.CheckPermission(Module, Operation: string;
  ItemType: string = ''; ItemId: Integer = 0): Boolean;
var
  DbRows: TDbRows;
  DbRows2: TDbRows;
  OperationId: Integer;
begin
  Result := False;
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'SELECT `Id` FROM `PermissionOperation` WHERE `Module`="' + Module + '"' +
    ' AND `Operation` = "' + Operation + '" AND `Item` = "' + ItemType + '"' +
    ' AND `ItemId` = ' + IntToStr(ItemId));
    if DbRows.Count > 0 then
    try
      DbRows2 := TDbRows.Create;
      OperationId := StrToInt(DbRows[0].Items['Id']);

      // Check user-operation relation
      Database.Select(DbRows2, 'PermissionUserAssignment', 'Id',
        '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(OperationId));
      if DbRows2.Count > 0 then begin
        Result := True;
        Exit;
      end;

      // Check user-group relation
      Database.Select(DbRows2, 'PermissionUserAssignment', 'AssignedGroup',
        '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
      if DbRows2.Count > 0 then begin
        if CheckGroupPermission(StrToInt(DbRows2[0].Items['AssignedGroup']), OperationId) then begin
          Result := True;
          Exit;
        end;
      end;
    finally
      DbRows2.Free;
    end;
  finally
    DBRows.Free;
  end;
end;

function TWebUser.CheckGroupPermission(Group, Operation: Integer): Boolean;
var
  DbRows2: TDbRows;
begin
  Result := False;
  try
    DbRows2 := TDbRows.Create;

    // Check group-operation relation
    Database.Select(DbRows2, 'PermissionGroupAssignment', 'Id',
      '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(Operation));
    if DbRows2.Count > 0 then begin
      Result := True;
      Exit;
    end;

    // Check group-group relation
    Database.Select(DbRows2, 'PermissionGroupAssignment', 'AssignedGroup',
      '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
    if DbRows2.Count > 0 then begin
      if CheckGroupPermission(StrToInt(DbRows2[0].Items['AssignedGroup']), Operation) then begin
        Result := True;
        Exit;
      end;
    end;
  finally
    DbRows2.Free;
  end;
end;

end.