{*******************************************************} { } { Tocsg.ServerBase } { } { Copyright (C) 2022 kku } { } {*******************************************************} unit Tocsg.ServerBase; interface uses System.Classes, System.SysUtils, Winapi.Messages, Winapi.Windows, Winapi.Winsock2, System.SyncObjs, Tocsg.Packet, Tocsg.Obj, Tocsg.Thread, Tocsg.Exception, Tocsg.Encrypt, System.Generics.Collections; const DEFAULT_BUF_COUNT = 1000; STOP_WORK = $FFFFFFFF; PACKET_VERSION = 1; MAX_SEND_COUNT = DWORD(-1); MAX_CTX_SEND_BUFCOUNT = 30000; FILE_CUT_IPS = 'CutIpLst.#info'; type // Server -> Client PCtxPacketHeader = ^TCtxPacketHeader; TCtxPacketHeader = packed record sSig: array [0..5] of AnsiChar; // @OC$.G wRank: WORD; dwId, dwSize: DWORD; end; ECrmSocket = class(ETgException); TTgSocketBase = class(TTgObject) private CS_: TCriticalSection; sRemoteHost_, sRemoteAddr_: String; function GetRemoteAddr: String; function GetRemoteHost: String; protected hSocket_: TSocket; bActive_: Boolean; DefEncoding_: TSnTextEncoding; PktEncKind_: TTgEncKind; PktEncPass_: String; Enc_: TTgEncrypt; procedure Lock; procedure Unlock; function GetActive: Boolean; virtual; procedure SetActive(bVal: Boolean); virtual; abstract; procedure _Check_WSAGetLastError(nResult: Integer; const sMsg: String); function GetPktEncKind: TTgEncKind; function GetPktEncPass: String; function GetPktEncObj: TTgEncrypt; public Constructor Create(aSocket: TSocket); Destructor Destroy; override; procedure SetPacketEncInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String); virtual; property Handle: TSocket read hSocket_; property Active: Boolean read GetActive write SetActive; property RemoteAddr: String read GetRemoteAddr; property RemoteHost: String read GetRemoteHost; end; TSocketDataType = (dtRcv, dtSend); PSocketData = ^TSocketData; TSocketData = packed record Overlapped: OVERLAPPED; WSABuf: WSABuf; SocketDataType: TSocketDataType; AllocBuf: Pointer; // arrBuf: array [0..MAX_BUF_LEN-1] of Byte; end; PSocketBuffer = ^TSocketBuffer; TSocketBuffer = packed record Data: TSocketData; bUseWSA: Boolean; end; TTgServerBase = class; TThdClientClose = class; TClientInfo = record nType: Integer; sVer, sWinVer, sIpAddr, sIpRAddr, sAccount, sComName, sMacAddr, sMacAddrs: String; BootDT, ConnDT: TDateTime; end; TTgClientCtxBase = class(TTgSocketBase) private _RcvBuffers: TSnBytes; _PieceRcvBuffers: array [0..2] of Byte; // 4바이트 미만 조각 데이터 _nTotalRcvLen, _nRemainRcvLen, _PieceRcvLen: Integer; // 4바이트 미만 조각 패킷 bRcvDec_, bSendEnc_: Boolean; // 전송 실패 카운트 nSendFailCnt_: Integer; // 각 클라이언트에 대한 패킷 처리방식을 다르게 하기위해 버전정보를 추가 한다. wPktVer_: WORD; dtLastRcv_: TDateTime; qSendWaitBuf_: TQueue; nIoRefCnt_: Integer; pRcvBuf_: PSocketBuffer; SendBufList_: TList; // SendPacket() 할때마다 카운트 되며 CtxPacketHeader의 dwId 값이 된다. dwSendCount_: DWORD; procedure OnSendQNotify(Sender: TObject; const Item: PSocketBuffer; Action: TCollectionNotification); procedure SetActive(bVal: Boolean); override; function GetLastRcvTime: TDateTime; procedure UpdateLastRcvTime; procedure SetPacketVersion(const wVal: WORD); function GetPacketVersion: WORD; procedure MakeRcvPacket(nBufferLen: Integer); procedure SetRcvDec(bVal: Boolean); function GetRcvDec: Boolean; procedure SetSendEnc(bVal: Boolean); function GetSendEnc: Boolean; function PushSendBuf(pBuf: PSocketBuffer): Boolean; function AddSendBuf(pBuf: PSocketBuffer): Integer; procedure RemoveSendBuf(pBuf: PSocketBuffer); function GetSendBufCount: Integer; // function Old_SendPacket_Until_1_2_3(Send: ISendPacket): Boolean; protected Server_: TTgServerBase; AssocObj_: TTgObject; ClientInfo_: TClientInfo; // 계속 물려있는 현상 보완을 위해 추가 dtCreate_: TDateTime; bSendPktEncInfo_: Boolean; public Constructor Create(aServer: TTgServerBase; aSocket: TSocket); Destructor Destroy; override; procedure ClearSendBuffer; procedure SetPacketEncInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String); override; procedure Close; function ReadyRecv: Boolean; // function ProcessSendBuf(pSendBuf: PSocketBuffer = nil): Boolean; function ProcessSendBuf: Boolean; function SendPacket(Send: ISendPacket): Boolean; property LastRcvTime: TDateTime read GetLastRcvTime; property AbleRcvDec: Boolean read GetRcvDec write SetRcvDec; property AbleSendEnc: Boolean read GetSendEnc write SetSendEnc; property OwnerSVr: TTgServerBase read Server_; property ClientInfo: TClientInfo read ClientInfo_; end; PRcvPktData = ^TRcvPktData; TRcvPktData = record Ctx: TTgClientCtxBase; PacketKind: TTgPacketKind; pData: Pointer; nLen: Integer; end; TClientEnumerator = TEnumerator; TClientContextClass = class of TTgClientCtxBase; TClientNotifyEvent = procedure(Sender: TTgServerBase; aClient: TTgClientCtxBase) of object; TThdSocket = class; TThdPingWorker = class; ECrmServer = class(ETgException); TTgServerBase = class(TTgSocketBase) private dtActive_: TDateTime; hCompPort_: THandle; sIPAddr_: String; nPort_: Integer; SockAddr_: TSockAddr; SenderThreadList_, WorkThreadList_: TList; ThdSvrAccept_, ThdSvrLogic_: TThdSocket; ThdClientClose_: TThdClientClose; ThdPingWorker_: TThdPingWorker; evClientConnected_, evClientDisconnected_: TClientNotifyEvent; nRcvBufSize_, nSendBufSize_: Integer; wWorkThdCnt_: WORD; CtxSendBufList_: TList; procedure _Accept; procedure _Open; procedure _Close; procedure _RegisterClient(aClient: TTgClientCtxBase); procedure _RemoveClient(aClient: TTgClientCtxBase); procedure _ProcessTossPacket(aCtx: TTgClientCtxBase; RcvPacket: IRcvPacket); procedure OnCtxSendBufNotify(Sender: TObject; const Item: PSocketBuffer; Action: TCollectionNotification); procedure AddCtxSendBuf(pBuf: PSocketBuffer); procedure RemoveCtxSendBuf(pBuf: PSocketBuffer); procedure ClearCtxSendBuf; protected QueueRcvPacket_: TQUeue; QueueSendPacket_: TQueue; llRcvWaitSize_: LONGLONG; // llSendWaitSize_: LONGLONG; DcClient_: TDictionary; CutIpList_: TStringList; sCutIpLogDir_, sCutIpLogFName_: String; sMakedPacketEncPass4Send_: String; // 클라이언트에 전송할 패킷 암호화 패스워드를 미리 만들어서 저장해 둔다. procedure _QueueRcvPacket(pRcvData: PRcvPktData); virtual; function _DequeueRcvPacket: PRcvPktData; virtual; procedure OnRcvDataNotify(Sender: TObject; const Item: PRcvPktData; Action: TCollectionNotification); function _DequeueSendPacket: ISendPacket; virtual; function CreateClientContext(aSocket: TSocket): TTgClientCtxBase; virtual; procedure OnClientNotify(Sender: TObject; const Item: TTgClientCtxBase; Action: TCollectionNotification); procedure OnWorkThreadNotify(Sender: TObject; const Item: TThdSocket; Action: TCollectionNotification); procedure SetActive(bVal: Boolean); override; procedure SetPort(const nPort: Integer); procedure ClientConnectedEvent(aClient: TTgClientCtxBase); virtual; procedure ClientDisconnectedEvent(aClient: TTgClientCtxBase); virtual; function GetClientEnumerator: TClientEnumerator; function GetClientCount: Integer; function GetRcvWaitSize: LONGLONG; // function GetSendWaitSize: LONGLONG; // function IsValidBuffer(pBuf: PSocketBuffer): Boolean; procedure SendPacketEncConfirm(aCtx: TTgClientCtxBase); procedure SendPacketEncInfo(aCtx: TTgClientCtxBase); procedure ProcessTossFail(aCtx: TTgClientCtxBase; aRcv: IRcvPacket); virtual; procedure ProcessRcvPacket(aCtx: TTgClientCtxBase; aRcv: IRcvPacket); virtual; procedure ProcessFileQueuePacket(aCtx: TTgClientCtxBase; aRcv: IRcvPacket); overload; virtual; procedure ProcessFileQueuePacket(aCtx: TTgClientCtxBase; pRcvBuf: Pointer; pRcvLen: Integer); overload; virtual; procedure ProcessClientConnection(aCtx: TTgClientCtxBase); virtual; abstract; procedure PushClientClose(aCtx: TTgClientCtxBase); virtual; procedure LoadCutIpList; public Constructor Create(const nPort: Integer); Destructor Destroy; override; procedure SetPacketEncInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String); override; procedure QueueSendPacket(SendPacket: ISendPacket); virtual; // protected에서 아래로 옮김 19_0830 16:03:47 sunk // procedure IncSendWaitSize(llSize: LONGLONG); // procedure DecSendWaitSize(llSize: LONGLONG); function IsValidClient(aClient: TTgClientCtxBase): Boolean; procedure CloseClientCtx(aClientCtx: TTgClientCtxBase); virtual; function CheckCutIp(sIp: String): Boolean; // function CheckAcceptBan(sIp: String): Boolean; property CompletionPort: THandle read hCompPort_; property IPAddr: String read sIPAddr_; property Port: Integer read nPort_ write SetPort; property CountClient: Integer read GetClientCount; property OnClientConnected: TClientNotifyEvent write evClientConnected_; property OnClientDisconnected: TClientNotifyEvent write evClientDisconnected_; property ActiveDateTime: TDateTime read dtActive_; property RcvWaitSize: LONGLONG read GetRcvWaitSize; // property SendWaitSize: LONGLONG read GetSendWaitSize; end; TThdSocket = class(TTgThread) private Server_: TTgServerBase; public Constructor Create(aServer: TTgServerBase); end; TThdServerAccept = class(TThdSocket) protected procedure Execute; override; end; TThdServerWork = class(TThdSocket) protected procedure Execute; override; end; TThdClientClose = class(TThdSocket) private qCloseCtx_: TQueue; DcCloseCtx_: TDictionary; procedure OnQCtxNotify(Sender: TObject; const Item: TTgClientCtxBase; Action: TCollectionNotification); procedure OnDCtxNotify(Sender: TObject; const Item: TTgClientCtxBase; Action: TCollectionNotification); protected procedure Execute; override; public Constructor Create(aServer: TTgServerBase); Destructor Destroy; override; procedure PushCloseCtx(aCtx: TTgClientCtxBase); end; TThdServerLogic = class(TThdSocket) protected procedure Execute; override; public Constructor Create(aServer: TTgServerBase); end; TThdPingWorker = class(TTgThread) private Server_: TTgServerBase; protected procedure Execute; override; public Constructor Create(aServer: TTgServerBase); end; implementation uses Tocsg.Safe, System.DateUtils, Tocsg.Path, Tocsg.Trace, Tocsg.Network, Tocsg.PacketDefine, Tocsg.Hex; const LEN_SOCKET_BUF = SizeOf(TSocketBuffer); LEN_CTX_PACKET_HEADER = SizeOf(TCtxPacketHeader); BUFFER_SIZE = 32 * 1024; MAX_BUF_LEN = BUFFER_SIZE; var _CS: TCriticalSection = nil; _WSAData: TWSAData; _WSACount: Integer = 0; { TTgSocketBase } Constructor TTgSocketBase.Create(aSocket: TSocket); begin CS_ := TCriticalSection.Create; Inherited Create; // nLockCnt_ := 0; sRemoteHost_ := ''; sRemoteAddr_ := ''; Enc_ := nil; PktEncPass_ := ''; PktEncKind_ := ekNone; hSocket_ := aSocket; bActive_ := hSocket_ <> INVALID_SOCKET; _CS.Acquire; try if _WSACount = 0 then begin // WinSock 2.2 요청 MAKEWORD(2, 2) = $0202 if WSAStartup($0202, _WSAData) <> 0 then begin // WSASYSNOTREADY 네트워크 서브 시스템이 네트워크에 접속을 준비할 수 없음 // WSAVERNOTSUPPORTED 요구한 윈속의 버전이 서포트 안됨 // WSAEINPROGRESS 블로킹 윈도우 소켓이 실행중 // WSAEPROCLIM 동시에 실행 가능한 최대 윈속수에 달했음 // WSAEFAULT lpWSAData가 무효한 포인터임 nLastError_ := GetLastError; _Trace('TSunkSocket.Create >> %s, LastError = %d', [SysErrorMessage(nLastError_), nLastError_]); raise ECrmSocket.CreateFmt('%s, Error = %d', [SysErrorMessage(nLastError_), nLastError_]); end else _WSACount := 1;; end else Inc(_WSACount); finally _CS.Release; end; end; Destructor TTgSocketBase.Destroy; begin _CS.Acquire; try if _WSACount > 0 then Dec(_WSACount); if _WSACount = 0 then WSACleanup; finally _CS.Release; end; Inherited; if Assigned(Enc_) then FreeAndNil(Enc_); FreeAndNil(CS_); end; procedure TTgSocketBase.Lock; begin if Assigned(CS_) then CS_.Acquire; end; procedure TTgSocketBase.Unlock; begin if Assigned(CS_) then CS_.Release; end; function TTgSocketBase.GetActive: Boolean; begin Lock; try Result := bActive_; finally Unlock; end; end; procedure TTgSocketBase._Check_WSAGetLastError(nResult: Integer; const sMsg: String); var nErr: Integer; begin if nResult <> 0 then begin nErr := WSAGetLastError; case nErr of WSAEWOULDBLOCK, ERROR_IO_PENDING : ; else begin nLastError_ := nErr; _Trace('_Check_WSAGetLastError("%s"), ErrorCode = %d', [sMsg, nErr]); raise ECrmSocket.CreateFmt('Windows socket error: %s (%d), on API ''%s''', [SysErrorMessage(nErr), nErr, sMsg]); end; end; end; end; function TTgSocketBase.GetPktEncKind: TTgEncKind; begin Lock; try Result := PktEncKind_; finally Unlock; end; end; function TTgSocketBase.GetPktEncPass: String; begin Lock; try Result := PktEncPass_; finally Unlock; end; end; function TTgSocketBase.GetPktEncObj: TTgEncrypt; begin Lock; try Result := Enc_; finally Unlock; end; end; function TTgSocketBase.GetRemoteAddr: String; var SockAddrIn: TSockAddr; nSize: Integer; begin if sRemoteAddr_ <> '' then begin Result := sRemoteAddr_; exit; end; Result := ''; if not bActive_ or (hSocket_ = INVALID_SOCKET) then exit; nSize := SizeOf(SockAddrIn); _Check_WSAGetLastError(getpeername(hSocket_, SockAddrIn, nSize), 'getpeername'); Result := String(inet_ntoa(TSockAddrIn(SockAddrIn).sin_addr)); sRemoteAddr_ := Result; end; function TTgSocketBase.GetRemoteHost: String; var SockAddrIn: TSockAddr; nSize: Integer; pHost: PHostEnt; begin if sRemoteHost_ <> '' then begin Result := sRemoteHost_; exit; end; Result := ''; if not bActive_ or (hSocket_ = INVALID_SOCKET) then exit; nSize := SizeOf(SockAddrIn); _Check_WSAGetLastError(getpeername(hSocket_, SockAddrIn, nSize), 'getpeername'); pHost := gethostbyaddr(@TSockAddrIn(SockAddrIn).sin_addr.s_addr, 4, PF_INET); if pHost <> nil then begin Result := String(pHost.h_name); sRemoteHost_ := Result; end; end; procedure TTgSocketBase.SetPacketEncInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String); begin Lock; try PktEncKind_ := aPktEncKind; PktEncPass_ := sPktEncPass; if Assigned(Enc_) then FreeAndNil(Enc_); if PktEncKind_ <> ekNone then Enc_ := TTgEncrypt.Create(PktEncPass_, PktEncKind_); finally Unlock; end; end; { TTgClientCtxBase } Constructor TTgClientCtxBase.Create(aServer: TTgServerBase; aSocket: TSocket); begin New(pRcvBuf_); ZeroMemory(pRcvBuf_, LEN_SOCKET_BUF); pRcvBuf_.Data.AllocBuf := AllocMem(MAX_BUF_LEN); // SetLength(pRcvBuf_.Data.AllocBuf, MAX_BUF_LEN); // New(pSendBuf_); // ZeroMemory(pSendBuf_, LEN_SOCKET_BUF); Inherited Create(aSocket); {$IFDEF DEBUG2} _Trace('Create() .. '); {$ENDIF} SendBufList_ := TList.Create; SendBufList_.OnNotify := OnSendQNotify; nIoRefCnt_ := 0; wPktVer_ := 0; bRcvDec_ := false; bSendEnc_ := false; Server_ := aServer; Server_._RegisterClient(Self); ASSERT(Server_.wWorkThdCnt_ > 0); // SetLength(arrSendBuf_, Server_.wWorkThdCnt_); // ZeroMemory(arrSendBuf_, LEN_SOCKET_BUF * Server_.wWorkThdCnt_); qSendWaitBuf_ := TQueue.Create; nSendFailCnt_ := 0; _PieceRcvLen := 0; _nTotalRcvLen := 0; _nRemainRcvLen := 0; dwSendCount_ := 0; AssocObj_ := nil; ZeroMemory(@ClientInfo_, SizeOf(ClientInfo_)); dtCreate_ := Now; bSendPktEncInfo_ := false; UpdateLastRcvTime; {$IFDEF DEBUG2} _Trace('Create() .. 1'); {$ENDIF} if not ReadyRecv then Server_.CloseClientCtx(Self); {$IFDEF DEBUG2} _Trace('Create() .. 2'); {$ENDIF} end; Destructor TTgClientCtxBase.Destroy; begin SetActive(false); SetLength(_RcvBuffers, 0); qSendWaitBuf_.OnNotify := OnSendQNotify; FreeAndNil(qSendWaitBuf_); FreeAndNil(SendBufList_); Inherited; // Dispose(pSendBuf_); // SetLength(pRcvBuf_.Data.AllocBuf, 0); FreeMem(pRcvBuf_.Data.AllocBuf, MAX_BUF_LEN); Dispose(pRcvBuf_); end; procedure TTgClientCtxBase.OnSendQNotify(Sender: TObject; const Item: PSocketBuffer; Action: TCollectionNotification); begin try case Action of cnAdded : ; cnRemoved : begin // if not Item.bUseWSA then // begin //// SetLength(Item.Data.AllocBuf, 0); // if (Item.Data.AllocBuf <> nil) and (Item.Data.WSABuf.len > 0) then // FreeMem(Item.Data.AllocBuf, Item.Data.WSABuf.len); // Dispose(Item); // end else // Server_.AddCtxSendBuf(Item); // SetLength(Item.Data.AllocBuf, 0); if (Item.Data.AllocBuf <> nil) and (Item.Data.WSABuf.len > 0) then FreeMem(Item.Data.AllocBuf, Item.Data.WSABuf.len); Dispose(Item); end; cnExtracted : ; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. OnSendQNotify()'); end; end; procedure TTgClientCtxBase.ClearSendBuffer; begin Lock; qSendWaitBuf_.OnNotify := OnSendQNotify; try qSendWaitBuf_.Clear; SendBufList_.Clear; finally qSendWaitBuf_.OnNotify := nil; Unlock; end; end; procedure TTgClientCtxBase.SetPacketEncInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String); begin // 서버가 활성화중이 아니면 무시 14_0704 09:56:49 sunk if not Server_.Active then exit; Inherited; // Lock; // try // bRcvDec_ := false; // bSendEnc_ := false; // finally // Unlock; // end; end; procedure TTgClientCtxBase.Close; begin Active := false; end; procedure TTgClientCtxBase.SetActive(bVal: Boolean); var li: TLinger; begin if bActive_ <> bVal then begin Lock; try bActive_ := bVal; finally Unlock; end; if not bVal then begin ClearSendBuffer; Lock; try if hSocket_ <> INVALID_SOCKET then begin ZeroMemory(@li, SizeOf(li)); setsockopt(hSocket_, SOL_SOCKET, SO_LINGER, @li, SizeOf(li)); closesocket(hSocket_); hSocket_ := INVALID_SOCKET; end; finally Unlock; end; end else raise ECrmSocket.Create('클라이언트는 임의적으로 활성화 시킬 수 없습니다.'); end; end; function TTgClientCtxBase.GetLastRcvTime: TDateTime; begin Lock; try Result := dtLastRcv_; finally Unlock; end; end; procedure TTgClientCtxBase.UpdateLastRcvTime; begin Lock; try dtLastRcv_ := Now; finally Unlock; end; end; procedure TTgClientCtxBase.SetPacketVersion(const wVal: WORD); begin Lock; try if wPktVer_ <> wVal then wPktVer_ := wVal; finally Unlock; end; end; function TTgClientCtxBase.GetPacketVersion: WORD; begin Lock; try Result := wPktVer_; finally Unlock; end; end; procedure TTgClientCtxBase.SetRcvDec(bVal: Boolean); begin Lock; try bRcvDec_ := bVal; finally Unlock; end; end; function TTgClientCtxBase.GetRcvDec: Boolean; begin Lock; try Result := bRcvDec_; finally Unlock; end; end; procedure TTgClientCtxBase.SetSendEnc(bVal: Boolean); begin Lock; try bSendEnc_ := bVal; finally Unlock; end; end; function TTgClientCtxBase.GetSendEnc: Boolean; begin Lock; try Result := bSendEnc_; finally Unlock; end; end; function TTgClientCtxBase.PushSendBuf(pBuf: PSocketBuffer): Boolean; var bDoProcSend: Boolean; begin try Result := false; if not Active then exit; Lock; try bDoProcSend := qSendWaitBuf_.Count = 0; qSendWaitBuf_.Enqueue(pBuf); finally Unlock; end; if bDoProcSend then begin Result := ProcessSendBuf; if not Result then Close; // Server_.CloseClientCtx(Self); end; Result := true; except on E: Exception do begin Result := false; ETgException.TraceException(Self, E, 'Fail .. PushSendBuf()'); end; end; end; function TTgClientCtxBase.AddSendBuf(pBuf: PSocketBuffer): Integer; begin Lock; try Result := SendBufList_.Add(pBuf); finally Unlock; end; end; procedure TTgClientCtxBase.RemoveSendBuf(pBuf: PSocketBuffer); var i: Integer; begin try Lock; try i := SendBufList_.IndexOf(pBuf); if i <> -1 then begin pBuf.bUseWSA := false; SendBufList_.Delete(i); end; finally Unlock; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. RemoveSendBuf()'); end; end; function TTgClientCtxBase.GetSendBufCount: Integer; begin Lock; try Result := SendBufList_.Count; finally Unlock; end; end; procedure TTgClientCtxBase.MakeRcvPacket(nBufferLen: Integer); const OVER_SIZE_PACKET = 52428800;{50MB} var nReaded, nReadLen: Integer; pBuf: TBytes; i: Integer; procedure ProcessRcvPacket; var Rcv: IRcvPacket; pDecBuf: TBytes; nDataPos: Integer; pRcvData: PRcvPktData; nPktVer: Integer; begin try nPktVer := GetPacketVersion; New(pRcvData); pRcvData.Ctx := Self; pRcvData.PacketKind := pkNormal; pRcvData.nLen := Length(_RcvBuffers); nDataPos := 0; // 헤더 확인 및 처리 if CompareMem(@PCtxPacketHeader(_RcvBuffers).sSig[0], @CTX_PACKET_SIGNATURE[1], 6) then begin // 패킷을 j-son 오브젝트로 파싱 하기 전에 파일큐에 넣기 위해 pRcvData.PacketKind := TTgPacketKind(PCtxPacketHeader(_RcvBuffers).wRank); nDataPos := LEN_CTX_PACKET_HEADER; pRcvData.nLen := PCtxPacketHeader(_RcvBuffers).dwSize; end; pRcvData.pData := AllocMem(pRcvData.nLen); // 복호화 확인 및 처리 if AbleRcvDec then begin if Enc_ = nil then begin // {$IFDEF DEBUG} // ASSERT(Enc_ <> nil, 'none.. encrypt obj ..'); // {$ENDIF} exit; end; Lock; try pDecBuf := Enc_.DecryptBufferEx(@_RcvBuffers[nDataPos], pRcvData.nLen); case Enc_.EncKind of ekAes256cbc, ekAes192cbc, ekAes128cbc: begin // 언패딩이 필요한 알고리즘의 경우, // 언패딩 후 길이를 다시 계산 pRcvData.nLen := Length(pDecBuf); end; end; finally Unlock; end; CopyMemory(pRcvData.pData, @pDecBuf[0], pRcvData.nLen); end else CopyMemory(pRcvData.pData, @_RcvBuffers[nDataPos], pRcvData.nLen); if pRcvData.PacketKind = pkCritical then begin // 패킷 버전 2부터 헤더를 확인해서 랭크를 j-son 파싱 전에 랭크 확인하고 처리 시켜주게 한다. // 그리고 로직 스레드에서 리시브 패킷 처리 하는걸로 변경 Rcv := TTgPacket.Create(Self, pRcvData.pData, pRcvData.nLen); if Rcv.Toss = 0 then Server_.ProcessRcvPacket(Self, Rcv) else Server_._ProcessTossPacket(Self, Rcv); FreeMem(pRcvData.pData); Dispose(pRcvData); end else Server_._QueueRcvPacket(pRcvData); except // on E: Exception do // ETgException.TraceException(E, 'TTgClientCtxBase >> MakeRcvPacket()::MakeRcvPacket() .. error'); end; end; begin try if not Active then exit; if _PieceRcvLen > 0 then begin SetLength(pBuf, _PieceRcvLen + nBufferLen); CopyMemory(@pBuf[0], @_PieceRcvBuffers[0], _PieceRcvLen); CopyMemory(@pBuf[_PieceRcvLen], pRcvBuf_.Data.AllocBuf, nBufferLen); Inc(nBufferLen, _PieceRcvLen); _PieceRcvLen := 0; end else begin // pBuf := @pRcvBuf_.Data.arrBuf; SetLength(pBuf, MAX_BUF_LEN); CopyMemory(@pBuf[0], pRcvBuf_.Data.AllocBuf, MAX_BUF_LEN); // pBuf := TBytes(pRcvBuf_.Data.AllocBuf); end; nReaded := 0; if _nRemainRcvLen = 0 then begin if nBufferLen < 10 then begin // 10바이트 미만 미루기 _PieceRcvLen := nBufferLen; CopyMemory(@_PieceRcvBuffers[0], @pBuf[nReaded], _PieceRcvLen); exit; end; // 먼저 밀린 패킷 마구 들어온건지 검증..15_0313 18:38:37 sunk for i := 4 to nBufferLen - 7 do begin if AnsiChar(pBuf[i]) = CTX_PACKET_SIGNATURE[1] then if AnsiChar(pBuf[i+1]) = CTX_PACKET_SIGNATURE[2] then if AnsiChar(pBuf[i+2]) = CTX_PACKET_SIGNATURE[3] then if AnsiChar(pBuf[i+3]) = CTX_PACKET_SIGNATURE[4] then if AnsiChar(pBuf[i+4]) = CTX_PACKET_SIGNATURE[5] then if AnsiChar(pBuf[i+5]) = CTX_PACKET_SIGNATURE[6] then begin nReaded := i - 4; break; end; end; if nBufferLen <= (i + 7) then begin _PieceRcvLen := 0; _nTotalRcvLen := 0; _nRemainRcvLen := 0; exit; end; CopyMemory(@_nTotalRcvLen, @pBuf[nReaded], SIZE_INTEGER); if _nTotalRcvLen + SIZE_INTEGER < nBufferLen then begin while nReaded < nBufferLen do begin if nBufferLen - nReaded < 4 then begin // 4바이트 미만은 패킷사이즈도 알수 없기때문에, // 4바이트 미만은 다음 패킷까지 미룬다 _PieceRcvLen := nBufferLen - nReaded; CopyMemory(@_PieceRcvBuffers[0], @pBuf[nReaded], _PieceRcvLen); exit; end; CopyMemory(@_nTotalRcvLen, @pBuf[nReaded], SIZE_INTEGER); Inc(nReaded, SIZE_INTEGER); if _nTotalRcvLen > OVER_SIZE_PACKET then begin // 용량이 넘 크면 문제가 있다고 판단하고 넘김 _PieceRcvLen := 0; _nTotalRcvLen := 0; _nRemainRcvLen := 0; exit; end; SetLength(_RcvBuffers, _nTotalRcvLen); if _nTotalRcvLen > (nBufferLen - nReaded) then begin CopyMemory(@_RcvBuffers[0], @pBuf[nReaded], nBufferLen - nReaded); _nRemainRcvLen := _nTotalRcvLen - (nBufferLen - nReaded); break; end else begin CopyMemory(@_RcvBuffers[0], @pBuf[nReaded], _nTotalRcvLen); ProcessRcvPacket; Inc(nReaded, _nTotalRcvLen); end; end; end else begin if (_nTotalRcvLen + SIZE_INTEGER) > nBufferLen then nReadLen := nBufferLen - SIZE_INTEGER else nReadLen := _nTotalRcvLen; if _nTotalRcvLen > OVER_SIZE_PACKET then begin // 용량이 넘 크면 문제가 있다고 판단하고 넘김 _PieceRcvLen := 0; _nTotalRcvLen := 0; _nRemainRcvLen := 0; exit; end; SetLength(_RcvBuffers, _nTotalRcvLen); CopyMemory(@_RcvBuffers[0], @pBuf[SIZE_INTEGER], nReadLen); _nRemainRcvLen := _nTotalRcvLen - nReadLen; if _nRemainRcvLen = 0 then ProcessRcvPacket; end; end else begin if _nRemainRcvLen < nBufferLen then begin CopyMemory(@_RcvBuffers[_nTotalRcvLen-_nRemainRcvLen], @pBuf[0], _nRemainRcvLen); ProcessRcvPacket; nReaded := _nRemainRcvLen; _nTotalRcvLen := 0; _nRemainRcvLen := 0; while nReaded < nBufferLen do begin if nBufferLen - nReaded < 4 then begin // 4바이트 미만은 패킷사이즈도 알수 없기때문에, // 4바이트 미만은 다음 패킷까지 미룬다 _PieceRcvLen := nBufferLen - nReaded; CopyMemory(@_PieceRcvBuffers[0], @pBuf[nReaded], _PieceRcvLen); exit; end; CopyMemory(@_nTotalRcvLen, @pBuf[nReaded], SIZE_INTEGER); Inc(nReaded, SIZE_INTEGER); {$IFDEF DEBUG} if _nTotalRcvLen > OVER_SIZE_PACKET then begin _nTotalRcvLen := _nTotalRcvLen + 0; end; {$ENDIF} if _nTotalRcvLen > OVER_SIZE_PACKET then begin // 용량이 넘 크면 문제가 있다고 판단하고 넘김 _PieceRcvLen := 0; _nTotalRcvLen := 0; _nRemainRcvLen := 0; exit; end; SetLength(_RcvBuffers, _nTotalRcvLen); if _nTotalRcvLen > (nBufferLen - nReaded) then begin CopyMemory(@_RcvBuffers[0], @pBuf[nReaded], nBufferLen - nReaded); _nRemainRcvLen := _nTotalRcvLen - (nBufferLen - nReaded); break; end else begin CopyMemory(@_RcvBuffers[0], @pBuf[nReaded], _nTotalRcvLen); ProcessRcvPacket; Inc(nReaded, _nTotalRcvLen); end; end; end else begin CopyMemory(@_RcvBuffers[_nTotalRcvLen-_nRemainRcvLen], @pBuf[0], nBufferLen); Dec(_nRemainRcvLen, nBufferLen); if _nRemainRcvLen = 0 then ProcessRcvPacket; end; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. MakeRcvPacket()'); end; end; function TTgClientCtxBase.ReadyRecv: Boolean; var dwFlags, dwRecvLen: DWORD; begin Result := false; try if Active then begin ZeroMemory(pRcvBuf_.Data.AllocBuf, MAX_BUF_LEN); pRcvBuf_.Data.WSABuf.buf := pRcvBuf_.Data.AllocBuf; pRcvBuf_.Data.WSABuf.len := MAX_BUF_LEN; pRcvBuf_.Data.SocketDataType := dtRcv; Lock; try if hSocket_ <> INVALID_SOCKET then begin dwFlags := 0; Result := WSARecv(hSocket_, @pRcvBuf_.Data.WSABuf, 1, dwRecvLen, dwFlags, @pRcvBuf_.Data.Overlapped, nil) <> SOCKET_ERROR; end else begin Result := false; exit; end; finally Unlock; end; if not Result then Result := (WSAGetLastError = ERROR_IO_PENDING); end; except // .. end; end; //function TTgClientCtxBase.ProcessSendBuf(pSendBuf: PSocketBuffer = nil): Boolean; function TTgClientCtxBase.ProcessSendBuf: Boolean; var pBuf: PSocketBuffer; bResult: Boolean; nError: Integer; dwFlags, dwSendLen: DWORD; nRemain: Integer; begin Result := false; if not Active then exit; Result := true; Lock; try nRemain := qSendWaitBuf_.Count; if nRemain > 0 then pBuf := qSendWaitBuf_.Dequeue else pBuf := nil; finally Unlock; end; if pBuf <> nil then begin // _Trace('ProcessSendBuf() .. Do Send.. nRemain=%d, SendLen=%d', [nRemain, pBuf.Data.WSABuf.len]); try pBuf.bUseWSA := true; AddSendBuf(pBuf); dwFlags := 0; Lock; try if hSocket_ <> INVALID_SOCKET then begin bResult := WSASend(hSocket_, @pBuf.Data.WSABuf, 1, dwSendLen, dwFlags, @pBuf.Data.Overlapped, nil) <> SOCKET_ERROR; end else exit; finally Unlock; end; if not bResult then begin nError := WSAGetLastError; case nError of WSA_IO_PENDING : ; WSAENOTSOCK, WSAENETRESET, WSAEDISCON, WSAEBADF, WSAEWOULDBLOCK, WSAECONNRESET, WSAECONNABORTED : begin RemoveSendBuf(pBuf); Result := false; _Trace('TTgClientCtxBase >> Fail!! ProcessSendBuf().. WSASend() ... Close .. Error=%d, IP = %s', [nError, RemoteAddr]); // Close; exit; end; else begin RemoveSendBuf(pBuf); Result := false; if nSendFailCnt_ < 5 then begin // 5번까지 시도해준다. _Trace('TTgClientCtxBase >> Fail!! ProcessSendBuf().. WSASend() >> Error=%d, IP = %s, FC=%d', [nError, RemoteAddr, nSendFailCnt_]); Inc(nSendFailCnt_); end else begin _Trace('TTgClientCtxBase >> Fail!! ProcessSendBuf().. WSASend() ... Close- >> IP = %s', [RemoteAddr]); // Close; end; exit; end; end; end; if nSendFailCnt_ > 0 then nSendFailCnt_ := 0; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. ProcessSendBuf()'); end; end; end; function TTgClientCtxBase.SendPacket(Send: ISendPacket): Boolean; var nLen: Integer; pBuf: PSocketBuffer; pEncBuf, pSendBuf: TSnBytes; nPacketVer, nSendPieceDataPos: Integer; CtxPacketHeader: TCtxPacketHeader; bAbleSendEnc: Boolean; begin Result := false; try if Active then begin bAbleSendEnc := AbleSendEnc; nPacketVer := wPktVer_; nLen := Send.ToBytesDataOnly(pSendBuf); if nLen = 0 then begin {$IFDEF DEBUG} ASSERT(false); {$ELSE} _Trace('TTgClientCtxBase >> Fail!! SendPacket().. no init buffer >> IP = %s', [RemoteAddr]); {$ENDIF} exit; end; New(pBuf); ZeroMemory(pBuf, LEN_SOCKET_BUF); try // if nPacketVer > 0 then // begin nSendPieceDataPos := LEN_CTX_PACKET_HEADER; // end else begin // bAbleSendEnc := false; // nSendPieceDataPos := 0; // end; try if not Active then exit; // 암호화 처리 if bAbleSendEnc then begin if Enc_ = nil then begin // {$IFDEF DEBUG} // ASSERT(Enc_ <> nil, 'none.. encrypt obj ..'); // {$ENDIF} exit; end; Lock; try pEncBuf := Enc_.EncryptBufferEx(pSendBuf, nLen); case Enc_.EncKind of ekAes256cbc, ekAes192cbc, ekAes128cbc: begin // 패딩이 필요한 알고리즘의 경우, // 패딩 길이도 들어가야해서 다시 계산. 18_0411 10:08:16 sunk nLen := Length(pEncBuf); end; end; finally Unlock; end; pBuf.Data.AllocBuf := AllocMem(LEN_CTX_PACKET_HEADER + nLen); CopyMemory(Pointer(NativeUInt(pBuf.Data.AllocBuf) + nSendPieceDataPos), pEncBuf, nLen); end else begin pBuf.Data.AllocBuf := AllocMem(LEN_CTX_PACKET_HEADER + nLen); CopyMemory(Pointer(NativeUInt(pBuf.Data.AllocBuf) + nSendPieceDataPos), pSendBuf, nLen); end; // 패킷 헤더는 암호화 후 넣는걸로 변경 18_0411 11:38:23 sunk // if nPacketVer > 0 then // begin // 패킷 버전별 헤더 도임 14_0610 11:18:13 sunk // 패킷 버전 1 추가 - 서버 -> 클라이언트 헤더 도입 // 패킷 버전 2 추가 - 클라이언트 -> 서버 헤더 도입 ZeroMemory(@CtxPacketHeader, SizeOf(CtxPacketHeader)); CopyMemory(@CtxPacketHeader.sSig[0], @CTX_PACKET_SIGNATURE[1], Length(CtxPacketHeader.sSig)); CtxPacketHeader.dwId := dwSendCount_; Inc(dwSendCount_); if dwSendCount_ >= 400000000 then dwSendCount_ := 0; CtxPacketHeader.dwSize := nLen; CopyMemory(pBuf.Data.AllocBuf, @CtxPacketHeader, LEN_CTX_PACKET_HEADER); // end; pBuf.Data.WSABuf.buf := pBuf.Data.AllocBuf; pBuf.Data.WSABuf.len := nLen + nSendPieceDataPos; pBuf.Data.SocketDataType := dtSend; if not PushSendBuf(pBuf) then begin Result := false; exit; end; finally SetLength(pSendBuf, 0); end; Result := true; finally if not Result then begin FreeMem(pBuf.Data.AllocBuf); Dispose(pBuf); end; end; end; except on E: Exception do ETgException.TraceException(E, 'TTgClientCtxBase >> SendPacket() .. exception'); // ETgException.TraceException(Self, ...) 이런식으로 쓰면 안된다 자신이 짤려서 AV로 여기 올때 다시 자신을 참조하면 아에 뻗음 16_1013 16:22:45 sunk end; end; // AES 알고리즘을 추가 하면서 문제가 생겼다. // 패딩 때문인데 이 패딩으로 추가되는 크기는 헤더 생성 후에 나오기 때문에 // 32k씩 잘라서 최초 헤더를 포함한 데이터가 쏘아지게 되면 뒤늦게 변경된 패딩 추가 크기를 // 알릴 방법이 애매하다. // 2013년 당시에 왜 이렇게 나눠서 보내게 했는지 기억나지 않지만 일단 변경후 상황을 지켜보기로 한다 18_0411 11:26:30 sunk // 이전 버전의 에이전트 업데이트를 위해 남겨둔다 18_0411 15:51:52 sunk (* function TTgClientCtxBase.Old_SendPacket_Until_1_2_3(Send: ISendPacket): Boolean; var nLen, nPieceLen: Integer; pBuf: PSocketBuffer; pEncBuf, pSendBuf, pSendBufPiece: TSnBytes; nSend, nSended, nPacketVer, nSendPieceDataPos: Integer; CtxPacketHeader: TCtxPacketHeader; bAbleSendEnc: Boolean; begin Result := false; try if Active then begin nPacketVer := GetPacketVersion; case nPacketVer of // 패킷 버전 1 추가 - 서버 -> 클라이언트 헤더 도입 14_0610 11:18:13 sunk // 패킷 버전 2 추가 - 클라이언트 -> 서버 헤더 도입 14_0708 17:08:26 sunk 1, 2, 3 : nLen := Send.ToBytesDataOnly(pSendBuf); else nLen := Send.ToBytes(pSendBuf); end; if nLen = 0 then begin {$IFDEF DEBUG} ASSERT(false); {$ELSE} _Trace('TTgClientCtxBase >> Fail!! Old_SendPacket_Until_1_2_3().. no init buffer >> IP = %s', [RemoteAddr]); {$ENDIF} exit; end; if nPacketVer > 0 then begin // 패킷 버전별 헤더 도임 14_0610 11:18:13 sunk // 패킷 버전 1 추가 - 서버 -> 클라이언트 헤더 도입 14_0610 11:18:13 sunk // 패킷 버전 2 추가 - 클라이언트 -> 서버 헤더 도입 14_0708 17:08:26 sunk ZeroMemory(@CtxPacketHeader, SizeOf(CtxPacketHeader)); CopyMemory(@CtxPacketHeader.sSig[0], @CTX_PACKET_SIGNATURE[1], Length(CtxPacketHeader.sSig)); CtxPacketHeader.dwId := dwSendCount_; Inc(dwSendCount_); if dwSendCount_ >= 400000000 then dwSendCount_ := 0; CtxPacketHeader.dwSize := nLen; SetLength(pSendBufPiece, BUFFER_SIZE + LEN_CTX_PACKET_HEADER); CopyMemory(@pSendBufPiece[0], @CtxPacketHeader, LEN_CTX_PACKET_HEADER); nSendPieceDataPos := LEN_CTX_PACKET_HEADER; // 암호화 정보 추가 14_0704 09:35:01 sunk bAbleSendEnc := AbleSendEnc; end else begin bAbleSendEnc := false; SetLength(pSendBufPiece, BUFFER_SIZE); nSendPieceDataPos := 0; end; try // 32kb씩 잘라서 처리해준다. 13_0516 17:21 sunk nSended := 0; while nSended < nLen do begin if not Active then break; nSend := nLen - nSended; if nSend > BUFFER_SIZE then nSend := BUFFER_SIZE; // 암호화 처리 추가 14_0704 11:23:48 sunk if bAbleSendEnc then begin if Enc_ = nil then // 추가 16_0712 13:08:53 sunk begin // {$IFDEF DEBUG} // ASSERT(Enc_ <> nil, 'none.. encrypt obj ..'); // {$ENDIF} exit; end; Lock; try case Enc_.EncKind of ekAes256cbc, ekAes192cbc, ekAes128cbc: begin ASSERT(false, '패킷 버전 2 이하는 올수 없는 위치 입니다.'); end; end; pEncBuf := Enc_.EncryptBufferEx(@pSendBuf[nSended], nSend); // CryptBuffer() 리셋 옵션 사용 32kb 씩 암호화 리셋 한다.. 14_0704 18:31:12 sunk finally Unlock; end; CopyMemory(@pSendBufPiece[nSendPieceDataPos], @pEncBuf[0], nSend); end else CopyMemory(@pSendBufPiece[nSendPieceDataPos], @pSendBuf[nSended], nSend); nPieceLen := nSend + nSendPieceDataPos; //Length(pSendBufPiece); New(pBuf); ZeroMemory(pBuf, LEN_SOCKET_BUF); // SetLength(pBuf.Data.AllocBuf, nPieceLen); pBuf.Data.AllocBuf := AllocMem(nPieceLen); CopyMemory(pBuf.Data.AllocBuf, @pSendBufPiece[0], nPieceLen); // pBuf.Data.WSABuf.buf := @pSendBufPiece[0]; pBuf.Data.WSABuf.buf := pBuf.Data.AllocBuf; pBuf.Data.WSABuf.len := nPieceLen; //nSend + nSendPieceDataPos; pBuf.Data.SocketDataType := dtSend; if not PushSendBuf(pBuf) then begin // SetLength(pBuf.Data.AllocBuf, 0); FreeMem(pBuf, nPieceLen); Dispose(pBuf); Result := false; exit; end; Inc(nSended, nSend); end; finally SetLength(pSendBufPiece, 0); SetLength(pSendBuf, 0); end; Result := true; end; except on E: Exception do ETgException.TraceException(E, 'TTgClientCtxBase >> Old_SendPacket_Until_1_2_3() .. exception'); // ETgException.TraceException(Self, ...) 이런식으로 쓰면 안된다 자신이 짤려서 AV로 여기 올때 다시 자신을 참조하면 아에 뻗음 16_1013 16:22:45 sunk end; end; *) { TTgServerBase } Constructor TTgServerBase.Create(const nPort: Integer); begin Inherited Create(INVALID_SOCKET); CtxSendBufList_ := TList.Create; CtxSendBufList_.OnNotify := OnCtxSendBufNotify; // llRcvWaitSize_ := 0; // llSendWaitSize_ := 0; sIPAddr_ := ''; SetPort(nPort); hCompPort_ := 0; wWorkThdCnt_ := 0; sMakedPacketEncPass4Send_ := ''; evClientConnected_ := nil; evClientDisconnected_ := nil; // QueueRcvPacket_ := TQueue.Create; QueueRcvPacket_ := TQUeue.Create; QueueSendPacket_ := TQueue.Create; DcClient_ := TDictionary.Create; ThdSvrAccept_ := nil; ThdSvrLogic_ := nil; ThdSvrLogic_ := nil; ThdPingWorker_ := nil; WorkThreadList_ := TList.Create; WorkThreadList_.OnNotify := OnWorkThreadNotify; SenderThreadList_ := TList.Create; SenderThreadList_.OnNotify := OnWorkThreadNotify; sCutIpLogDir_ := ''; sCutIpLogFName_ := ''; CutIpList_ := TStringList.Create; end; Destructor TTgServerBase.Destroy; begin SetActive(false); FreeAndNil(CutIpList_); FreeAndNil(SenderThreadList_); FreeAndNil(WorkThreadList_); FreeAndNil(DcClient_); FreeAndNil(QueueSendPacket_); QueueRcvPacket_.OnNotify := OnRcvDataNotify; FreeAndNil(QueueRcvPacket_); FreeAndNil(CtxSendBufList_); Inherited; end; procedure TTgServerBase.OnCtxSendBufNotify(Sender: TObject; const Item: PSocketBuffer; Action: TCollectionNotification); begin case Action of cnAdded: ; cnRemoved: begin // SetLength(Item.Data.AllocBuf, 0); if (Item.Data.AllocBuf <> nil) and (Item.Data.WSABuf.len > 0) then begin FreeMem(Item.Data.AllocBuf, Item.Data.WSABuf.len); Dispose(Item); end; end; cnExtracted: ; end; end; procedure TTgServerBase.AddCtxSendBuf(pBuf: PSocketBuffer); begin Lock; try CtxSendBufList_.Add(pBuf); finally Unlock; end; end; procedure TTgServerBase.RemoveCtxSendBuf(pBuf: PSocketBuffer); var i: Integer; begin Lock; try i := CtxSendBufList_.IndexOf(pBuf); if i <> -1 then CtxSendBufList_.Delete(i); finally Unlock; end; end; procedure TTgServerBase.ClearCtxSendBuf; begin Lock; try CtxSendBufList_.Clear; finally Unlock; end; end; procedure TTgServerBase.OnClientNotify(Sender: TObject; const Item: TTgClientCtxBase; Action: TCollectionNotification); begin case Action of cnAdded: ; cnRemoved: Item.Free; cnExtracted: ; end; end; procedure TTgServerBase.OnWorkThreadNotify(Sender: TObject; const Item: TThdSocket; Action: TCollectionNotification); begin case Action of cnAdded: ; cnRemoved: Item.Free; cnExtracted: ; end; end; //procedure TTgServerBase.IncSendWaitSize(llSize: LONGLONG); //begin // Lock; // try // Inc(llSendWaitSize_, llSize); // finally // Unlock; // end; //end; // //procedure TTgServerBase.DecSendWaitSize(llSize: LONGLONG); //begin // Lock; // try // Dec(llSendWaitSize_, llSize); // if llSendWaitSize_ < 0 then // llSendWaitSize_ := 0; // finally // Unlock; // end; //end; procedure TTgServerBase.CloseClientCtx(aClientCtx: TTgClientCtxBase); begin if IsValidClient(aClientCtx) then begin try PostQueuedCompletionStatus(hCompPort_, 0, NativeInt(aClientCtx), Pointer(STOP_WORK)); // _RemoveClient(aClientCtx); except // end; end; end; function TTgServerBase.CreateClientContext(aSocket: TSocket): TTgClientCtxBase; begin Result := TTgClientCtxBase.Create(Self, aSocket); end; //function TTgServerBase.CheckAcceptBan(sIp: String): Boolean; //begin // //end; function TTgServerBase.CheckCutIp(sIp: String): Boolean; var sLog, sLogPath: String; dtNow: TDateTime; begin Result := false; if (CutIpList_ <> nil) and (CutIpList_.Count > 0) then begin Result := CutIpList_.IndexOf(sIp) <> -1; try if Result and (sCutIpLogDir_ <> '') and (sCutIpLogFName_ <> '') then begin dtNow := Now; sLogPath := sCutIpLogDir_ + FormatDateTime('yyyy\mm\', dtNow); if not DirectoryExists(sLogPath) then if not ForceDirectories(sLogPath) then exit; sLogPath := sLogPath + FormatDateTime('yy_mmdd ', dtNow) + sCutIpLogFName_; sLog := FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', Now) + Format('Cut - %s', [sIp]); WriteLnFileEndUTF8(sLogPath, sLog); end; except exit; end; end; end; procedure TTgServerBase.LoadCutIpList; var sPath: String; begin sCutIpLogDir_ := ''; sCutIpLogFName_ := ''; CutIpList_.Clear; sPath := GetRunExePathDir + FILE_CUT_IPS; if FileExists(sPath) then begin try CutIpList_.LoadFromFile(sPath, TEncoding.UTF8); except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. LoadCutIpList()'); end; end; end; procedure TTgServerBase.SetActive(bVal: Boolean); begin if bActive_ <> bVal then begin bActive_ := bVal; if not bActive_ then begin _Close; QueueSendPacket_.Clear; QueueRcvPacket_.OnNotify := OnRcvDataNotify; try QueueRcvPacket_.Clear; finally QueueRcvPacket_.OnNotify := nil; end; dtActive_ := 0; sIPAddr_ := ''; // Lock; // try // llRcvWaitSize_ := 0; // llSendWaitSize_ := 0; // finally // Unlock; // end; sCutIpLogDir_ := ''; sCutIpLogFName_ := ''; CutIpList_.Clear; _Trace('Server Active Off.'); end else begin LoadCutIpList; sIPAddr_ := GetHostIP; _Open; dtActive_ := now; _Trace('Server Active On.'); end; end; end; procedure TTgServerBase.SetPort(const nPort: Integer); begin if bActive_ then raise ECrmServer.Create('서버가 활성화 중입니다. 포트 설정을 할 수 없습니다.'); if nPort_ <> nPort then nPort_ := nPort; end; procedure TTgServerBase.ClientConnectedEvent(aClient: TTgClientCtxBase); begin if Assigned(evClientConnected_) then evClientConnected_(Self, aClient); end; procedure TTgServerBase.ClientDisconnectedEvent(aClient: TTgClientCtxBase); begin if Assigned(evClientDisconnected_) then evClientDisconnected_(Self, aClient); end; function TTgServerBase.IsValidClient(aClient: TTgClientCtxBase): Boolean; begin Lock; try Result := DcClient_.ContainsKey(aClient); finally UnLock; end; end; function TTgServerBase.GetClientEnumerator: TClientEnumerator; begin Lock; try Result := DcClient_.Values.GetEnumerator; finally Unlock end; end; function TTgServerBase.GetClientCount: Integer; begin Lock; try Result := DcClient_.Count; finally Unlock; end; end; function TTgServerBase.GetRcvWaitSize: LONGLONG; begin Lock; try Result := llRcvWaitSize_; finally Unlock; end; end; //function TTgServerBase.GetSendWaitSize: LONGLONG; //begin // Lock; // try // Result := llSendWaitSize_; // finally // Unlock; // end; //end; procedure TTgServerBase.SetPacketEncInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String); var enc: TTgEncrypt; sMakePass: String; pBuf: TBytes; begin try if Active then raise ECrmServer.Create('서버가 활성화되어 있는 상태에서는 할 수 없습니다.'); Inherited; case aPktEncKind of ekAes256cbc, ekAes192cbc, ekAes128cbc : begin sMakePass := 'kwa' + sPktEncPass + '!7v*' + #0; Guard(enc, TTgEncrypt.Create(ENC_PASSPASS, aPktEncKind)); pBuf := enc.EncryptBufferEx(@sMakePass[1], Length(sMakePass) * 2); sMakedPacketEncPass4Send_ := ConvBinToStr(@pBuf[0], Length(pBuf)); end else sMakedPacketEncPass4Send_ := ''; end; except on E: Exception do ECrmServer.TraceException(Self, E, 'Fail .. SetPacketEncInfo'); end; end; procedure TTgServerBase.SendPacketEncConfirm(aCtx: TTgClientCtxBase); var Send: ISendPacket; PktEncKind: TTgEncKind; begin try if IsValidClient(aCtx) then begin PktEncKind := GetPktEncKind; // if PktEncKind <> ekNone then // none 이어도 해당 패킷을 보내야 전송이 활성화 된다 18_0117 14:52:51 sunk begin Send := TTgPacket.Create(TOC_CONFIRM_PACKET_ENCRYPT); Send.I['K'] := NativeInt(PktEncKind); Send.I['SPV'] := PACKET_VERSION; aCtx.SendPacket(Send); end; end; except on E: Exception do ECrmServer.TraceException(Self, E, 'Fail .. SendPacketEncConfirm()'); end; end; procedure TTgServerBase.SendPacketEncInfo(aCtx: TTgClientCtxBase); var Send: ISendPacket; PktEncKind: TTgEncKind; begin try if IsValidClient(aCtx) then begin PktEncKind := GetPktEncKind; // if PktEncKind <> ekNone then begin Send := TTgPacket.Create(TOC_UPDATE_PACKET_ENCRYPT); Send.I['K'] := NativeInt(PktEncKind); Send.S['J'] := sMakedPacketEncPass4Send_; aCtx.SendPacket(Send); end; aCtx.bSendPktEncInfo_ := true; end; except on E: Exception do ECrmServer.TraceException(Self, E, 'Fail .. SendPacketEncInfo'); end; end; procedure TTgServerBase.ProcessTossFail(aCtx: TTgClientCtxBase; aRcv: IRcvPacket); begin // 토스 실패.. end; procedure TTgServerBase.ProcessRcvPacket(aCtx: TTgClientCtxBase; aRcv: IRcvPacket); procedure process_TOC_CLIENT_INFO; begin with aCtx.ClientInfo_, aRcv do begin nType := I['Type']; sVer := S['Ver']; sComName := S['ComName']; sAccount := S['Account']; sWinVer := S['WinVer']; BootDT := D['BootDT']; sIpRAddr := S['rIP']; sIpAddr := aCtx.RemoteAddr; sMacAddr := S['MacAddr']; sMacAddrs := S['MacAddrs']; ConnDT := Now; end; SendPacketEncConfirm(aCtx); ProcessClientConnection(aCtx); end; procedure process_TOC_CONFIRM_PACKET_ENCRYPT; var EncKind: TTgEncKind; begin EncKind := TTgEncKind(aRcv.I['K']); aCtx.wPktVer_ := aRcv.I['CPV']; SendPacketEncInfo(aCtx); if EncKind <> ekNone then begin // send 암호화 설정 aCtx.AbleSendEnc := true; aCtx.SetPacketEncInfo(EncKind, GetPktEncPass); end; end; procedure process_TOC_UPDATE_PACKET_ENCRYPT; begin Lock; try {$IFDEF DEBUG} ASSERT(Enc_ <> nil, 'no enc obj...'); {$ELSE} if Enc_ = nil then begin // 이렇게 되면 정상이 아닌데... // 테스트 중에 이런 현상이 있어서 아래처럼 보완 처리 14_0708 09:26:40 sunk aCtx.AbleSendEnc := true; aCtx.SetPacketEncInfo(GetPktEncKind, GetPktEncPass); end; {$ENDIF} finally Unlock; end; // rcv 복호화 설정 aCtx.AbleRcvDec := true; end; procedure process_TOC_REQUEST_CONFIRM_PACKET_ENCRYPT; begin SendPacketEncConfirm(aCtx); end; begin try if not IsValidClient(aCtx) then exit; case aRcv.Command of TOC_CLIENT_INFO : process_TOC_CLIENT_INFO; TOC_CONFIRM_PACKET_ENCRYPT : process_TOC_CONFIRM_PACKET_ENCRYPT; TOC_UPDATE_PACKET_ENCRYPT : process_TOC_UPDATE_PACKET_ENCRYPT; TOC_REQUEST_CONFIRM_PACKET_ENCRYPT : process_TOC_REQUEST_CONFIRM_PACKET_ENCRYPT; end; except on E: Exception do ECrmServer.TraceException(Self, E, Format('ProcessRcvPacket() .. Cmd = %d', [aRcv.Command])); end; end; procedure TTgServerBase.ProcessFileQueuePacket(aCtx: TTgClientCtxBase; aRcv: IRcvPacket); begin // end; procedure TTgServerBase.ProcessFileQueuePacket(aCtx: TTgClientCtxBase; pRcvBuf: Pointer; pRcvLen: Integer); begin // end; procedure TTgServerBase.PushClientClose(aCtx: TTgClientCtxBase); begin ThdClientClose_.PushCloseCtx(aCtx); end; procedure TTgServerBase._RegisterClient(aClient: TTgClientCtxBase); begin {$IFDEF DEBUG2} _Trace('_RegisterClient() .. '); {$ENDIF} if IsValidClient(aClient) then exit; {$IFDEF DEBUG2} _Trace('_RegisterClient() .. 1'); {$ENDIF} Lock; try DcClient_.Add(aClient, aClient); // 소켓을 위한 윈도우 메세지와 처리 할 네트워크 이벤트 등록 2011-09-09 sunk // FD_ACCEPT 클라이언트가 접속하면 윈도우 메시지를 발생시킨다. // FD_READ 데이터 수신이 가능하면 윈도우 메시지를 발생시킨다. // FD_WRITE 데이터 송신이 가능하면 윈도우 메시지를 발생시킨다. // FS_CLOSE 상대가 접속을 종료하면 윈도우 메시지를 발생시킨다. // FS_CONNECT 접속이 완료되면 윈도우 메시지를 발생시킨다. // WSAAsyncSelect(aSocket.SocketHandle, hSocket_, WM_SOCKET_CLOSE, FD_CLOSE); finally Unlock; end; {$IFDEF DEBUG2} _Trace('_RegisterClient() .. 2'); {$ENDIF} ClientConnectedEvent(aClient); {$IFDEF DEBUG2} _Trace('_RegisterClient() .. 3'); {$ENDIF} end; procedure TTgServerBase._RemoveClient(aClient: TTgClientCtxBase); begin if not IsValidClient(aClient) then exit; Lock; try DcClient_.Remove(aClient); finally UnLock; end; if not Assigned(DcClient_.OnValueNotify) then begin ClientDisconnectedEvent(aClient); // FreeAndNil(aClient); ThdFreeCloseCtx 에서 처리 19_0905 08:51:10 sunk end; end; procedure TTgServerBase._Open; procedure CreateWorkThread; var i: Integer; SystemInfo: TSystemInfo; begin GetSystemInfo(SystemInfo); wWorkThdCnt_ := SystemInfo.dwNumberOfProcessors * 2; ASSERT(wWorkThdCnt_ > 0); ThdSvrLogic_ := TThdServerLogic.Create(Self); for i := 0 to wWorkThdCnt_ - 1 do WorkThreadList_.Add(TThdServerWork.Create(Self)); // for i := 0 to (SystemInfo.dwNumberOfProcessors * 2) - 1 do // SenderThreadList_.Add(TThdServerSender.Create(Self)); ThdPingWorker_ := TThdPingWorker.Create(Self); end; var nLen: Integer; begin try ClearCtxSendBuf; hCompPort_ := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0); if hCompPort_ = 0 then begin {$IFDEF DEBUG} ASSERT(false); {$ENDIF} nLastError_ := GetLastError; _Trace('TTgServerBase._Open() >> CreateIoCompletionPort() > %s, ErrorCode = %d', [SysErrorMessage(GetLastError), nLastError_]); raise ECrmSocket.CreateFmt('%s, Error = %d', [SysErrorMessage(GetLastError), nLastError_]); end; CreateWorkThread; hSocket_ := WSASocket(PF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED); if hSocket_ = INVALID_SOCKET then begin {$IFDEF DEBUG} ASSERT(false); {$ENDIF} nLastError_ := GetLastError; _Trace('TTgServerBase._Open() >> WSASocket() > %s, ErrorCode = %d', [SysErrorMessage(GetLastError), nLastError_]); raise ECrmSocket.CreateFmt('%s, Error = %d', [SysErrorMessage(GetLastError), nLastError_]); end; nRcvBufSize_ := -1; nSendBufSize_ := -1; nLen := SizeOf(nRcvBufSize_); // nRcvBufSize_ := 32768; // nSendBufSize_ := 32768; // setsockopt(hSocket_, SOL_SOCKET, nSendBufSize_, @nRcvBufSize_, nLen); getsockopt(hSocket_, SOL_SOCKET, SO_RCVBUF, @nRcvBufSize_, nLen); getsockopt(hSocket_, SOL_SOCKET, SO_SNDBUF, @nSendBufSize_, nLen); ZeroMemory(@SockAddr_, SizeOf(SockAddr_)); with TSockAddrIn(SockAddr_) do begin sin_family := AF_INET; sin_port := htons(nPort_); sin_addr.S_addr := INADDR_ANY; end; _Check_WSAGetLastError(bind(hSocket_, SockAddr_, SizeOf(SockAddr_)), 'bind'); _Check_WSAGetLastError(listen(hSocket_, SOMAXCONN), 'listen'); ThdClientClose_ := TThdClientClose.Create(Self); ThdSvrAccept_ := TThdServerAccept.Create(Self); except _Close; raise; end; end; procedure TTgServerBase._Close; begin if hCompPort_ <> 0 then begin PostQueuedCompletionStatus(hCompPort_, 0, 0, Pointer(STOP_WORK)); CloseHandle(hCompPort_); hCompPort_ := 0; Sleep(2000); end; if hSocket_ <> INVALID_SOCKET then begin closesocket(hSocket_); hSocket_ := INVALID_SOCKET; end; if Assigned(ThdPingWorker_) then begin ThdPingWorker_.StopThread; FreeAndNil(ThdPingWorker_); end; WorkThreadList_.Clear; if Assigned(ThdSvrLogic_) then begin ThdSvrLogic_.StopThread; FreeAndNil(ThdSvrLogic_); end; // if Assigned(ThdServerSendWork_) then // begin // ThdServerSendWork_.StopThread; // FreeAndNil(ThdServerSendWork_); // end; if Assigned(ThdSvrAccept_) then begin ThdSvrAccept_.StopThread; FreeAndNil(ThdSvrAccept_); end; if Assigned(ThdClientClose_) then begin ThdClientClose_.StopThread; FreeAndNil(ThdClientClose_); end; DcClient_.OnValueNotify := OnClientNotify; try DcClient_.Clear; finally DcClient_.OnValueNotify := nil; end; ClearCtxSendBuf; end; procedure TTgServerBase._Accept; var hClientSocket: TSocket; SockAddr: TSockAddr; // hClientWinSocket: TSocket; aCtx: TTgClientCtxBase; nSockAddrLen: Integer; function CheckCut: Boolean; var SockAddrIn: TSockAddr; nSize: Integer; begin Result := false; try nSize := SizeOf(SockAddrIn); _Check_WSAGetLastError(getpeername(hClientSocket, SockAddrIn, nSize), 'getpeername'); // sIpAddr := String(inet_ntoa(TSockAddrIn(SockAddrIn).sin_addr)); // if sIpAddr = '192.168.99.99' then // Result := true; Result := CheckCutIp(inet_ntoa(TSockAddrIn(SockAddrIn).sin_addr)); except exit; end; end; procedure CloseClientContext; begin if Assigned(aCtx) then begin {$IFDEF DEBUG2} _Trace('_Accept() .. CloseClientContext()'); {$ENDIF} // ThdServerDisconnWork_.EnqDisconnCtx(aCtx); _RemoveClient(aCtx); end else if hClientSocket <> INVALID_SOCKET then closesocket(hClientSocket); end; begin if (Handle = INVALID_SOCKET) or (hCompPort_ = 0) then exit; nSockAddrLen := SizeOf(SockAddr); hClientSocket := Winapi.Winsock2.accept(Handle, @SockAddr, @nSockAddrLen); if hClientSocket <> INVALID_SOCKET then begin if not bActive_ or CheckCut then begin closesocket(hClientSocket); exit; end; aCtx := nil; try {$IFDEF DEBUG2} _Trace('_Accept() .. 1'); {$ENDIF} aCtx := CreateClientContext(hClientSocket); {$IFDEF DEBUG2} _Trace('_Accept() .. 2'); {$ENDIF} if CreateIoCompletionPort(hClientSocket, hCompPort_, DWORD(aCtx), 0) = 0 then begin CloseClientContext; exit; end; {$IFDEF DEBUG2} _Trace('_Accept() .. 3'); {$ENDIF} except CloseClientContext; end; end; end; procedure TTgServerBase._QueueRcvPacket(pRcvData: PRcvPktData); begin Lock; try Inc(llRcvWaitSize_, pRcvData.nLen); QueueRcvPacket_.Enqueue(pRcvData); finally Unlock; end; end; function TTgServerBase._DequeueRcvPacket: PRcvPktData; begin Result := nil; Lock; try if QueueRcvPacket_.Count > 0 then Result := QueueRcvPacket_.Dequeue; if Result <> nil then begin if llRcvWaitSize_ >= Result.nLen then Dec(llRcvWaitSize_, Result.nLen) else llRcvWaitSize_ := 0; end else llRcvWaitSize_ := 0; finally Unlock; end; end; procedure TTgServerBase.OnRcvDataNotify(Sender: TObject; const Item: PRcvPktData; Action: TCollectionNotification); begin case Action of cnAdded: ; cnRemoved: begin FreeMem(Item.pData); Dispose(Item); end; cnExtracted: ; end; end; procedure TTgServerBase.QueueSendPacket(SendPacket: ISendPacket); begin Lock; try QueueSendPacket_.Enqueue(SendPacket); finally Unlock; end; end; function TTgServerBase._DequeueSendPacket: ISendPacket; begin Result := nil; Lock; try if QueueSendPacket_.Count > 0 then begin Result := QueueSendPacket_.Dequeue; end; finally Unlock; end; end; procedure TTgServerBase._ProcessTossPacket(aCtx: TTgClientCtxBase; RcvPacket: IRcvPacket); var SendCtx: TTgClientCtxBase; Send: ISendPacket; begin SendCtx := TTgClientCtxBase(RcvPacket.Toss); if IsValidClient(SendCtx) then begin Send := TTgPacket.Create(RcvPacket); Send.Toss := LONGLONG(aCtx); // Send.Socket := ClientContext; // _QueueSendPacket(Send); SendCtx.SendPacket(Send); end else ProcessTossFail(aCtx, RcvPacket); end; { TThdSocket } Constructor TThdSocket.Create(aServer: TTgServerBase); begin Server_ := aServer; Inherited Create; StartThread; end; { TThdAccept } procedure TThdServerAccept.Execute; begin while not Terminated and not bWorkStop_ do begin if Server_.Active then begin Server_._Accept; end else Sleep(50); end; end; { TThdServerWork } procedure TThdServerWork.Execute; var nvClient: NativeUInt; dwTransfered: DWORD; pSocketBuf: PSocketBuffer; aCtx: TTgClientCtxBase; // RcvPacket: IRcvPacket; bProcDisconnect: Boolean; procedure ProcessDisconnected(n: Integer); begin try if Server_.IsValidClient(aCtx) then Server_.PushClientClose(aCtx); except //.. end; end; begin while not Terminated and not bWorkStop_ and Server_.Active do if Server_.CompletionPort <> 0 then begin nvClient := 0; if not GetQueuedCompletionStatus(Server_.CompletionPort, dwTransfered, nvClient, POVERLAPPED(pSocketBuf), INFINITE) then begin if (GetLastError <> $40) or (nvClient <> 0) then begin // aCtx := TTgClientCtxBase(nvClient); ProcessDisconnected(1); Server_.RemoveCtxSendBuf(pSocketBuf); end; continue; end; aCtx := TTgClientCtxBase(nvClient); if DWORD(pSocketBuf) = STOP_WORK then begin if nvClient = 0 then begin // 서버 active off break; end else begin // 클라이언트 접속 종료 ProcessDisconnected(2); continue; end; end; if not Server_.Active then break; if dwTransfered = 0 then begin ProcessDisconnected(3); continue; end; if pSocketBuf = nil then begin {$IFDEF DEBUG} if GetLastError <> $40 then ASSERT(false); {$ENDIF} ProcessDisconnected(4); continue; end; bProcDisconnect := false; try if not Server_.IsValidClient(aCtx) then continue; try try case pSocketBuf.Data.SocketDataType of dtRcv : begin aCtx.UpdateLastRcvTime; aCtx.MakeRcvPacket(dwTransfered); if not aCtx.ReadyRecv then begin {$IFDEF DEBUG2} _Trace('Fail .. aCtx.ReadyRecv()'); {$ENDIF} bProcDisconnect := true; continue; end; end; dtSend : begin aCtx.RemoveSendBuf(pSocketBuf); if not aCtx.ProcessSendBuf then begin {$IFDEF DEBUG2} _Trace('Fail .. aCtx.ProcessSendBuf()'); {$ENDIF} bProcDisconnect := true; continue; end; end; else ASSERT(false); end; except on E: Exception do begin bProcDisconnect := true; continue; end; end; finally if bProcDisconnect then begin ProcessDisconnected(5); end; end; except continue; end; end else Sleep(500); end; { TThdClientClose } Constructor TThdClientClose.Create(aServer: TTgServerBase); begin Inherited Create(aServer); DcCloseCtx_ := TDictionary.Create; qCloseCtx_ := TQueue.Create; qCloseCtx_.OnNotify := OnQCtxNotify; end; Destructor TThdClientClose.Destroy; begin FreeAndNIl(qCloseCtx_); DcCloseCtx_.OnValueNotify := OnDCtxNotify; FreeAndNil(DcCloseCtx_); Inherited; end; procedure TThdClientClose.OnQCtxNotify(Sender: TObject; const Item: TTgClientCtxBase; Action: TCollectionNotification); begin case Action of cnAdded : begin if not DcCloseCtx_.ContainsKey(Item) then DcCloseCtx_.Add(Item, Item); end; cnRemoved : ; cnExtracted : ; end; end; procedure TThdClientClose.OnDCtxNotify(Sender: TObject; const Item: TTgClientCtxBase; Action: TCollectionNotification); begin case Action of cnAdded : ; cnRemoved : Item.Free; cnExtracted : ; end; end; procedure TThdClientClose.PushCloseCtx(aCtx: TTgClientCtxBase); var bAdd: Boolean; begin try bAdd := false; Lock; try if not DcCloseCtx_.ContainsKey(aCtx) then begin bAdd := true; qCloseCtx_.Enqueue(aCtx); end; finally Unlock; end; if bAdd then begin {$IFDEF DEBUG2} _Trace('PushCloseCtx() .. Add FreeCtx., Ptr=%d', [NativeUInt(aCtx)]); {$ENDIF} Server_._RemoveClient(aCtx); aCtx.Close; aCtx.UpdateLastRcvTime; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. PushCloseCtx()'); end; end; procedure TThdClientClose.Execute; const FREE_WAIT_SEC = 180; var FreeCtx: TTgClientCtxBase; wStep: WORD; begin while not Terminated and not WorkStop do begin wStep := 0; try Lock; try if qCloseCtx_.Count > 0 then FreeCtx := qCloseCtx_.Dequeue else FreeCtx := nil; finally Unlock; end; wStep := 1; if FreeCtx <> nil then begin wStep := 2; if SecondsBetween(FreeCtx.LastRcvTime, Now) < FREE_WAIT_SEC then begin wStep := 3; Lock; try qCloseCtx_.Enqueue(FreeCtx); finally Unlock; end; Sleep(100); end else begin wStep := 4; Lock; try DcCloseCtx_.Remove(FreeCtx); finally Unlock; end; wStep := 5; FreeAndNil(FreeCtx); end; end else Sleep(500); wStep := 6; except on E: Exception do ETgException.TraceException(Self, E, Format('Fail .. Execute(), Step=%d', [wStep])); end; end; end; { TThdServerLogic } Constructor TThdServerLogic.Create(aServer: TTgServerBase); begin Inherited Create(aServer); Priority := tpTimeCritical; end; procedure TThdServerLogic.Execute; var Rcv: IRcvPacket; pRcvData: PRcvPktData; begin while not Terminated and not bWorkStop_ and Server_.Active do begin try pRcvData := Server_._DequeueRcvPacket; if pRcvData <> nil then begin case pRcvData.PacketKind of pkNormal : try Rcv := TTgPacket.Create(pRcvData.Ctx, pRcvData.pData, pRcvData.nLen); if Rcv.Toss = 0 then Server_.ProcessRcvPacket(pRcvData.Ctx, Rcv) else Server_._ProcessTossPacket(pRcvData.Ctx, Rcv); except on E: Exception do ETgException.TraceException(Self, E, 'Normal packet - fail ..'); end; pkFileQueue : try Server_.ProcessFileQueuePacket(pRcvData.Ctx, pRcvData.pData, pRcvData.nLen); except on E: Exception do ETgException.TraceException(Self, E, 'FileQueue packet - fail ..'); end; end; FreeMem(pRcvData.pData); Dispose(pRcvData); end else Sleep(10); except on E: Exception do begin ETgException.TraceException(Self, E, 'Fail .. Execute()'); Sleep(1000); end; end; end; end; { TThdPingWorker } Constructor TThdPingWorker.Create(aServer: TTgServerBase); begin Inherited Create; Server_ := aServer; StartThread; end; procedure TThdPingWorker.Execute; const PING_CYCLE = 120; var dwTick: DWORD; enum: TClientEnumerator; dtNow: TDateTime; Ctx: TTgClientCtxBase; begin dwTick := GetTickCount; while not Terminated and not WorkStop do begin Sleep(100); try if ((GetTickCount - dwTick) div 1000) > 60 then begin dtNow := Now; Guard(enum, Server_.GetClientEnumerator); while enum.MoveNext do begin try if not Server_.IsValidClient(enum.Current) then break; if not (enum.Current is TTgClientCtxBase) then begin {$IFDEF DEBUG} ASSERT(false, 'Invalid Ctx ...'); {$ELSE} _Trace('Execute() .. Invalid Ctx ...'); {$ENDIF} continue; end; Ctx := TTgClientCtxBase(enum.Current); if not Ctx.bSendPktEncInfo_ and (SecondsBetween(Ctx.dtCreate_, dtNow) > 600) then begin // 패킷 전송 처리 시간 체크 후 종료 처리 Server_.CloseClientCtx(Ctx); _Trace('Execute() .. Close old connection .. (NoSendPktEncInfo)'); end else if SecondsBetween(Ctx.LastRcvTime, dtNow) > PING_CYCLE then begin if Server_.IsValidClient(Ctx) then begin if Ctx.ClientInfo_.nType = 0 then Server_.CloseClientCtx(Ctx) else Ctx.SendPacket(TTgPacket.Create(TOC_PING)); end; end; except break; end; end; dwTick := GetTickCount; end; except Sleep(1000); dwTick := GetTickCount; continue; end; end; end; Initialization if not Assigned(_CS) then _CS := TCriticalSection.Create; Finalization if Assigned(_CS) then FreeAndNil(_CS); end.