RecvTC.pas

   1 uses MemStream,NetAddr
   2     ,SysUtils,Sockets,UnixType,BaseUnix
   3      ;
   4
   5
   6 var s_inet:tSocket;
   7
   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;
  14
  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}
  22
  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;
  66
  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;
  79
  80 var Terminated:boolean=false;
  81
  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;
  89
  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;
 104
 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.