DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


d3e67cfd6ef34c4ad3fdfc9cc0ed8ab1c1f6b2f4
[d2df-sdl.git] / src / game / g_net.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit g_net;
17
18 interface
19
20 uses
21 e_log, e_msg, ENet, Classes, md5, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
22
23 const
24 NET_PROTOCOL_VER = 182;
25
26 NET_MAXCLIENTS = 24;
27 NET_CHANS = 12;
28
29 NET_CHAN_SERVICE = 0;
30 NET_CHAN_IMPORTANT = 1;
31 NET_CHAN_GAME = 2;
32 NET_CHAN_PLAYER = 3;
33 NET_CHAN_PLAYERPOS = 4;
34 NET_CHAN_MONSTER = 5;
35 NET_CHAN_MONSTERPOS = 6;
36 NET_CHAN_LARGEDATA = 7;
37 NET_CHAN_CHAT = 8;
38 NET_CHAN_DOWNLOAD = 9;
39 NET_CHAN_SHOTS = 10;
40 NET_CHAN_DOWNLOAD_EX = 11;
41
42 NET_NONE = 0;
43 NET_SERVER = 1;
44 NET_CLIENT = 2;
45
46 NET_BUFSIZE = $FFFF;
47 NET_PING_PORT = $DF2D;
48
49 NET_EVERYONE = -1;
50
51 NET_UNRELIABLE = 0;
52 NET_RELIABLE = 1;
53
54 NET_DISC_NONE: enet_uint32 = 0;
55 NET_DISC_PROTOCOL: enet_uint32 = 1;
56 NET_DISC_VERSION: enet_uint32 = 2;
57 NET_DISC_FULL: enet_uint32 = 3;
58 NET_DISC_KICK: enet_uint32 = 4;
59 NET_DISC_DOWN: enet_uint32 = 5;
60 NET_DISC_PASSWORD: enet_uint32 = 6;
61 NET_DISC_TEMPBAN: enet_uint32 = 7;
62 NET_DISC_BAN: enet_uint32 = 8;
63 NET_DISC_MAX: enet_uint32 = 8;
64 NET_DISC_FILE_TIMEOUT: enet_uint32 = 13;
65
66 NET_STATE_NONE = 0;
67 NET_STATE_AUTH = 1;
68 NET_STATE_GAME = 2;
69
70 NET_CONNECT_TIMEOUT = 1000 * 10;
71
72 BANLIST_FILENAME = 'banlist.txt';
73 NETDUMP_FILENAME = 'netdump';
74
75 {$IFDEF FREEBSD}
76 NilThreadId = nil;
77 {$ELSE}
78 NilThreadId = 0;
79 {$ENDIF}
80
81 type
82 TNetFileTransfer = record
83 diskName: string;
84 hash: TMD5Digest;
85 stream: TStream;
86 size: Integer; // file size in bytes
87 chunkSize: Integer;
88 lastSentChunk: Integer;
89 lastAckChunk: Integer;
90 lastAckTime: Int64; // msecs; if not "in progress", we're waiting for the first ack
91 inProgress: Boolean;
92 diskBuffer: PChar; // of `chunkSize` bytes
93 resumed: Boolean;
94 end;
95
96 TNetClient = record
97 ID: Byte;
98 Used: Boolean;
99 State: Byte;
100 Peer: pENetPeer;
101 Player: Word;
102 RequestedFullUpdate: Boolean;
103 RCONAuth: Boolean;
104 Voted: Boolean;
105 Transfer: TNetFileTransfer; // only one transfer may be active
106 NetOut: array [0..1] of TMsg;
107 end;
108 TBanRecord = record
109 IP: LongWord;
110 Perm: Boolean;
111 end;
112 pTNetClient = ^TNetClient;
113
114 AByte = array of Byte;
115
116 var
117 NetInitDone: Boolean = False;
118 NetMode: Byte = NET_NONE;
119 NetDump: Boolean = False;
120
121 NetServerName: string = 'Unnamed Server';
122 NetPassword: string = '';
123 NetPort: Word = 25666;
124
125 NetAllowRCON: Boolean = False;
126 NetRCONPassword: string = '';
127
128 NetTimeToUpdate: Cardinal = 0;
129 NetTimeToReliable: Cardinal = 0;
130 NetTimeToMaster: Cardinal = 0;
131
132 NetHost: pENetHost = nil;
133 NetPeer: pENetPeer = nil;
134 NetEvent: ENetEvent;
135 NetAddr: ENetAddress;
136
137 NetPongAddr: ENetAddress;
138 NetPongSock: ENetSocket = ENET_SOCKET_NULL;
139
140 NetUseMaster: Boolean = True;
141 NetSlistAddr: ENetAddress;
142 NetSlistIP: string = 'mpms.doom2d.org';
143 NetSlistPort: Word = 25665;
144
145 NetClientIP: string = '127.0.0.1';
146 NetClientPort: Word = 25666;
147
148 NetIn, NetOut: TMsg;
149 NetBuf: array [0..1] of TMsg;
150
151 NetClients: array of TNetClient;
152 NetClientCount: Byte = 0;
153 NetMaxClients: Byte = 255;
154 NetBannedHosts: array of TBanRecord;
155
156 NetState: Integer = NET_STATE_NONE;
157
158 NetMyID: Integer = -1;
159 NetPlrUID1: Integer = -1;
160 NetPlrUID2: Integer = -1;
161
162 NetInterpLevel: Integer = 1;
163 NetUpdateRate: Cardinal = 0; // as soon as possible
164 NetRelupdRate: Cardinal = 18; // around two times a second
165 NetMasterRate: Cardinal = 60000;
166
167 NetForcePlayerUpdate: Boolean = False;
168 NetPredictSelf: Boolean = True;
169 NetForwardPorts: Boolean = False;
170
171 NetGotEverything: Boolean = False;
172 NetGotKeys: Boolean = False;
173
174 {$IFDEF USE_MINIUPNPC}
175 NetPortForwarded: Word = 0;
176 NetPongForwarded: Boolean = False;
177 NetIGDControl: AnsiString;
178 NetIGDService: TURLStr;
179 {$ENDIF}
180
181 NetPortThread: TThreadID = NilThreadId;
182
183 NetDumpFile: TStream;
184
185 g_Res_received_map_start: Integer = 0; // set if we received "map change" event
186
187
188 function g_Net_Init(): Boolean;
189 procedure g_Net_Cleanup();
190 procedure g_Net_Free();
191 procedure g_Net_Flush();
192
193 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
194 procedure g_Net_Host_Die();
195 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
196 function g_Net_Host_Update(): enet_size_t;
197
198 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
199 procedure g_Net_Disconnect(Forced: Boolean = False);
200 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
201 function g_Net_Client_Update(): enet_size_t;
202 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
203
204 function g_Net_Client_ByName(Name: string): pTNetClient;
205 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
206 function g_Net_ClientName_ByID(ID: Integer): string;
207
208 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
209 //function g_Net_Wait_Event(msgId: Word): TMemoryStream;
210 //function g_Net_Wait_FileInfo (var tf: TNetFileTransfer; asMap: Boolean; out resList: TStringList): Integer;
211
212 function IpToStr(IP: LongWord): string;
213 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
214
215 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
216 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
217 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
218 function g_Net_UnbanHost(IP: string): Boolean; overload;
219 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
220 procedure g_Net_UnbanNonPermHosts();
221 procedure g_Net_SaveBanList();
222
223 procedure g_Net_DumpStart();
224 procedure g_Net_DumpSendBuffer();
225 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
226 procedure g_Net_DumpEnd();
227
228 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
229 procedure g_Net_UnforwardPorts();
230
231 function g_Net_UserRequestExit: Boolean;
232
233 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; resList: TStringList): Integer;
234 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
235 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
236 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
237
238
239 implementation
240
241 uses
242 SysUtils,
243 e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
244 g_main, g_game, g_language, g_weapons, utils, ctypes,
245 g_map;
246
247 const
248 FILE_CHUNK_SIZE = 8192;
249
250 var
251 g_Net_DownloadTimeout: Single;
252 trans_omsg: TMsg;
253
254
255 //**************************************************************************
256 //
257 // SERVICE FUNCTIONS
258 //
259 //**************************************************************************
260
261 procedure clearNetClientTransfers (var nc: TNetClient);
262 begin
263 nc.Transfer.stream.Free;
264 nc.Transfer.diskName := ''; // just in case
265 if (nc.Transfer.diskBuffer <> nil) then FreeMem(nc.Transfer.diskBuffer);
266 nc.Transfer.stream := nil;
267 nc.Transfer.diskBuffer := nil;
268 end;
269
270
271 procedure clearNetClient (var nc: TNetClient);
272 begin
273 clearNetClientTransfers(nc);
274 end;
275
276
277 procedure clearNetClients (clearArray: Boolean);
278 var
279 f: Integer;
280 begin
281 for f := Low(NetClients) to High(NetClients) do clearNetClient(NetClients[f]);
282 if (clearArray) then SetLength(NetClients, 0);
283 end;
284
285
286 function g_Net_UserRequestExit (): Boolean;
287 begin
288 Result := {e_KeyPressed(IK_SPACE) or}
289 e_KeyPressed(IK_ESCAPE) or
290 e_KeyPressed(VK_ESCAPE) or
291 e_KeyPressed(JOY0_JUMP) or
292 e_KeyPressed(JOY1_JUMP) or
293 e_KeyPressed(JOY2_JUMP) or
294 e_KeyPressed(JOY3_JUMP)
295 end;
296
297
298 //**************************************************************************
299 //
300 // file transfer declaraions and host packet processor
301 //
302 //**************************************************************************
303
304 const
305 // server packet type
306 NTF_SERVER_DONE = 10; // done with this file
307 NTF_SERVER_FILE_INFO = 11; // sent after client request
308 NTF_SERVER_CHUNK = 12; // next chunk; chunk number follows
309 NTF_SERVER_ABORT = 13; // server abort
310 NTF_SERVER_MAP_INFO = 14;
311
312 // client packet type
313 NTF_CLIENT_MAP_REQUEST = 100; // map file request; also, returns list of additional wads to download
314 NTF_CLIENT_FILE_REQUEST = 101; // resource file request (by index)
315 NTF_CLIENT_ABORT = 102; // do not send requested file, or abort current transfer
316 NTF_CLIENT_START = 103; // start transfer; client may resume download by sending non-zero starting chunk
317 NTF_CLIENT_ACK = 104; // chunk ack; chunk number follows
318
319
320 // disconnect client due to some file transfer error
321 procedure killClientByFT (var nc: TNetClient);
322 begin
323 e_LogWritefln('disconnected client #%d due to file transfer error', [nc.ID], TMsgType.Warning);
324 enet_peer_disconnect(nc.Peer, NET_DISC_FILE_TIMEOUT);
325 clearNetClientTransfers(nc);
326 end;
327
328
329 // send file transfer message from server to client
330 function ftransSendServerMsg (var nc: TNetClient; var m: TMsg): Boolean;
331 var
332 pkt: PENetPacket;
333 begin
334 result := false;
335 if (m.CurSize < 1) then exit;
336 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
337 if not Assigned(pkt) then begin killClientByFT(nc); exit; end;
338 if (enet_peer_send(nc.Peer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then begin killClientByFT(nc); exit; end;
339 result := true;
340 end;
341
342
343 // send file transfer message from client to server
344 function ftransSendClientMsg (var m: TMsg): Boolean;
345 var
346 pkt: PENetPacket;
347 begin
348 result := false;
349 if (m.CurSize < 1) then exit;
350 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
351 if not Assigned(pkt) then exit;
352 if (enet_peer_send(NetPeer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then exit;
353 result := true;
354 end;
355
356
357 // file chunk sender
358 procedure ProcessChunkSend (var nc: TNetClient);
359 var
360 tf: ^TNetFileTransfer;
361 ct: Int64;
362 chunks: Integer;
363 rd: Integer;
364 begin
365 tf := @nc.Transfer;
366 if (tf.stream = nil) then exit;
367 ct := GetTimerMS();
368 // arbitrary timeout number
369 if (ct-tf.lastAckTime >= 5000) then
370 begin
371 killClientByFT(nc);
372 exit;
373 end;
374 // check if we need to send something
375 if (not tf.inProgress) then exit; // waiting for the initial ack
376 // ok, we're sending chunks
377 if (tf.lastAckChunk <> tf.lastSentChunk) then exit;
378 Inc(tf.lastSentChunk);
379 // do it one chunk at a time; client ack will advance our chunk counter
380 chunks := (tf.size+tf.chunkSize-1) div tf.chunkSize;
381
382 if (tf.lastSentChunk > chunks) then
383 begin
384 killClientByFT(nc);
385 exit;
386 end;
387
388 trans_omsg.Clear();
389 if (tf.lastSentChunk = chunks) then
390 begin
391 // we're done with this file
392 e_LogWritefln('download: client #%d, DONE sending chunks #%d/#%d', [nc.ID, tf.lastSentChunk, chunks]);
393 trans_omsg.Write(Byte(NTF_SERVER_DONE));
394 clearNetClientTransfers(nc);
395 end
396 else
397 begin
398 // packet type
399 trans_omsg.Write(Byte(NTF_SERVER_CHUNK));
400 trans_omsg.Write(LongInt(tf.lastSentChunk));
401 // read chunk
402 rd := tf.size-(tf.lastSentChunk*tf.chunkSize);
403 if (rd > tf.chunkSize) then rd := tf.chunkSize;
404 trans_omsg.Write(LongInt(rd));
405 //e_LogWritefln('download: client #%d, sending chunk #%d/#%d (%d bytes)', [nc.ID, tf.lastSentChunk, chunks, rd]);
406 //FIXME: check for errors here
407 try
408 tf.stream.Seek(tf.lastSentChunk*tf.chunkSize, soFromBeginning);
409 tf.stream.ReadBuffer(tf.diskBuffer^, rd);
410 trans_omsg.WriteData(tf.diskBuffer, rd);
411 except // sorry
412 killClientByFT(nc);
413 exit;
414 end;
415 end;
416 // send packet
417 ftransSendServerMsg(nc, trans_omsg);
418 end;
419
420
421 // server file transfer packet processor
422 // received packet is in `NetEvent`
423 procedure ProcessDownloadExPacket ();
424 var
425 f: Integer;
426 nc: ^TNetClient;
427 nid: Integer = -1;
428 msg: TMsg;
429 cmd: Byte;
430 tf: ^TNetFileTransfer;
431 fname: string;
432 chunk: Integer;
433 ridx: Integer;
434 dfn: AnsiString;
435 md5: TMD5Digest;
436 st: TStream;
437 size: LongInt;
438 begin
439 // find client index by peer
440 for f := Low(NetClients) to High(NetClients) do
441 begin
442 if (not NetClients[f].Used) then continue;
443 if (NetClients[f].Peer = NetEvent.peer) then
444 begin
445 nid := f;
446 break;
447 end;
448 end;
449 //e_LogWritefln('RECEIVE: dlpacket; client=%d (datalen=%u)', [nid, NetEvent.packet^.dataLength]);
450
451 if (nid < 0) then exit; // wtf?!
452 nc := @NetClients[nid];
453
454 if (NetEvent.packet^.dataLength = 0) then
455 begin
456 killClientByFT(nc^);
457 exit;
458 end;
459
460 tf := @NetClients[nid].Transfer;
461 tf.lastAckTime := GetTimerMS();
462
463 cmd := Byte(NetEvent.packet^.data^);
464 //e_LogWritefln('RECEIVE: nid=%d; cmd=%u', [nid, cmd]);
465 case cmd of
466 NTF_CLIENT_FILE_REQUEST: // file request
467 begin
468 if (tf.stream <> nil) then
469 begin
470 killClientByFT(nc^);
471 exit;
472 end;
473 if (NetEvent.packet^.dataLength < 2) then
474 begin
475 killClientByFT(nc^);
476 exit;
477 end;
478 // new transfer request; build packet
479 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
480 begin
481 killClientByFT(nc^);
482 exit;
483 end;
484 // get resource index
485 ridx := msg.ReadLongInt();
486 if (ridx < -1) or (ridx >= gExternalResources.Count) then
487 begin
488 e_LogWritefln('Invalid resource index %d', [ridx], TMsgType.Warning);
489 killClientByFT(nc^);
490 exit;
491 end;
492 if (ridx < 0) then fname := MapsDir+gGameSettings.WAD else fname := GameDir+'/wads/'+gExternalResources[ridx];
493 if (length(fname) = 0) then
494 begin
495 e_WriteLog('Invalid filename: '+fname, TMsgType.Warning);
496 killClientByFT(nc^);
497 exit;
498 end;
499 tf.diskName := findDiskWad(fname);
500 //if (length(tf.diskName) = 0) then tf.diskName := findDiskWad(GameDir+'/wads/'+fname);
501 if (length(tf.diskName) = 0) then
502 begin
503 e_LogWritefln('NETWORK: file "%s" not found!', [fname], TMsgType.Fatal);
504 killClientByFT(nc^);
505 exit;
506 end;
507 // calculate hash
508 //TODO: cache hashes
509 tf.hash := MD5File(tf.diskName);
510 // create file stream
511 tf.diskName := findDiskWad(fname);
512 try
513 tf.stream := openDiskFileRO(tf.diskName);
514 except
515 tf.stream := nil;
516 end;
517 if (tf.stream = nil) then
518 begin
519 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname]), TMsgType.Fatal);
520 killClientByFT(nc^);
521 exit;
522 end;
523 e_LogWritefln('client #%d requested resource #%d (file is `%s` : `%s`)', [nc.ID, ridx, fname, tf.diskName]);
524 tf.size := tf.stream.size;
525 tf.chunkSize := FILE_CHUNK_SIZE; // arbitrary
526 tf.lastSentChunk := -1;
527 tf.lastAckChunk := -1;
528 tf.lastAckTime := GetTimerMS();
529 tf.inProgress := False; // waiting for the first ACK or for the cancel
530 GetMem(tf.diskBuffer, tf.chunkSize);
531 // sent file info message
532 trans_omsg.Clear();
533 trans_omsg.Write(Byte(NTF_SERVER_FILE_INFO));
534 trans_omsg.Write(tf.hash);
535 trans_omsg.Write(tf.size);
536 trans_omsg.Write(tf.chunkSize);
537 trans_omsg.Write(ExtractFileName(fname));
538 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
539 end;
540 NTF_CLIENT_ABORT: // do not send requested file, or abort current transfer
541 begin
542 e_LogWritefln('client #%d aborted file transfer', [nc.ID]);
543 clearNetClientTransfers(nc^);
544 end;
545 NTF_CLIENT_START: // start transfer; client may resume download by sending non-zero starting chunk
546 begin
547 if not Assigned(tf.stream) then
548 begin
549 killClientByFT(nc^);
550 exit;
551 end;
552 if (tf.lastSentChunk <> -1) or (tf.lastAckChunk <> -1) or (tf.inProgress) then
553 begin
554 // double ack, get lost
555 killClientByFT(nc^);
556 exit;
557 end;
558 if (NetEvent.packet^.dataLength < 2) then
559 begin
560 killClientByFT(nc^);
561 exit;
562 end;
563 // build packet
564 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
565 begin
566 killClientByFT(nc^);
567 exit;
568 end;
569 chunk := msg.ReadLongInt();
570 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
571 begin
572 killClientByFT(nc^);
573 exit;
574 end;
575 e_LogWritefln('client #%d started file transfer from chunk %d', [nc.ID, chunk]);
576 // start sending chunks
577 tf.inProgress := True;
578 tf.lastSentChunk := chunk-1;
579 tf.lastAckChunk := chunk-1;
580 ProcessChunkSend(nc^);
581 end;
582 NTF_CLIENT_ACK: // chunk ack; chunk number follows
583 begin
584 if not Assigned(tf.stream) then
585 begin
586 killClientByFT(nc^);
587 exit;
588 end;
589 if (tf.lastSentChunk < 0) or (not tf.inProgress) then
590 begin
591 // double ack, get lost
592 killClientByFT(nc^);
593 exit;
594 end;
595 if (NetEvent.packet^.dataLength < 2) then
596 begin
597 killClientByFT(nc^);
598 exit;
599 end;
600 // build packet
601 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
602 begin
603 killClientByFT(nc^);
604 exit;
605 end;
606 chunk := msg.ReadLongInt();
607 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
608 begin
609 killClientByFT(nc^);
610 exit;
611 end;
612 // do it this way, so client may seek, or request retransfers for some reason
613 tf.lastAckChunk := chunk;
614 tf.lastSentChunk := chunk;
615 //e_LogWritefln('client #%d acked file transfer chunk %d', [nc.ID, chunk]);
616 ProcessChunkSend(nc^);
617 end;
618 NTF_CLIENT_MAP_REQUEST:
619 begin
620 e_LogWritefln('client #%d requested map info', [nc.ID]);
621 trans_omsg.Clear();
622 dfn := findDiskWad(MapsDir+gGameSettings.WAD);
623 if (dfn = '') then dfn := '!wad_not_found!.wad'; //FIXME
624 md5 := MD5File(dfn);
625 st := openDiskFileRO(dfn);
626 if not assigned(st) then exit; //wtf?!
627 size := st.size;
628 st.Free;
629 // packet type
630 trans_omsg.Write(Byte(NTF_SERVER_MAP_INFO));
631 // map wad name
632 trans_omsg.Write(gGameSettings.WAD);
633 // map wad md5
634 trans_omsg.Write(md5);
635 // map wad size
636 trans_omsg.Write(size);
637 // number of external resources for map
638 trans_omsg.Write(LongInt(gExternalResources.Count));
639 // external resource names
640 for f := 0 to gExternalResources.Count-1 do
641 begin
642 trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
643 end;
644 // send packet
645 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
646 end;
647 else
648 begin
649 killClientByFT(nc^);
650 exit;
651 end;
652 end;
653 end;
654
655
656 //**************************************************************************
657 //
658 // file transfer crap (both client and server)
659 //
660 //**************************************************************************
661
662 function getNewTimeoutEnd (): Int64;
663 begin
664 result := GetTimerMS();
665 if (g_Net_DownloadTimeout <= 0) then
666 begin
667 result := result+1000*60*3; // 3 minutes
668 end
669 else
670 begin
671 result := result+trunc(g_Net_DownloadTimeout*1000);
672 end;
673 end;
674
675
676 // send map request to server, and wait for "map info" server reply
677 //
678 // returns `false` on error or user abort
679 // fills:
680 // hash
681 // size
682 // chunkSize
683 // returns:
684 // <0 on error
685 // 0 on success
686 // 1 on user abort
687 // 2 on server abort
688 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
689 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; resList: TStringList): Integer;
690 var
691 ev: ENetEvent;
692 rMsgId: Byte;
693 Ptr: Pointer;
694 msg: TMsg;
695 freePacket: Boolean = false;
696 ct, ett: Int64;
697 status: cint;
698 s: AnsiString;
699 rc, f: LongInt;
700 begin
701 // send request
702 trans_omsg.Clear();
703 trans_omsg.Write(Byte(NTF_CLIENT_MAP_REQUEST));
704 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
705
706 FillChar(ev, SizeOf(ev), 0);
707 Result := -1;
708 try
709 ett := getNewTimeoutEnd();
710 repeat
711 status := enet_host_service(NetHost, @ev, 300);
712 if (status < 0) then
713 begin
714 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
715 Result := -1;
716 exit;
717 end;
718 if (status = 0) then
719 begin
720 // check for timeout
721 ct := GetTimerMS();
722 if (ct >= ett) then
723 begin
724 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
725 Result := -1;
726 exit;
727 end;
728 end
729 else
730 begin
731 // some event
732 case ev.kind of
733 ENET_EVENT_TYPE_RECEIVE:
734 begin
735 freePacket := true;
736 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
737 begin
738 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
739 freePacket := false;
740 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
741 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
742 end
743 else
744 begin
745 ett := getNewTimeoutEnd();
746 if (ev.packet.dataLength < 1) then
747 begin
748 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
749 Result := -1;
750 exit;
751 end;
752 Ptr := ev.packet^.data;
753 rMsgId := Byte(Ptr^);
754 e_LogWritefln('g_Net_Wait_MapInfo: got message %u from server (dataLength=%u)', [rMsgId, ev.packet^.dataLength]);
755 if (rMsgId = NTF_SERVER_FILE_INFO) then
756 begin
757 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
758 Result := -1;
759 exit;
760 end
761 else if (rMsgId = NTF_SERVER_ABORT) then
762 begin
763 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
764 Result := 2;
765 exit;
766 end
767 else if (rMsgId = NTF_SERVER_MAP_INFO) then
768 begin
769 e_LogWritefln('g_Net_Wait_MapInfo: creating map info packet...', []);
770 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
771 e_LogWritefln('g_Net_Wait_MapInfo: parsing map info packet (rd=%d; max=%d)...', [msg.ReadCount, msg.MaxSize]);
772 resList.Clear();
773 // map wad name
774 tf.diskName := msg.ReadString();
775 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf.diskName]);
776 // map wad md5
777 tf.hash := msg.ReadMD5();
778 // map wad size
779 tf.size := msg.ReadLongInt();
780 e_LogWritefln('g_Net_Wait_MapInfo: map wad size is %d', [tf.size]);
781 // number of external resources for map
782 rc := msg.ReadLongInt();
783 if (rc < 0) or (rc > 1024) then
784 begin
785 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc]);
786 Result := -1;
787 exit;
788 end;
789 e_LogWritefln('g_Net_Wait_MapInfo: map external resource count is %d', [rc]);
790 // external resource names
791 for f := 0 to rc-1 do
792 begin
793 s := ExtractFileName(msg.ReadString());
794 if (length(s) = 0) then
795 begin
796 Result := -1;
797 exit;
798 end;
799 resList.append(s);
800 end;
801 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
802 Result := 0; // success
803 exit;
804 end
805 else
806 begin
807 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
808 Result := -1;
809 exit;
810 end;
811 end;
812 end;
813 ENET_EVENT_TYPE_DISCONNECT:
814 begin
815 if (ev.data <= NET_DISC_MAX) then
816 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
817 Result := -1;
818 exit;
819 end;
820 else
821 begin
822 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
823 result := -1;
824 exit;
825 end;
826 end;
827 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
828 end;
829 ProcessLoading();
830 if g_Net_UserRequestExit() then
831 begin
832 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
833 Result := 1;
834 exit;
835 end;
836 until false;
837 finally
838 if (freePacket) then enet_packet_destroy(ev.packet);
839 end;
840 end;
841
842
843 // send file request to server, and wait for server reply
844 //
845 // returns `false` on error or user abort
846 // fills:
847 // diskName (actually, base name)
848 // hash
849 // size
850 // chunkSize
851 // returns:
852 // <0 on error
853 // 0 on success
854 // 1 on user abort
855 // 2 on server abort
856 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
857 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
858 var
859 ev: ENetEvent;
860 rMsgId: Byte;
861 Ptr: Pointer;
862 msg: TMsg;
863 freePacket: Boolean = false;
864 ct, ett: Int64;
865 status: cint;
866 begin
867 // send request
868 trans_omsg.Clear();
869 trans_omsg.Write(Byte(NTF_CLIENT_FILE_REQUEST));
870 trans_omsg.Write(resIndex);
871 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
872
873 FillChar(ev, SizeOf(ev), 0);
874 Result := -1;
875 try
876 ett := getNewTimeoutEnd();
877 repeat
878 status := enet_host_service(NetHost, @ev, 300);
879 if (status < 0) then
880 begin
881 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
882 Result := -1;
883 exit;
884 end;
885 if (status = 0) then
886 begin
887 // check for timeout
888 ct := GetTimerMS();
889 if (ct >= ett) then
890 begin
891 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
892 Result := -1;
893 exit;
894 end;
895 end
896 else
897 begin
898 // some event
899 case ev.kind of
900 ENET_EVENT_TYPE_RECEIVE:
901 begin
902 freePacket := true;
903 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
904 begin
905 //e_LogWriteln('g_Net_Wait_Event: skip message from non-transfer channel');
906 freePacket := false;
907 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
908 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
909 end
910 else
911 begin
912 ett := getNewTimeoutEnd();
913 if (ev.packet.dataLength < 1) then
914 begin
915 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
916 Result := -1;
917 exit;
918 end;
919 Ptr := ev.packet^.data;
920 rMsgId := Byte(Ptr^);
921 e_LogWritefln('received transfer packet with id %d (%u bytes)', [rMsgId, ev.packet^.dataLength]);
922 if (rMsgId = NTF_SERVER_FILE_INFO) then
923 begin
924 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
925 tf.hash := msg.ReadMD5();
926 tf.size := msg.ReadLongInt();
927 tf.chunkSize := msg.ReadLongInt();
928 tf.diskName := ExtractFileName(msg.readString());
929 if (tf.size < 0) or (tf.chunkSize <> FILE_CHUNK_SIZE) or (length(tf.diskName) = 0) then
930 begin
931 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
932 Result := -1;
933 exit;
934 end;
935 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex, tf.size, tf.diskName]);
936 Result := 0; // success
937 exit;
938 end
939 else if (rMsgId = NTF_SERVER_ABORT) then
940 begin
941 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
942 Result := 2;
943 exit;
944 end
945 else if (rMsgId = NTF_SERVER_MAP_INFO) then
946 begin
947 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
948 Result := -1;
949 exit;
950 end
951 else
952 begin
953 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
954 Result := -1;
955 exit;
956 end;
957 end;
958 end;
959 ENET_EVENT_TYPE_DISCONNECT:
960 begin
961 if (ev.data <= NET_DISC_MAX) then
962 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
963 Result := -1;
964 exit;
965 end;
966 else
967 begin
968 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
969 result := -1;
970 exit;
971 end;
972 end;
973 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
974 end;
975 ProcessLoading();
976 if g_Net_UserRequestExit() then
977 begin
978 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
979 Result := 1;
980 exit;
981 end;
982 until false;
983 finally
984 if (freePacket) then enet_packet_destroy(ev.packet);
985 end;
986 end;
987
988
989 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
990 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
991 begin
992 result := false;
993 e_LogWritefln('aborting file transfer...', []);
994 // send request
995 trans_omsg.Clear();
996 trans_omsg.Write(Byte(NTF_CLIENT_ABORT));
997 result := ftransSendClientMsg(trans_omsg);
998 if result then enet_host_flush(NetHost);
999 end;
1000
1001
1002 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1003 //
1004 // returns `false` on error or user abort
1005 // fills:
1006 // hash
1007 // size
1008 // chunkSize
1009 // returns:
1010 // <0 on error
1011 // 0 on success
1012 // 1 on user abort
1013 // 2 on server abort
1014 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1015 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
1016 var
1017 ev: ENetEvent;
1018 rMsgId: Byte;
1019 Ptr: Pointer;
1020 msg: TMsg;
1021 freePacket: Boolean = false;
1022 ct, ett: Int64;
1023 status: cint;
1024 nextChunk: Integer = 0;
1025 chunkTotal: Integer;
1026 chunk: Integer;
1027 csize: Integer;
1028 buf: PChar = nil;
1029 resumed: Boolean;
1030 //stx: Int64;
1031 begin
1032 tf.resumed := false;
1033 e_LogWritefln('file `%s`, size=%d (%d)', [tf.diskName, Integer(strm.size), tf.size], TMsgType.Notify);
1034 // check if we should resume downloading
1035 resumed := (strm.size > tf.chunkSize) and (strm.size < tf.size);
1036 // send request
1037 trans_omsg.Clear();
1038 trans_omsg.Write(Byte(NTF_CLIENT_START));
1039 if resumed then chunk := strm.size div tf.chunkSize else chunk := 0;
1040 trans_omsg.Write(LongInt(chunk));
1041 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1042
1043 strm.Seek(chunk*tf.chunkSize, soFromBeginning);
1044 chunkTotal := (tf.size+tf.chunkSize-1) div tf.chunkSize;
1045 e_LogWritefln('receiving file `%s` (%d chunks)', [tf.diskName, chunkTotal], TMsgType.Notify);
1046 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf.diskName)+'"', chunkTotal, False);
1047 tf.resumed := resumed;
1048
1049 if (chunk > 0) then g_Game_StepLoading(chunk);
1050 nextChunk := chunk;
1051
1052 // wait for reply data
1053 FillChar(ev, SizeOf(ev), 0);
1054 Result := -1;
1055 GetMem(buf, tf.chunkSize);
1056 try
1057 ett := getNewTimeoutEnd();
1058 repeat
1059 //stx := -GetTimerMS();
1060 status := enet_host_service(NetHost, @ev, 300);
1061 if (status < 0) then
1062 begin
1063 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1064 Result := -1;
1065 exit;
1066 end;
1067 if (status = 0) then
1068 begin
1069 // check for timeout
1070 ct := GetTimerMS();
1071 if (ct >= ett) then
1072 begin
1073 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1074 Result := -1;
1075 exit;
1076 end;
1077 end
1078 else
1079 begin
1080 // some event
1081 case ev.kind of
1082 ENET_EVENT_TYPE_RECEIVE:
1083 begin
1084 freePacket := true;
1085 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1086 begin
1087 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1088 freePacket := false;
1089 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1090 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1091 end
1092 else
1093 begin
1094 //stx := stx+GetTimerMS();
1095 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1096 //stx := -GetTimerMS();
1097 ett := getNewTimeoutEnd();
1098 if (ev.packet.dataLength < 1) then
1099 begin
1100 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1101 Result := -1;
1102 exit;
1103 end;
1104 Ptr := ev.packet^.data;
1105 rMsgId := Byte(Ptr^);
1106 if (rMsgId = NTF_SERVER_DONE) then
1107 begin
1108 e_LogWritefln('file transfer complete.', []);
1109 result := 0;
1110 exit;
1111 end
1112 else if (rMsgId = NTF_SERVER_CHUNK) then
1113 begin
1114 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1115 chunk := msg.ReadLongInt();
1116 csize := msg.ReadLongInt();
1117 if (chunk <> nextChunk) then
1118 begin
1119 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk, nextChunk]);
1120 Result := -1;
1121 exit;
1122 end;
1123 if (csize < 0) or (csize > tf.chunkSize) then
1124 begin
1125 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize, tf.chunkSize]);
1126 Result := -1;
1127 exit;
1128 end;
1129 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1130 msg.ReadData(buf, csize);
1131 strm.WriteBuffer(buf^, csize);
1132 nextChunk := chunk+1;
1133 g_Game_StepLoading();
1134 // send ack
1135 trans_omsg.Clear();
1136 trans_omsg.Write(Byte(NTF_CLIENT_ACK));
1137 trans_omsg.Write(LongInt(chunk));
1138 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1139 end
1140 else if (rMsgId = NTF_SERVER_ABORT) then
1141 begin
1142 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1143 Result := 2;
1144 exit;
1145 end
1146 else
1147 begin
1148 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1149 Result := -1;
1150 exit;
1151 end;
1152 //stx := stx+GetTimerMS();
1153 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1154 end;
1155 end;
1156 ENET_EVENT_TYPE_DISCONNECT:
1157 begin
1158 if (ev.data <= NET_DISC_MAX) then
1159 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1160 Result := -1;
1161 exit;
1162 end;
1163 else
1164 begin
1165 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1166 result := -1;
1167 exit;
1168 end;
1169 end;
1170 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1171 end;
1172 ProcessLoading();
1173 if g_Net_UserRequestExit() then
1174 begin
1175 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1176 Result := 1;
1177 exit;
1178 end;
1179 until false;
1180 finally
1181 FreeMem(buf);
1182 if (freePacket) then enet_packet_destroy(ev.packet);
1183 end;
1184 end;
1185
1186
1187 //**************************************************************************
1188 //
1189 // common functions
1190 //
1191 //**************************************************************************
1192
1193 function g_Net_FindSlot(): Integer;
1194 var
1195 I: Integer;
1196 F: Boolean;
1197 N, C: Integer;
1198 begin
1199 N := -1;
1200 F := False;
1201 C := 0;
1202 for I := Low(NetClients) to High(NetClients) do
1203 begin
1204 if NetClients[I].Used then
1205 Inc(C)
1206 else
1207 if not F then
1208 begin
1209 F := True;
1210 N := I;
1211 end;
1212 end;
1213 if C >= NetMaxClients then
1214 begin
1215 Result := -1;
1216 Exit;
1217 end;
1218
1219 if not F then
1220 begin
1221 if (Length(NetClients) >= NetMaxClients) then
1222 N := -1
1223 else
1224 begin
1225 SetLength(NetClients, Length(NetClients) + 1);
1226 N := High(NetClients);
1227 end;
1228 end;
1229
1230 if N >= 0 then
1231 begin
1232 NetClients[N].Used := True;
1233 NetClients[N].ID := N;
1234 NetClients[N].RequestedFullUpdate := False;
1235 NetClients[N].RCONAuth := False;
1236 NetClients[N].Voted := False;
1237 NetClients[N].Player := 0;
1238 clearNetClientTransfers(NetClients[N]); // just in case
1239 end;
1240
1241 Result := N;
1242 end;
1243
1244 function g_Net_Init(): Boolean;
1245 var
1246 F: TextFile;
1247 IPstr: string;
1248 IP: LongWord;
1249 begin
1250 NetIn.Clear();
1251 NetOut.Clear();
1252 NetBuf[NET_UNRELIABLE].Clear();
1253 NetBuf[NET_RELIABLE].Clear();
1254 //SetLength(NetClients, 0);
1255 clearNetClients(true); // clear array
1256 NetPeer := nil;
1257 NetHost := nil;
1258 NetMyID := -1;
1259 NetPlrUID1 := -1;
1260 NetPlrUID2 := -1;
1261 NetAddr.port := 25666;
1262 SetLength(NetBannedHosts, 0);
1263 if FileExists(DataDir + BANLIST_FILENAME) then
1264 begin
1265 Assign(F, DataDir + BANLIST_FILENAME);
1266 Reset(F);
1267 while not EOF(F) do
1268 begin
1269 Readln(F, IPstr);
1270 if StrToIp(IPstr, IP) then
1271 g_Net_BanHost(IP);
1272 end;
1273 CloseFile(F);
1274 g_Net_SaveBanList();
1275 end;
1276
1277 Result := (enet_initialize() = 0);
1278 end;
1279
1280 procedure g_Net_Flush();
1281 var
1282 T: Integer;
1283 P: pENetPacket;
1284 F, Chan: enet_uint32;
1285 I: Integer;
1286 begin
1287 F := 0;
1288 Chan := NET_CHAN_GAME;
1289
1290 if NetMode = NET_SERVER then
1291 for T := NET_UNRELIABLE to NET_RELIABLE do
1292 begin
1293 if NetBuf[T].CurSize > 0 then
1294 begin
1295 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1296 if not Assigned(P) then continue;
1297 enet_host_broadcast(NetHost, Chan, P);
1298 NetBuf[T].Clear();
1299 end;
1300
1301 for I := Low(NetClients) to High(NetClients) do
1302 begin
1303 if not NetClients[I].Used then continue;
1304 if NetClients[I].NetOut[T].CurSize <= 0 then continue;
1305 P := enet_packet_create(NetClients[I].NetOut[T].Data, NetClients[I].NetOut[T].CurSize, F);
1306 if not Assigned(P) then continue;
1307 enet_peer_send(NetClients[I].Peer, Chan, P);
1308 NetClients[I].NetOut[T].Clear();
1309 end;
1310
1311 // next and last iteration is always RELIABLE
1312 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1313 Chan := NET_CHAN_IMPORTANT;
1314 end
1315 else if NetMode = NET_CLIENT then
1316 for T := NET_UNRELIABLE to NET_RELIABLE do
1317 begin
1318 if NetBuf[T].CurSize > 0 then
1319 begin
1320 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1321 if not Assigned(P) then continue;
1322 enet_peer_send(NetPeer, Chan, P);
1323 NetBuf[T].Clear();
1324 end;
1325 // next and last iteration is always RELIABLE
1326 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1327 Chan := NET_CHAN_IMPORTANT;
1328 end;
1329 end;
1330
1331 procedure g_Net_Cleanup();
1332 begin
1333 NetIn.Clear();
1334 NetOut.Clear();
1335 NetBuf[NET_UNRELIABLE].Clear();
1336 NetBuf[NET_RELIABLE].Clear();
1337
1338 //SetLength(NetClients, 0);
1339 clearNetClients(true); // clear array
1340 NetClientCount := 0;
1341
1342 NetPeer := nil;
1343 NetHost := nil;
1344 NetMPeer := nil;
1345 NetMHost := nil;
1346 NetMyID := -1;
1347 NetPlrUID1 := -1;
1348 NetPlrUID2 := -1;
1349 NetState := NET_STATE_NONE;
1350
1351 NetPongSock := ENET_SOCKET_NULL;
1352
1353 NetTimeToMaster := 0;
1354 NetTimeToUpdate := 0;
1355 NetTimeToReliable := 0;
1356
1357 NetMode := NET_NONE;
1358
1359 if NetPortThread <> NilThreadId then
1360 WaitForThreadTerminate(NetPortThread, 66666);
1361
1362 NetPortThread := NilThreadId;
1363 g_Net_UnforwardPorts();
1364
1365 if NetDump then
1366 g_Net_DumpEnd();
1367 end;
1368
1369 procedure g_Net_Free();
1370 begin
1371 g_Net_Cleanup();
1372
1373 enet_deinitialize();
1374 NetInitDone := False;
1375 end;
1376
1377
1378 //**************************************************************************
1379 //
1380 // SERVER FUNCTIONS
1381 //
1382 //**************************************************************************
1383
1384 function ForwardThread(Param: Pointer): PtrInt;
1385 begin
1386 Result := 0;
1387 if not g_Net_ForwardPorts() then Result := -1;
1388 end;
1389
1390 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
1391 begin
1392 if NetMode <> NET_NONE then
1393 begin
1394 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
1395 Result := False;
1396 Exit;
1397 end;
1398
1399 Result := True;
1400
1401 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
1402 if not NetInitDone then
1403 begin
1404 if (not g_Net_Init()) then
1405 begin
1406 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
1407 Result := False;
1408 Exit;
1409 end
1410 else
1411 NetInitDone := True;
1412 end;
1413
1414 NetAddr.host := IPAddr;
1415 NetAddr.port := Port;
1416
1417 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
1418
1419 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
1420
1421 if (NetHost = nil) then
1422 begin
1423 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
1424 Result := False;
1425 g_Net_Cleanup;
1426 Exit;
1427 end;
1428
1429 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1430 if NetPongSock <> ENET_SOCKET_NULL then
1431 begin
1432 NetPongAddr.host := IPAddr;
1433 NetPongAddr.port := NET_PING_PORT;
1434 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
1435 begin
1436 enet_socket_destroy(NetPongSock);
1437 NetPongSock := ENET_SOCKET_NULL;
1438 end
1439 else
1440 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
1441 end;
1442
1443 NetMode := NET_SERVER;
1444 NetOut.Clear();
1445 NetBuf[NET_UNRELIABLE].Clear();
1446 NetBuf[NET_RELIABLE].Clear();
1447
1448 if NetDump then
1449 g_Net_DumpStart();
1450 end;
1451
1452 procedure g_Net_Host_Die();
1453 var
1454 I: Integer;
1455 begin
1456 if NetMode <> NET_SERVER then Exit;
1457
1458 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
1459 for I := 0 to High(NetClients) do
1460 if NetClients[I].Used then
1461 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
1462
1463 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
1464 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
1465 enet_packet_destroy(NetEvent.packet);
1466
1467 for I := 0 to High(NetClients) do
1468 if NetClients[I].Used then
1469 begin
1470 FreeMemory(NetClients[I].Peer^.data);
1471 NetClients[I].Peer^.data := nil;
1472 enet_peer_reset(NetClients[I].Peer);
1473 NetClients[I].Peer := nil;
1474 NetClients[I].Used := False;
1475 NetClients[I].NetOut[NET_UNRELIABLE].Free();
1476 NetClients[I].NetOut[NET_RELIABLE].Free();
1477 end;
1478
1479 clearNetClients(false); // don't clear array
1480 if (NetMPeer <> nil) and (NetMHost <> nil) then g_Net_Slist_Disconnect;
1481 if NetPongSock <> ENET_SOCKET_NULL then
1482 enet_socket_destroy(NetPongSock);
1483
1484 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
1485 enet_host_destroy(NetHost);
1486
1487 NetMode := NET_NONE;
1488
1489 g_Net_Cleanup;
1490 e_WriteLog('NET: Server stopped', TMsgType.Notify);
1491 end;
1492
1493
1494 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1495 var
1496 T: Integer;
1497 begin
1498 if (Reliable) then
1499 T := NET_RELIABLE
1500 else
1501 T := NET_UNRELIABLE;
1502
1503 if (ID >= 0) then
1504 begin
1505 if ID > High(NetClients) then Exit;
1506 if NetClients[ID].Peer = nil then Exit;
1507 // write size first
1508 NetClients[ID].NetOut[T].Write(Integer(NetOut.CurSize));
1509 NetClients[ID].NetOut[T].Write(NetOut);
1510 end
1511 else
1512 begin
1513 // write size first
1514 NetBuf[T].Write(Integer(NetOut.CurSize));
1515 NetBuf[T].Write(NetOut);
1516 end;
1517
1518 if NetDump then g_Net_DumpSendBuffer();
1519 NetOut.Clear();
1520 end;
1521
1522 procedure g_Net_Host_CheckPings();
1523 var
1524 ClAddr: ENetAddress;
1525 Buf: ENetBuffer;
1526 Len: Integer;
1527 ClTime: Int64;
1528 Ping: array [0..9] of Byte;
1529 NPl: Byte;
1530 begin
1531 if NetPongSock = ENET_SOCKET_NULL then Exit;
1532
1533 Buf.data := Addr(Ping[0]);
1534 Buf.dataLength := 2+8;
1535
1536 Ping[0] := 0;
1537
1538 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
1539 if Len < 0 then Exit;
1540
1541 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
1542 begin
1543 ClTime := Int64(Addr(Ping[2])^);
1544
1545 NetOut.Clear();
1546 NetOut.Write(Byte(Ord('D')));
1547 NetOut.Write(Byte(Ord('F')));
1548 NetOut.Write(NetPort);
1549 NetOut.Write(ClTime);
1550 g_Net_Slist_WriteInfo();
1551 NPl := 0;
1552 if gPlayer1 <> nil then Inc(NPl);
1553 if gPlayer2 <> nil then Inc(NPl);
1554 NetOut.Write(NPl);
1555 NetOut.Write(gNumBots);
1556
1557 Buf.data := NetOut.Data;
1558 Buf.dataLength := NetOut.CurSize;
1559 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
1560
1561 NetOut.Clear();
1562 end;
1563 end;
1564
1565
1566 function g_Net_Host_Update(): enet_size_t;
1567 var
1568 IP: string;
1569 Port: Word;
1570 ID: Integer;
1571 TC: pTNetClient;
1572 TP: TPlayer;
1573 begin
1574 IP := '';
1575 Result := 0;
1576
1577 if NetUseMaster then g_Net_Slist_Check;
1578 g_Net_Host_CheckPings;
1579
1580 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1581 begin
1582 case (NetEvent.kind) of
1583 ENET_EVENT_TYPE_CONNECT:
1584 begin
1585 IP := IpToStr(NetEvent.Peer^.address.host);
1586 Port := NetEvent.Peer^.address.port;
1587 g_Console_Add(_lc[I_NET_MSG] +
1588 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
1589
1590 if (NetEvent.data <> NET_PROTOCOL_VER) then
1591 begin
1592 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1593 _lc[I_NET_DISC_PROTOCOL]);
1594 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
1595 Byte(NetEvent.peer^.data^) := 255;
1596 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
1597 enet_host_flush(NetHost);
1598 Exit;
1599 end;
1600
1601 ID := g_Net_FindSlot();
1602
1603 if ID < 0 then
1604 begin
1605 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1606 _lc[I_NET_DISC_FULL]);
1607 NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
1608 Byte(NetEvent.peer^.data^) := 255;
1609 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
1610 enet_host_flush(NetHost);
1611 Exit;
1612 end;
1613
1614 NetClients[ID].Peer := NetEvent.peer;
1615 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
1616 Byte(NetClients[ID].Peer^.data^) := ID;
1617 NetClients[ID].State := NET_STATE_AUTH;
1618 NetClients[ID].RCONAuth := False;
1619 NetClients[ID].NetOut[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
1620 NetClients[ID].NetOut[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
1621 clearNetClientTransfers(NetClients[ID]); // just in case
1622
1623 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1624
1625 Inc(NetClientCount);
1626 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
1627 end;
1628
1629 ENET_EVENT_TYPE_RECEIVE:
1630 begin
1631 //e_LogWritefln('RECEIVE: chan=%u', [NetEvent.channelID]);
1632 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then
1633 begin
1634 ProcessDownloadExPacket();
1635 end
1636 else
1637 begin
1638 ID := Byte(NetEvent.peer^.data^);
1639 if ID > High(NetClients) then Exit;
1640 TC := @NetClients[ID];
1641
1642 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1643 g_Net_Host_HandlePacket(TC, NetEvent.packet, g_Net_HostMsgHandler);
1644 end;
1645 end;
1646
1647 ENET_EVENT_TYPE_DISCONNECT:
1648 begin
1649 ID := Byte(NetEvent.peer^.data^);
1650 if ID > High(NetClients) then Exit;
1651 clearNetClient(NetClients[ID]);
1652 TC := @NetClients[ID];
1653 if TC = nil then Exit;
1654
1655 if not (TC^.Used) then Exit;
1656
1657 TP := g_Player_Get(TC^.Player);
1658
1659 if TP <> nil then
1660 begin
1661 TP.Lives := 0;
1662 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
1663 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
1664 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', TMsgType.Notify);
1665 g_Player_Remove(TP.UID);
1666 end;
1667
1668 TC^.Used := False;
1669 TC^.State := NET_STATE_NONE;
1670 TC^.Peer := nil;
1671 TC^.Player := 0;
1672 TC^.RequestedFullUpdate := False;
1673 TC^.NetOut[NET_UNRELIABLE].Free();
1674 TC^.NetOut[NET_RELIABLE].Free();
1675
1676 FreeMemory(NetEvent.peer^.data);
1677 NetEvent.peer^.data := nil;
1678 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
1679 Dec(NetClientCount);
1680
1681 if NetUseMaster then g_Net_Slist_Update;
1682 end;
1683 end;
1684 end;
1685 end;
1686
1687
1688 //**************************************************************************
1689 //
1690 // CLIENT FUNCTIONS
1691 //
1692 //**************************************************************************
1693
1694 procedure g_Net_Disconnect(Forced: Boolean = False);
1695 begin
1696 if NetMode <> NET_CLIENT then Exit;
1697 if (NetHost = nil) or (NetPeer = nil) then Exit;
1698
1699 if not Forced then
1700 begin
1701 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
1702
1703 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
1704 begin
1705 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1706 begin
1707 NetPeer := nil;
1708 break;
1709 end;
1710
1711 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1712 enet_packet_destroy(NetEvent.packet);
1713 end;
1714
1715 if NetPeer <> nil then
1716 begin
1717 enet_peer_reset(NetPeer);
1718 NetPeer := nil;
1719 end;
1720 end
1721 else
1722 begin
1723 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
1724 if (NetEvent.data <= NET_DISC_MAX) then
1725 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
1726 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
1727 end;
1728
1729 if NetHost <> nil then
1730 begin
1731 enet_host_destroy(NetHost);
1732 NetHost := nil;
1733 end;
1734 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
1735
1736 g_Net_Cleanup;
1737 e_WriteLog('NET: Disconnected', TMsgType.Notify);
1738 end;
1739
1740 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1741 var
1742 T: Integer;
1743 begin
1744 if (Reliable) then
1745 T := NET_RELIABLE
1746 else
1747 T := NET_UNRELIABLE;
1748
1749 // write size first
1750 NetBuf[T].Write(Integer(NetOut.CurSize));
1751 NetBuf[T].Write(NetOut);
1752
1753 if NetDump then g_Net_DumpSendBuffer();
1754 NetOut.Clear();
1755 g_Net_Flush(); // FIXME: for now, send immediately
1756 end;
1757
1758 function g_Net_Client_Update(): enet_size_t;
1759 begin
1760 Result := 0;
1761 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1762 begin
1763 case NetEvent.kind of
1764 ENET_EVENT_TYPE_RECEIVE:
1765 begin
1766 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1767 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1768 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientMsgHandler);
1769 end;
1770
1771 ENET_EVENT_TYPE_DISCONNECT:
1772 begin
1773 g_Net_Disconnect(True);
1774 Result := 1;
1775 Exit;
1776 end;
1777 end;
1778 end
1779 end;
1780
1781 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
1782 begin
1783 Result := 0;
1784 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1785 begin
1786 case NetEvent.kind of
1787 ENET_EVENT_TYPE_RECEIVE:
1788 begin
1789 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1790 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1791 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientLightMsgHandler);
1792 end;
1793
1794 ENET_EVENT_TYPE_DISCONNECT:
1795 begin
1796 g_Net_Disconnect(True);
1797 Result := 1;
1798 Exit;
1799 end;
1800 end;
1801 end;
1802 g_Net_Flush();
1803 end;
1804
1805 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
1806 var
1807 OuterLoop: Boolean;
1808 TimeoutTime, T: Int64;
1809 begin
1810 if NetMode <> NET_NONE then
1811 begin
1812 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
1813 Result := False;
1814 Exit;
1815 end;
1816
1817 Result := True;
1818
1819 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
1820 [IP, Port]));
1821 if not NetInitDone then
1822 begin
1823 if (not g_Net_Init()) then
1824 begin
1825 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
1826 Result := False;
1827 Exit;
1828 end
1829 else
1830 NetInitDone := True;
1831 end;
1832
1833 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
1834
1835 if (NetHost = nil) then
1836 begin
1837 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1838 g_Net_Cleanup;
1839 Result := False;
1840 Exit;
1841 end;
1842
1843 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
1844 NetAddr.port := Port;
1845
1846 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
1847
1848 if (NetPeer = nil) then
1849 begin
1850 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1851 enet_host_destroy(NetHost);
1852 g_Net_Cleanup;
1853 Result := False;
1854 Exit;
1855 end;
1856
1857 // предупредить что ждем слишком долго через N секунд
1858 TimeoutTime := GetTimer() + NET_CONNECT_TIMEOUT;
1859
1860 OuterLoop := True;
1861 while OuterLoop do
1862 begin
1863 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1864 begin
1865 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1866 begin
1867 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
1868 NetMode := NET_CLIENT;
1869 NetOut.Clear();
1870 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1871 NetClientIP := IP;
1872 NetClientPort := Port;
1873 if NetDump then
1874 g_Net_DumpStart();
1875 Exit;
1876 end;
1877 end;
1878
1879 T := GetTimer();
1880 if T > TimeoutTime then
1881 begin
1882 TimeoutTime := T + NET_CONNECT_TIMEOUT * 100; // одного предупреждения хватит
1883 g_Console_Add(_lc[I_NET_MSG_TIMEOUT_WARN], True);
1884 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1885 end;
1886
1887 ProcessLoading(true);
1888
1889 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1890 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1891 OuterLoop := False;
1892 end;
1893
1894 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
1895 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1896 if NetPeer <> nil then enet_peer_reset(NetPeer);
1897 if NetHost <> nil then
1898 begin
1899 enet_host_destroy(NetHost);
1900 NetHost := nil;
1901 end;
1902 g_Net_Cleanup();
1903 Result := False;
1904 end;
1905
1906 function IpToStr(IP: LongWord): string;
1907 var
1908 Ptr: Pointer;
1909 begin
1910 Ptr := Addr(IP);
1911 Result := IntToStr(PByte(Ptr + 0)^) + '.';
1912 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
1913 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
1914 Result := Result + IntToStr(PByte(Ptr + 3)^);
1915 end;
1916
1917 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
1918 var
1919 EAddr: ENetAddress;
1920 begin
1921 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
1922 IP := EAddr.host;
1923 end;
1924
1925 function g_Net_Client_ByName(Name: string): pTNetClient;
1926 var
1927 a: Integer;
1928 pl: TPlayer;
1929 begin
1930 Result := nil;
1931 for a := Low(NetClients) to High(NetClients) do
1932 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
1933 begin
1934 pl := g_Player_Get(NetClients[a].Player);
1935 if pl = nil then continue;
1936 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
1937 if NetClients[a].Peer <> nil then
1938 begin
1939 Result := @NetClients[a];
1940 Exit;
1941 end;
1942 end;
1943 end;
1944
1945 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
1946 var
1947 a: Integer;
1948 begin
1949 Result := nil;
1950 for a := Low(NetClients) to High(NetClients) do
1951 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
1952 if NetClients[a].Player = PID then
1953 begin
1954 Result := @NetClients[a];
1955 Exit;
1956 end;
1957 end;
1958
1959 function g_Net_ClientName_ByID(ID: Integer): string;
1960 var
1961 a: Integer;
1962 pl: TPlayer;
1963 begin
1964 Result := '';
1965 if ID = NET_EVERYONE then
1966 Exit;
1967 for a := Low(NetClients) to High(NetClients) do
1968 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
1969 begin
1970 pl := g_Player_Get(NetClients[a].Player);
1971 if pl = nil then Exit;
1972 Result := pl.Name;
1973 end;
1974 end;
1975
1976 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
1977 var
1978 P: pENetPacket;
1979 F: enet_uint32;
1980 dataLength: Cardinal;
1981 begin
1982 dataLength := Length(Data);
1983
1984 if (Reliable) then
1985 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
1986 else
1987 F := 0;
1988
1989 if (peer <> nil) then
1990 begin
1991 P := enet_packet_create(@Data[0], dataLength, F);
1992 if not Assigned(P) then Exit;
1993 enet_peer_send(peer, Chan, P);
1994 end
1995 else
1996 begin
1997 P := enet_packet_create(@Data[0], dataLength, F);
1998 if not Assigned(P) then Exit;
1999 enet_host_broadcast(NetHost, Chan, P);
2000 end;
2001
2002 enet_host_flush(NetHost);
2003 end;
2004
2005 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
2006 var
2007 I: Integer;
2008 begin
2009 Result := False;
2010 if NetBannedHosts = nil then
2011 Exit;
2012 for I := 0 to High(NetBannedHosts) do
2013 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
2014 begin
2015 Result := True;
2016 break;
2017 end;
2018 end;
2019
2020 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
2021 var
2022 I, P: Integer;
2023 begin
2024 if IP = 0 then
2025 Exit;
2026 if g_Net_IsHostBanned(IP, Perm) then
2027 Exit;
2028
2029 P := -1;
2030 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2031 if NetBannedHosts[I].IP = 0 then
2032 begin
2033 P := I;
2034 break;
2035 end;
2036
2037 if P < 0 then
2038 begin
2039 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
2040 P := High(NetBannedHosts);
2041 end;
2042
2043 NetBannedHosts[P].IP := IP;
2044 NetBannedHosts[P].Perm := Perm;
2045 end;
2046
2047 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
2048 var
2049 a: LongWord;
2050 b: Boolean;
2051 begin
2052 b := StrToIp(IP, a);
2053 if b then
2054 g_Net_BanHost(a, Perm);
2055 end;
2056
2057 procedure g_Net_UnbanNonPermHosts();
2058 var
2059 I: Integer;
2060 begin
2061 if NetBannedHosts = nil then
2062 Exit;
2063 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2064 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
2065 begin
2066 NetBannedHosts[I].IP := 0;
2067 NetBannedHosts[I].Perm := True;
2068 end;
2069 end;
2070
2071 function g_Net_UnbanHost(IP: string): Boolean; overload;
2072 var
2073 a: LongWord;
2074 begin
2075 Result := StrToIp(IP, a);
2076 if Result then
2077 Result := g_Net_UnbanHost(a);
2078 end;
2079
2080 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
2081 var
2082 I: Integer;
2083 begin
2084 Result := False;
2085 if IP = 0 then
2086 Exit;
2087 if NetBannedHosts = nil then
2088 Exit;
2089 for I := 0 to High(NetBannedHosts) do
2090 if NetBannedHosts[I].IP = IP then
2091 begin
2092 NetBannedHosts[I].IP := 0;
2093 NetBannedHosts[I].Perm := True;
2094 Result := True;
2095 // no break here to clear all bans of this host, perm and non-perm
2096 end;
2097 end;
2098
2099 procedure g_Net_SaveBanList();
2100 var
2101 F: TextFile;
2102 I: Integer;
2103 begin
2104 Assign(F, DataDir + BANLIST_FILENAME);
2105 Rewrite(F);
2106 if NetBannedHosts <> nil then
2107 for I := 0 to High(NetBannedHosts) do
2108 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
2109 Writeln(F, IpToStr(NetBannedHosts[I].IP));
2110 CloseFile(F);
2111 end;
2112
2113 procedure g_Net_DumpStart();
2114 begin
2115 if NetMode = NET_SERVER then
2116 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
2117 else
2118 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
2119 end;
2120
2121 procedure g_Net_DumpSendBuffer();
2122 begin
2123 writeInt(NetDumpFile, gTime);
2124 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
2125 writeInt(NetDumpFile, Byte(1));
2126 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
2127 end;
2128
2129 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
2130 begin
2131 if (Buf = nil) or (Len = 0) then Exit;
2132 writeInt(NetDumpFile, gTime);
2133 writeInt(NetDumpFile, Len);
2134 writeInt(NetDumpFile, Byte(0));
2135 NetDumpFile.WriteBuffer(Buf^, Len);
2136 end;
2137
2138 procedure g_Net_DumpEnd();
2139 begin
2140 NetDumpFile.Free();
2141 NetDumpFile := nil;
2142 end;
2143
2144 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
2145 {$IFDEF USE_MINIUPNPC}
2146 var
2147 DevList: PUPNPDev;
2148 Urls: TUPNPUrls;
2149 Data: TIGDDatas;
2150 LanAddr: array [0..255] of Char;
2151 StrPort: AnsiString;
2152 Err, I: Integer;
2153 begin
2154 Result := False;
2155
2156 if NetPortForwarded = NetPort then
2157 begin
2158 Result := True;
2159 exit;
2160 end;
2161
2162 NetPongForwarded := False;
2163 NetPortForwarded := 0;
2164
2165 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
2166 if DevList = nil then
2167 begin
2168 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
2169 exit;
2170 end;
2171
2172 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
2173
2174 if I = 0 then
2175 begin
2176 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2177 FreeUPNPDevList(DevList);
2178 FreeUPNPUrls(@Urls);
2179 exit;
2180 end;
2181
2182 StrPort := IntToStr(NetPort);
2183 I := UPNP_AddPortMapping(
2184 Urls.controlURL, Addr(data.first.servicetype[1]),
2185 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2186 PChar('UDP'), nil, PChar('0')
2187 );
2188
2189 if I <> 0 then
2190 begin
2191 conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
2192 FreeUPNPDevList(DevList);
2193 FreeUPNPUrls(@Urls);
2194 exit;
2195 end;
2196
2197 if ForwardPongPort then
2198 begin
2199 StrPort := IntToStr(NET_PING_PORT);
2200 I := UPNP_AddPortMapping(
2201 Urls.controlURL, Addr(data.first.servicetype[1]),
2202 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2203 PChar('UDP'), nil, PChar('0')
2204 );
2205
2206 if I <> 0 then
2207 begin
2208 conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
2209 NetPongForwarded := False;
2210 end
2211 else
2212 begin
2213 conwritefln('forwarded port %d successfully', [NetPort + 1]);
2214 NetPongForwarded := True;
2215 end;
2216 end;
2217
2218 conwritefln('forwarded port %d successfully', [NetPort]);
2219 NetIGDControl := AnsiString(Urls.controlURL);
2220 NetIGDService := data.first.servicetype;
2221 NetPortForwarded := NetPort;
2222
2223 FreeUPNPDevList(DevList);
2224 FreeUPNPUrls(@Urls);
2225 Result := True;
2226 end;
2227 {$ELSE}
2228 begin
2229 Result := False;
2230 end;
2231 {$ENDIF}
2232
2233 procedure g_Net_UnforwardPorts();
2234 {$IFDEF USE_MINIUPNPC}
2235 var
2236 I: Integer;
2237 StrPort: AnsiString;
2238 begin
2239 if NetPortForwarded = 0 then Exit;
2240
2241 conwriteln('unforwarding ports...');
2242
2243 StrPort := IntToStr(NetPortForwarded);
2244 I := UPNP_DeletePortMapping(
2245 PChar(NetIGDControl), Addr(NetIGDService[1]),
2246 PChar(StrPort), PChar('UDP'), nil
2247 );
2248 conwritefln(' port %d: %d', [NetPortForwarded, I]);
2249
2250 if NetPongForwarded then
2251 begin
2252 NetPongForwarded := False;
2253 StrPort := IntToStr(NetPortForwarded + 1);
2254 I := UPNP_DeletePortMapping(
2255 PChar(NetIGDControl), Addr(NetIGDService[1]),
2256 PChar(StrPort), PChar('UDP'), nil
2257 );
2258 conwritefln(' port %d: %d', [NetPortForwarded + 1, I]);
2259 end;
2260
2261 NetPortForwarded := 0;
2262 end;
2263 {$ELSE}
2264 begin
2265 end;
2266 {$ENDIF}
2267
2268
2269 initialization
2270 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2271 SetLength(NetClients, 0);
2272 g_Net_DownloadTimeout := 60;
2273 NetIn.Alloc(NET_BUFSIZE);
2274 NetOut.Alloc(NET_BUFSIZE);
2275 NetBuf[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
2276 NetBuf[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
2277 trans_omsg.Alloc(NET_BUFSIZE);
2278 finalization
2279 NetIn.Free();
2280 NetOut.Free();
2281 NetBuf[NET_UNRELIABLE].Free();
2282 NetBuf[NET_RELIABLE].Free();
2283 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024