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

 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: LocalUsers

 class for local users

*********************************************************}
unit LocalUsers;

interface

{$I Defines.pas}

uses
  Windows, Classes2, SysUtils, Constants, STypes, BlckSock, SynSock, WinSock,
  Share, Servers, Users, Registered, Lang, SlavaStrings, StringResources;

type
  TLocalUserState = set of (locSwapBytes, locNeedsUpdate, locWriteOnly,
    locFloodWarning, locPingable);
  TLocalUserDetector = set of (loc326, Loc110, Loc640, Loc208,
    Loc100, Loc870, Loc10300, locMD5Zero, locMD5NonZero, locMD5Zeros,
      locMacDir);
  TLocalUser = class(TObject)
    Data: POnlineUser;
    Socket: HSocket;
    Last_Seen: Cardinal;
    Hotlist: TStringHash;
    Ignored: TStringHash;
    Out_List: TStringHash;
{$IFDEF USERS_DOUBLE_QUEUE}
    Out_List2: TStringHash; // Second queue - for search and browse Results
{$ENDIF}
    Recv_Buf: string;
    Recv_Len: SmallInt;
    SoftwareID: ShortInt;
    Shared: TShareList;
    Shared_Mp3,
      Shared_Audio,
      Shared_Video,
      Shared_Cd,
      Shared_Images,
      Shared_Text,
      Shared_Blocked,
      Shared_Apps: Word;
    Shared_Size: Int64;
    Last_Search_Time: Cardinal;
    Searches_Count: SmallInt;
    Searchespm: Integer;
    LocalState: TLocalUserState;
    DLRequestsp3m: Integer;
    WantQueuep3m: Integer;
    Blocked_Incomplete,
      Blocked_Fakeext,
      Blocked_Toolong,
      Blocked_Toolarge,
      Blocked_Toomany,
      Blocked_Tooshort,
      Blocked_Toosmall,
      Blocked_Tooshortmp3,
      Blocked_Other: Word;
        // Blocked_Otherはブロックワードによるブロックを含まない
    Detector: TLocalUserDetector;
    Last_Command_Time: Cardinal;
    Join_Delay: SmallInt; // 自動入室までの遅延時間(ミリ秒)
    constructor Create;
    destructor Destroy; override;
    function Logged: Boolean;
    function Ip: Cardinal;
    function Nick: string;
    function Software: string;
    function Level: TNapUserLevel;
    function AddState(St: TUserState): TUserState;
    function DelState(St: TUserState): TUserState;
    procedure Exec(Id: Integer; Cmd: string);
    procedure WriteData(Str: string);
    procedure Flush(Can_Disconnect: Boolean = True);
    function BufferEmpty: Boolean;
    procedure CheckPong(var Id: Integer; var Cmd: string);
    procedure Clear;
  end;

function CreateLocalUser: TLocalUser;
procedure FreeLocalUser(User: TLocalUser);

implementation

uses
  Vars, Handler, Thread, Memory_Manager;

var
  Total_LocalUsers: Integer;
  List_LocalUsers: TMyList;

constructor TLocalUser.Create;
begin
  inherited Create;
  Data := nil;
  Socket := INVALID_SOCKET;
  Last_Seen := Current_Time;
  StrHash_Reset(Hotlist);
  StrHash_Reset(Ignored);
  StrHash_Reset(Out_List);
  SetLength(Recv_Buf, 0);
  Recv_Len := 0;
  Shared := nil;
  Shared_Mp3 := 0;
  Shared_Audio := 0;
  Shared_Video := 0;
  Shared_Cd := 0;
  Shared_Images := 0;
  Shared_Text := 0;
  Shared_Apps := 0;
  Shared_Size := 0;
  Shared_Blocked := 0;
  Last_Search_Time := 0;
  Searches_Count := 0;
  Searchespm := 0;
  DLRequestsp3m := 0;
  WantQueuep3m := 0;
  LocalState := [];
  SoftwareID := softUnknown;
  Blocked_Incomplete := 0;
  Blocked_Fakeext := 0;
  Blocked_Toolong := 0;
  Blocked_Toolarge := 0;
  Blocked_Toomany := 0;
  Blocked_Tooshort := 0;
  Blocked_Toosmall := 0;
  Blocked_Tooshortmp3 := 0;
  Blocked_Other := 0;
  Detector := [];
  Last_Command_Time := Current_Time;
  Join_Delay := INITIAL_JOIN_DELAY;
{$IFDEF USERS_DOUBLE_QUEUE}
  StrHash_Reset(Out_List2);
{$ENDIF}
end;

destructor TLocalUser.Destroy;
var
  Num: Integer;
begin
  Num := 0;
  try
    StrHash_Clear(Hotlist);
    Num := 1;
    StrHash_Clear(Ignored);
    Num := 2;
    StrHash_Clear(Out_List);
{$IFDEF USERS_DOUBLE_QUEUE}
    StrHash_Clear(Out_List2);
{$ENDIF}
    Num := 3;
    if Shared <> nil then
    begin
      Shared.Free;
      Shared := nil;
    end;
    Num := 4;
    DoCloseSocket(Socket);
    Socket := INVALID_SOCKET;
    Num := 5;
    SetLength(Recv_Buf, 0);
  except
    on E: Exception do
      if Running then
        DebugLog('Exception in TLocalUser::Destroy  Num=' + IntToStr(Num) + ' : '
          + E.Message);
  end;
  inherited Destroy;
end;

procedure TLocalUser.Clear;
begin
  DoCloseSocket(Socket);
  Socket := INVALID_SOCKET;
  Last_Seen := Current_Time;
  StrHash_Clear(Hotlist);
  StrHash_Clear(Ignored);
  StrHash_Clear(Out_List);
  SetLength(Recv_Buf, 0);
  Recv_Len := 0;
  if Shared <> nil then
  begin
    Shared.Free;
    Shared := nil;
  end;
  Shared_Mp3 := 0;
  Shared_Audio := 0;
  Shared_Video := 0;
  Shared_Cd := 0;
  Shared_Images := 0;
  Shared_Text := 0;
  Shared_Apps := 0;
  Shared_Size := 0;
  Shared_Blocked := 0;
  Last_Search_Time := 0;
  Searches_Count := 0;
  Searchespm := 0;
  DLRequestsp3m := 0;
  WantQueuep3m := 0;
  LocalState := [];
  SoftwareID := softUnknown;
  Blocked_Incomplete := 0;
  Blocked_Fakeext := 0;
  Blocked_Toolong := 0;
  Blocked_Toolarge := 0;
  Blocked_Toomany := 0;
  Blocked_Tooshort := 0;
  Blocked_Toosmall := 0;
  Blocked_Tooshortmp3 := 0;
  Blocked_Other := 0;
  Detector := [];
  Last_Command_Time := Current_Time;
  Join_Delay := INITIAL_JOIN_DELAY;
{$IFDEF USERS_DOUBLE_QUEUE}
  StrHash_Clear(Out_List2);
{$ENDIF}
end;

function TLocalUser.Logged: Boolean;
begin
  Result := Data <> nil;
end;

function TLocalUser.AddState(St: TUserState): TUserState;
begin
  if Data = nil then
    Result := []
  else
  begin
    Data^.State := Data^.State + St;
    Result := Data^.State;
  end;
end;

function TLocalUser.DelState(St: TUserState): TUserState;
begin
  if Data = nil then
    Result := []
  else
  begin
    Data^.State := Data^.State - St;
    Result := Data^.State;
  end;
end;

function TLocalUser.Nick: string;
begin
  if Data = nil then
    Result := ''
  else
    Result := Data^.UserName;
end;

function TLocalUser.Software: string;
begin
  if Data = nil then
    Result := ''
  else
    Result := Data^.Software;
end;

function TLocalUser.Level: TNapUserLevel;
begin
  if Data = nil then
    Result := napUserUser
  else
    Result := Data^.Level;
end;

function TLocalUser.Ip: Cardinal;
begin
  if Data <> nil then
    Result := Data^.Ip
  else if Socket <> INVALID_SOCKET then
    Result := TCPSocket_GetRemoteSin(Socket).Sin_Addr.S_Addr
  else
    Result := 0;
end;

procedure TLocalUser.CheckPong(var Id: Integer; var Cmd: string);
var
  List: TMyStringList;
  I: Integer;
  Srv: TServer;
  Server: string;
begin
  List := CreateStringList;
  SplitString(Cmd, List);
  if List.Count = 4 then
    if List.Strings[1] = 'pingall' then
    begin
      Server := '';
      if List.Strings[0] = Cons.Nick then
        Server := ServerName_T
      else
        for I := 0 to DB_Servers.Count - 1 do
        begin
          Srv := DB_Servers.Items[I];
          if Srv.Logged then
            if Srv.Console = List.Strings[0] then
              Server := Srv.Host;
        end;
      if Server <> '' then
      begin // pong response thru channel request
        Id := MSG_SERVER_PUBLIC;
        I := GetTickCount - StrToIntDef(List.Strings[3], GetTickCount);
        Cmd := Format(RS_Handler_SPong, [List.Strings[2], Server,
          IntToStrDot(I)]);
      end;
    end;
  FreeStringList(List);
end;

procedure TLocalUser.Exec(Id: Integer; Cmd: string);
var
  Str: string;
begin
  try
    if Log_Commands then
    begin
      Str := RS_LocalUsers_SendCommand + ' [' + IntToStr(Id) + '] "' + Cmd +
        '" (';
      if Nick <> '' then
        Str := Str + Nick + ', ' + Software + ', ';
      Str := Str + Decode_Ip(Ip) + ')';
      Log(0, Str, True);
    end;
    if Id = MSG_SERVER_PONG then
      CheckPong(Id, Cmd);
    if Self = Cons then
    begin
      Sync_Reply_List.AddDoubleCmd(MSG_SR_CONSOLEREPLY, Id, Cmd, '');
      Exit;
    end;
    Str := '    ' + Cmd;
    if locSwapBytes in LocalState then
    begin
      Str[2] := Chr(Length(Cmd) and 255);
      Str[1] := Chr(Length(Cmd) div 256);
      Str[4] := Chr(Id and 255);
      Str[3] := Chr(Id div 256);
    end
    else
    begin
      Str[1] := Chr(Length(Cmd) and 255);
      Str[2] := Chr(Length(Cmd) div 256);
      Str[3] := Chr(Id and 255);
      Str[4] := Chr(Id div 256);
    end;
{$IFDEF USERS_DOUBLE_QUEUE}
    case Id of
      MSG_SERVER_SEARCH_RESULT, // Search results
      MSG_SERVER_SEARCH_END,
        MSG_SERVER_BROWSE_RESPONSE, // Browse results
      MSG_SERVER_BROWSE_END,
        MSG_SERVER_RESUME_MATCH, // Resume match
      MSG_SERVER_RESUME_MATCH_END,
        MSG_SERVER_GLOBAL_USER_LIST, // Users list
      MSG_CLIENT_GLOBAL_USER_LIST: StrHash_AddEx(Out_List2, Str);
    else
      StrHash_AddEx(Out_List, Str);
    end;
{$ELSE}
    StrHash_AddEx(Out_List, Str);
{$ENDIF}
  except
  end;
end;

procedure TLocalUser.WriteData(Str: string);
begin
  StrHash_AddEx(Out_List, Str);
end;

procedure TLocalUser.Flush(Can_Disconnect: Boolean = True);
var
  Num: Integer;
  Cmd: PStringHashItem;
  Last_Error: Integer;
begin
  if Self = Cons then Exit;
  if Socket = INVALID_SOCKET then
  begin
    StrHash_Clear(Out_List);
    Exit;
  end;
{$IFDEF USERS_DOUBLE_QUEUE}
  if (Out_List.Count = 0) and (Out_List2.Count = 0) then Exit;
{$ELSE}
  if Out_List.Count = 0 then Exit;
{$ENDIF}
  Num := 0;
  if (Logged = True) and (CanSend(False) = False) then Exit;
  Cmd := Out_List.First;
{$I CheckSync.pas}
  while Cmd <> nil do
  begin
    TCPSocket_SendString(Socket, Cmd^.Data, Last_Error);
    if Last_Error = WSAEWOULDBLOCK then Exit;
    if Last_Error <> 0 then
    begin
      if Can_Disconnect then
        DisconnectUser(Self, '', GetLangT(LNG_DISCONNECT_SOCKETERR, Nick,
          Software, IntToStr(Last_Error), GetErrorDesc(Last_Error)), 'Flush (2)',
          True);
      Exit;
    end;
    Inc(Bytes_Out, Length(Cmd^.Data));
    Inc(Bandwidth_Up, Length(Cmd^.Data));
    StrHash_DeleteFirst(Out_List);
    Cmd := Out_List.First;
    Inc(Num);
    if ((Num mod 10) = 9) then
    begin
{$I CheckSync.pas}
    end;
    if (Logged = True) and (CanSend(False) = False) then Exit;
  end;
{$IFDEF USERS_DOUBLE_QUEUE}
  Cmd := Out_List2.First;
  while Cmd <> nil do
  begin
    TCPSocket_SendString(Socket, Cmd^.Data, Last_Error);
    if Last_Error = WSAEWOULDBLOCK then Exit;
    if Last_Error <> 0 then
    begin
      if Can_Disconnect then
        DisconnectUser(Self, '', GetLangT(LNG_DISCONNECT_SOCKETERR, Nick,
          Software, IntToStr(Last_Error), GetErrorDesc(Last_Error)), 'Flush (4)',
          True);
      Exit;
    end;
    Inc(Bytes_Out, Length(Cmd^.Data));
    Inc(Bandwidth_Up, Length(Cmd^.Data));
    StrHash_DeleteFirst(Out_List2);
    Cmd := Out_List2.First;
    Inc(Num);
    if ((Num mod 10) = 9) then
    begin
{$I CheckSync.pas}
    end;
    if not CanSend(False) then Exit;
  end;
{$ENDIF}
  if locWriteOnly in LocalState then
    Last_Seen := SetSocketCloseTime;
end;

function TLocalUser.BufferEmpty: Boolean;
begin
{$IFDEF USERS_DOUBLE_QUEUE}
  Result := True;
  if Out_List.Count > 9 then
    Result := False;
  if Out_List2.Count > 0 then
    Result := False;
{$ELSE}
  Result := Out_List.Count < 10;
{$ENDIF}
end;

function CreateLocalUser: TLocalUser;
begin
  if List_LocalUsers.Count > 0 then
  begin
    Result := List_LocalUsers.Items[List_LocalUsers.Count - 1];
    List_LocalUsers.Delete(List_LocalUsers.Count - 1);
  end
  else
  begin
    Result := TLocalUser.Create;
    Inc(Total_LocalUsers);
  end;
  Result.Last_Seen := Current_Time;
end;

procedure FreeLocalUser(User: TLocalUser);
begin
  User.Clear;
  List_LocalUsers.Add(User);
end;

procedure ClearUsersList;
var
  I: Integer;
begin
  for I := 0 to List_LocalUsers.Count - 1 do
    TLocalUser(List_LocalUsers.Items[I]).Free;
end;

initialization
  begin
    Total_LocalUsers := 0;
    List_LocalUsers := TMyList.Create;
  end;

finalization
  begin
    ClearUsersList;
    List_LocalUsers.Free;
    Total_LocalUsers := 0;
  end;

end.
