Merge branch 'dev' into dht
[brdnet.git] / RecvTC.pas
blobf6a2d77e4acbfe1c171822283f34fb7ddf519933
1 uses MemStream,NetAddr
2 ,SysUtils,Sockets,UnixType,BaseUnix
6 var s_inet:tSocket;
8 procedure SC(fn:pointer; retval:cint);
9 begin
10 if retval < 0 then begin
11 raise eXception.Create(Format('Socket error %d operation %P',[SocketError,fn]));
12 end;
13 end;
15 var CurMark:byte=0;
16 var PrvMark:byte=0;
17 var StartT:tDateTime;
18 var Total:LongWord=0;
19 var DGcnt:LongWord=0;
20 {opcode 4=data, 8=data-no-report, 6=data-immediate-ack}
21 {opcode 5=cont, 7=ack}
23 procedure HandleMSG(sock:tSocket; var s:tMemoryStream; const from: tSockAddr);
24 var opcode:byte;
25 var mark:byte;
26 var sendbuf:array [1..128] of byte;
27 var r:tMemoryStream;
28 var rateR:real;
29 var rate:DWord; {BytesPerSecond shr 6 (=64)}
30 begin
31 r.Init(@sendbuf,0,128);
32 opcode:=s.ReadByte;
33 mark:=s.ReadByte;
34 case opcode of
35 4:begin
36 if mark<>PrvMark then begin
37 if mark<>CurMark then begin
38 PrvMark:=CurMark;
39 CurMark:=mark;
40 StartT:=now;
41 Total:=1;
42 DgCnt:=1;
43 end else begin Inc(Total,s.length); Inc(DgCnt) end;
44 end;
45 end;
46 8:;
47 6:begin
48 r.WriteByte(7);
49 r.WriteByte(mark);
50 r.WriteWord(s.length,2);
51 SC(@fpsendto,fpsendto(s_inet,r.base,r.length,0,@from,sizeof(sockaddr_in)));
52 end;
53 end;
54 if DgCnt<8 then exit;
55 if (now-Startt)<(0.4/SecsPerDay) then exit;
56 rateR:=Total/((now-Startt)*SecsPerDay);
57 writeln('Rate: ',(rateR/1024):7:1);
58 rate:=round(rateR/64);
59 StartT:=now;
60 Total:=1;
61 r.WriteByte(5);
62 r.WriteByte(mark);
63 r.WriteWord(rate,4);
64 SC(@fpsendto,fpsendto(s_inet,r.base,r.length,0,@from,sizeof(sockaddr_in)));
65 end;
67 procedure s_SetupInet;
68 var bind_addr:tInetSockAddr;
69 begin
70 with bind_addr do begin
71 family:=AF_INET;
72 port:=htons(3519);
73 addr:=0; {any}
74 s_inet:=fpSocket(family,SOCK_DGRAM,IPPROTO_UDP);
75 SC(@fpSocket,s_inet);
76 end;
77 SC(@fpBind,fpBind(s_inet,@bind_addr,sizeof(bind_addr)));
78 end;
80 var Terminated:boolean=false;
82 procedure SignalHandler(sig:cint);CDecl;
83 begin
84 writeln;
85 if terminated then raise eControlC.Create('CtrlC DoubleTap') ;
86 Terminated:=true;
87 writeln('Shutdown requested');
88 end;
90 procedure Loop;
91 var Buffer:array [1..4096] of byte;
92 var s:tMemoryStream;
93 var pkLen:LongInt;
94 var From:tSockAddr;
95 var FromLen:LongWord;
96 begin
97 FromLen:=sizeof(From);
98 pkLen:=fprecvfrom(s_inet,@Buffer,sizeof(Buffer),0,@from,@fromlen);
99 SC(@fprecvfrom,pkLen);
100 //writeln('size ',pkLen,' opcode ',buffer[1]);
101 s.Init(@buffer,pkLen,sizeof(buffer));
102 HandleMsg(s_inet,s,from);
103 end;
105 BEGIN
106 s_setupInet;
107 fpSignal(SigInt,@SignalHandler);
108 fpSignal(SigTerm,@SignalHandler);
109 repeat Loop until Terminated;
110 write('Standard terminate [');
111 CloseSocket(s_inet);
112 writeln(']');
113 END.