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

 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;


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:='無期限';
   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)+'日, ';
 if hours>0 then
   str:=str+IntToStr(hours)+'時間, '
 else
  if str<>'' then str:=str+'0時間, ';
 str:=str+IntToStr(min)+'分, ';
 str:=str+IntToStr(sec)+'秒';
 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:='n/a';
   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;
 mask: String;
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,'# version 3');
 list.Insert(1,'# ! このファイルは次回サーバーがシャットダウンしたとき上書きされます。');
 list.Insert(2,'# 編集するときは、サーバーが稼動していないか確認してください。');
 list.Insert(3,'#');
 list.Insert(4,'# 形式: user ip admin time expires reason lastattempt using tries');
 list.Insert(5,'#');
 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,GetLangEx('<$1> $2 ($3)のBanを解除しました: Banから$4経過して期限切れ',servername_t,JoinBan(b^.user,b^.ip),b^.reason,BanTime2Str(t-b^.time)),true)
     else
      Wallop(MSG_SERVER_NOSUCH,wallopMBan,GetLangEx('<$1> $2 ($3)のBanを解除しました: Banから$4経過して期限切れ',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.
