{*********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: Bans

 class for bans list

*********************************************************}
unit Bans;

interface

{$I Defines.pas}

uses
  SysUtils, Classes2, Slavamasks, Windows, Constants, STypes, StringResources;

type
  TBan = record
    User, Ip, Using: string;
    Admin: string;
    Reason: string;
    Time: Time_T;
    Expires: Time_T;
    LastAttempt: Time_T;
    Tries: Integer;
  end;
  PBan = ^TBan;
  TBanList = class(TMyList)
    function Add(Value: TBan): Integer;
    procedure Clear; override;
    procedure Delete(Index: Integer);
    function Item(N: Integer): PBan;
    function FindRec(Rec: string): Integer; overload;
    function FindRec(User, Ip: string): Integer; overload;
    function Banned(User: string; Ip: string; var Rec: PBan): Boolean;
    function Ban(Admin, Ban: string; Reason: string; Timeout: Time_T): Integer;
    procedure Expire;
    procedure LoadFromFile(Name: string);
    procedure SaveToFile(Name: string);
    constructor Create;
    destructor Destroy; override;
  end;

function BanTime2Str(T: Time_T): string;
procedure SplitBan(Rec: string; var User: string; var Ip: string);
function JoinBan(User, Ip: string): string;
function CheckBan(Rec: string): string;

implementation

uses
  Handler, Lang, Users, Vars, Thread, Memory_Manager;

function BanTime2Str(T: Time_T): string;
var
  Days, Hours, Min, Sec: Integer;
  Str: string;
begin
  if T = 0 then
  begin
    Result := RS_BantimeForever;
    Exit;
  end;
  Sec := T mod 60;
  T := T div 60;
  Min := T mod 60;
  T := T div 60;
  Hours := T mod 24;
  Days := T div 24;
  Str := '';
  if Days > 0 then
    Str := IntToStr(Days) + RS_Bans_Days;
  if Hours > 0 then
    Str := Str + IntToStr(Hours) + RS_Bans_Hours
  else if Str <> '' then
    Str := Str + '0' + RS_Bans_Hours;
  Str := Str + IntToStr(Min) + RS_Bans_Minutes;
  Str := Str + IntToStr(Sec) + RS_Bans_Seconds;
  Result := Str;
end;

procedure SplitBan(Rec: string; var User: string; var Ip: string);
var
  I: Integer;
begin
  I := Pos('!', Rec);
  User := '';
  Ip := '';
  if I > 0 then
  begin
    if I > 1 then
      User := Copy(Rec, 1, I - 1);
    if I < Length(Rec) then
      Ip := Copy(Rec, I + 1, Length(Rec));
  end
  else
  begin
    if Pos('.', Rec) > 0 then
      Ip := Rec
    else
      User := Rec;
  end;
  if User = '' then
    User := '*';
  if Ip = '' then
    Ip := '*';
  if Ip = '*.*' then
    Ip := '*';
  if Ip = '*.*.*' then
    Ip := '*';
  if Ip = '*.*.*.*' then
    Ip := '*';
end;

function JoinBan(User, Ip: string): string;
begin
  if User = '' then
    User := '*';
  if Ip = '' then
    Ip := '*';
  if Ip = '*.*' then
    Ip := '*';
  if Ip = '*.*.*' then
    Ip := '*';
  if Ip = '*.*.*.*' then
    Ip := '*';
  Result := AnsiLowerCase(User) + '!' + LowerCase(Ip);
end;

function CheckBan(Rec: string): string;
var
  User, Ip: string;
begin
  SplitBan(Rec, User, Ip);
  Result := JoinBan(User, Ip);
end;

function TBanList.Add(Value: TBan): Integer;
var
  Data: PBan;
begin
  Data := AllocMem(SizeOf(TBan));
  with Data^ do
  begin
    Pointer(User) := nil;
    User := AnsiLowerCase(Value.User);
    Pointer(Ip) := nil;
    Ip := LowerCase(Value.Ip);
    Pointer(Reason) := nil;
    Reason := Value.Reason;
    Pointer(Admin) := nil;
    Admin := Value.Admin;
    Time := Value.Time;
    LastAttempt := Value.LastAttempt;
    Expires := Value.Expires;
    Tries := Value.Tries;
    Using := Value.Using;

    if User = '' then
      User := '*';
    if Ip = '' then
      Ip := '*';
    if Ip = '*.*' then
      Ip := '*';
    if Ip = '*.*.*' then
      Ip := '*';
    if Ip = '*.*.*.*' then
      Ip := '*';
    if Reason = '' then
      Reason := RS_Bans_NoReason;
    if Admin = '' then
      Admin := '?';
  end;
  Result := inherited Add(Data);
end;

procedure TBanList.Clear;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    Delete(I);
  inherited Clear;
end;

procedure TBanList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= Count) then Exit;
  if Items[Index] <> nil then
  begin
    Finalize(PBan(Items[Index])^);
    FreeMem(PBan(Items[Index]), SizeOf(TBan));
  end;
  inherited Delete(Index);
end;

function TBanList.Item(N: Integer): PBan;
begin
  Result := PBan(Items[N]);
end;

function TBanList.FindRec(Rec: string): Integer;
var
  User, Ip: string;
begin
  SplitBan(Rec, User, Ip);
  Result := FindRec(User, Ip);
end;

function TBanList.FindRec(User, Ip: string): Integer;
var
  I: Integer;
  P: PBan;
begin
  for I := 0 to Count - 1 do
  begin
    P := Items[I];
    if (P^.User = User) and (P^.Ip = Ip) then
    begin
      Result := I;
      Exit;
    end;
  end;
  Result := -1;
end;

function TBanList.Banned(User: string; Ip: string; var Rec: PBan): Boolean;
var
  I: Integer;
  T: PBan;
begin
  Result := False;
  Expire;
  User := AnsiLowerCase(User);
  if User = '' then
    User := '*';
  if Ip = '' then
    Ip := '*';
  if Ip = '*.*.*.*' then
    Ip := '*';
  for I := 0 to Count - 1 do
  try
    T := Items[I];
    if (Ip <> '*') and (T^.Ip <> '*') then
      if MatchesMaskEx(Ip, T^.Ip) then
      begin
        Rec := T;
        Result := True;
        Exit;
      end;
    if (User <> '*') and (T^.User <> '*') then
      if MatchesMaskEx(User, T^.User) then
      begin
        Rec := T;
        Result := True;
        Exit;
      end;
  except
    on E: Exception do
      Debuglog('Exception in TBanList::Banned : ' + E.Message);
  end;
end;

procedure TBanList.LoadFromFile(Name: string);
var
  List, Lst: TMyStringList;
  I: Integer;
  Data: TBan;
  Str: string;
begin
  Clear;
  if not FileExists(Name) then Exit;
  List := CreateStringList;
  try
    List.LoadFromFile(Name);
  except
    FreeStringList(List);
    Exit;
  end;
  Lst := CreateStringList;
  for I := 0 to List.Count - 1 do
  begin
    Str := Trim(List.Strings[I]);
    if Str[1] <> '#' then
    begin
      SplitString(Str, Lst);
      if Lst.Count > 4 then
      begin
        Data.User := AnsiLowerCase(Lst.Strings[0]);
        Data.Ip := LowerCase(Lst.Strings[1]);
        Data.Admin := Lst.Strings[2];
        Data.Time := StrToIntDef(Lst.Strings[3], 0);
        Data.Expires := 0;
        if Lst.Count > 5 then
        begin
          Data.Expires := StrToIntDef(Lst.Strings[4], 0);
          Data.Reason := Lst.Strings[5];
        end
        else
          Data.Reason := Lst.Strings[4];
        if Lst.Count > 6 then
          Data.LastAttempt := StrToIntDef(Lst.Strings[6], 0)
        else
          Data.LastAttempt := Data.Time;
        if Lst.Count > 7 then
          Data.Using := Lst.Strings[7]
        else
          Data.Using := '';
        if Lst.Count > 8 then
          Data.Tries := StrToIntDef(Lst.Strings[8], 0)
        else
          Data.Tries := 0;
      end;
      if FindRec(Data.User, Data.Ip) = -1 then
        Add(Data);
    end;
  end;
  FreeStringList(Lst);
  FreeStringList(List);
end;

procedure TBanList.SaveToFile(Name: string);
var
  I: Integer;
  List: TMyStringList;
  Rec: PBan;
begin
  List := CreateStringList;
  for I := 0 to Count - 1 do
  begin
    Rec := Item(I);
    List.Add(AddStr(Rec.User) + ' ' + AddStr(Rec.Ip) + ' ' + AddStr(Rec^.Admin) +
      ' ' +
      IntToStr(Rec^.Time) + ' ' + IntToStr(Rec^.Expires) + ' ' +
      AddStr(Rec^.Reason) + ' ' + IntToStr(Rec^.LastAttempt) + ' ' +
      AddStr(Rec^.Using) + ' ' + IntToStr(Rec^.Tries));
    if (I mod 50) = 0 then
    begin
{$I CheckSync.pas}
    end;
  end;
  List.Sort;
  List.Insert(0, RS_Bans_FileDescription0);
  List.Insert(1, RS_Bans_FileDescription1);
  List.Insert(2, RS_Bans_FileDescription2);
  List.Insert(3, RS_Bans_FileDescription3);
  List.Insert(4, RS_Bans_FileDescription4);
  List.Insert(5, RS_Bans_FileDescription5);
  try
    List.SaveToFile(Name);
  except
  end;
  FreeStringList(List);
end;

function TBanList.Ban(Admin, Ban: string; Reason: string;
  Timeout: Time_T): Integer;
var
  Rec: TBan;
begin
  SplitBan(Ban, Rec.User, Rec.Ip);
  Rec.Admin := Admin;
  Rec.Reason := Reason;
  Rec.Time := GetTickCountT;
  if TimeOut = 0 then
    Rec.Expires := 0
  else
    Rec.Expires := Rec.Time + Timeout;
  Rec.LastAttempt := Rec.Time;
  Rec.Using := '';
  Rec.Tries := 0;
  Result := Add(Rec);
end;

procedure TBanList.Expire;
var
  I: Integer;
  T: Time_T;
  B: PBan;
begin
  T := GetTickCountT;
  for I := Count - 1 downto 0 do
    if PBan(Items[I])^.Expires <> 0 then
      if PBan(Items[I])^.Expires < T then
      begin
        B := Items[I];
        if Copy(B^.Admin, 1, 7) = 'server:' then
          Wallop(MSG_SERVER_NOSUCH, wallopSBan, Format(RS_Bans_Unban,
            [ServerName_T,
            JoinBan(B^.User, B^.Ip), B^.Reason, BanTime2Str(T - B^.Time)]), True)
        else
          Wallop(MSG_SERVER_NOSUCH, wallopMBan, Format(RS_Bans_Unban,
            [ServerName_T,
            JoinBan(B^.User, B^.Ip), B^.Reason, BanTime2Str(T - B^.Time)]),
              True);
        Delete(I);
      end;
end;

constructor TBanList.Create;
begin
  inherited Create;
end;

destructor TBanList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

end.
