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 procedure t.Rekt;
  71  begin
  72  writeln('TestFS: rekt');
  73  FreeMem(@self,sizeof(self));
  74 end;
  75
  76 procedure t.HardTimeout;
  77  begin
  78  writeln('TestFS: hardtimeout');
  79  ch.DisposeHook:=@Rekt;
  80  ch.Close;
  81 end;
  82
  83 procedure init;
  84  var o:^t;
  85  var oi:word;
  86  var s:tMemoryStream;
  87  const opt='-test-fs';
  88  begin
  89  oi:=OptIndex(opt);
  90  if oi>0 then begin
  91   assert(OptParamCount(oi)=1,opt+'(rcpt:tNetAddr)');
  92   writeln('TestFS: rcpt '+paramstr(oi+1));
  93   new(o); with o^ do begin
  94    ch.Init(paramstr(oi+1));
  95    ch.Callback:=@ST1;
  96    Shedule(7000,@HardTimeout);
  97    ch.streaminit(s,33);
  98    s.WriteByte(opcode.upFileServer);
  99    s.WriteByte({channel}99);
 100    s.WriteByte(opcode.upGET);
 101    s.Skip(20);
 102    s.WriteWord(0,2);
 103    s.WriteWord(0,4);
 104    s.WriteWord($FFFFFFFF,4);
 105    ch.Send(s);
 106   end;
 107  end;
 108 end;
 109
 110 BEGIN
 111  init;
 112 END.