TestFS.pas

   1 unit TestFS;
   2
   3 INTERFACE
   4 IMPLEMENTATION
   5 USES ServerLoop,Chat,SysUtils,MemStream,NetAddr,opcode;
   6
   7 type t=object
   8  ch: tChat;
   9  //procedure UserInput
  10  procedure ST1(msg:tSMsg; data:boolean);
  11  procedure ST2(msg:tSMsg; data:boolean);
  12  procedure ST3(msg:tSMsg; data:boolean);
  13  procedure Rekt;
  14  procedure HardTimeout;
  15 end;
  16
  17 procedure t.ST1(msg:tSMsg; data:boolean);
  18  var r:tMemoryStream absolute msg.stream;
  19  var s:tMemoryStream;
  20  var op:byte;
  21  begin
  22  {reply from GET request}
  23  write('TestFS: ST1 reply from FS: ');
  24  if not data then begin
  25   writeln('ack');
  26  end else begin
  27   ch.Ack;
  28   op:=msg.stream.ReadByte;
  29   if op=upFAIL then writeln('FAIL ',r.readbyte{,'-',r.readbyte})
  30   else if op=upINFO then begin
  31    r.skip(2);
  32    writeln('INFO size=',r.ReadWord(4),' final=',r.readbyte,' seg=',r.readword(4));
  33    ch.Callback:=@ST2;
  34   end else if op=upClose then writeln('CLOSE')
  35   else writeln('unknown');
  36  end;
  37 end;
  38 procedure t.ST2(msg:tSMsg; data:boolean);
  39  var r:tMemoryStream absolute msg.stream;
  40  var s:tMemoryStream;
  41  var op:byte;
  42  begin
  43  {Status Message}
  44  write('TestFS: ST2 reply from FS: ');
  45  if data then begin
  46   ch.Ack;
  47   op:=msg.stream.ReadByte;
  48   if op=upCLOSE then writeln('CLOSE ')
  49   else if op=upDONE then begin
  50    writeln('DONE');
  51    ch.streaminit(s,1);
  52    s.WriteByte(opcode.upClose);
  53    ch.Send(s);
  54    ch.Callback:=@ST3;
  55   end;
  56  end else writeln('ack (unexpected)');
  57 end;
  58 procedure t.ST3(msg:tSMsg; data:boolean);
  59  begin
  60  {ACK to Close}
  61  write('TestFS: ST3 reply from FS: ');
  62  if data then writeln('unepected data') else begin
  63   writeln('ack');
  64   UnShedule(@HardTimeout);
  65   ch.DisposeHook:=@Rekt;
  66   ch.Close;
  67  end;
  68 end;
  69
  70 var cnt:LongWOrd=0;
  71 procedure IgnoreData(msg:tSMsg);
  72  begin
  73  cnt:=cnt+msg.length;
  74  //Writeln('Data: ',cnt);
  75 end;
  76
  77 procedure t.Rekt;
  78  begin
  79  writeln('TestFS: rekt');
  80  UnShedule(@HardTimeout);
  81  FreeMem(@self,sizeof(self));
  82 end;
  83
  84 procedure t.HardTimeout;
  85  begin
  86  writeln('TestFS: hardtimeout');
  87  ch.DisposeHook:=@Rekt;
  88  ch.Close;
  89 end;
  90
  91 procedure init;
  92  var o:^t;
  93  var oi:word;
  94  var s:tMemoryStream;
  95  const opt='-test-fs';
  96  begin
  97  oi:=OptIndex(opt);
  98  if oi>0 then begin
  99   assert(OptParamCount(oi)=1,opt+'(rcpt:tNetAddr)');
 100   writeln('TestFS: rcpt '+paramstr(oi+1));
 101   new(o); with o^ do begin
 102    ch.Init(paramstr(oi+1));
 103    ch.Callback:=@ST1;
 104    Shedule(20000,@HardTimeout);
 105    ch.streaminit(s,33);
 106    s.WriteByte(opcode.upFileServer);
 107    s.WriteByte({channel}99);
 108    s.WriteByte(opcode.upGET);
 109    s.Skip(20);
 110    s.WriteWord(0,2);
 111    s.WriteWord(0,4);
 112    s.WriteWord($FFFFFFFF,4);
 113    ch.Send(s);
 114    ServerLoop.SetMsgHandler(4,@IgnoreData);
 115    ServerLoop.SetMsgHandler(6,@IgnoreData);
 116   end;
 117  end;
 118 end;
 119
 120 BEGIN
 121  init;
 122 END.