lcoretest.dpr

   1 program lcoretest;\r
   2 \r
   3 uses\r
   4   lcore,\r
   5   lsocket,\r
   6   {$ifdef win32}\r
   7     lcorewsaasyncselect in 'lcorewsaasyncselect.pas',\r
   8   {$else}\r
   9     lcoreselect,\r
  10   {$endif}\r
  11   dnsasync,\r
  12   binipstuff,\r
  13   sysutils,\r
  14   dnssync;\r
  15 {$ifdef win32}\r
  16   {$R *.RES}\r
  17 {$endif}\r
  18 \r
  19 type\r
  20   tsc=class\r
  21     procedure sessionavailable(sender: tobject;error : word);\r
  22     procedure dataavailable(sender: tobject;error : word);\r
  23     procedure sessionconnected(sender: tobject;error : word);\r
  24     procedure taskrun(wparam,lparam:longint);\r
  25     procedure timehandler(sender:tobject);\r
  26     procedure dnsrequestdone(sender:tobject;error : word);\r
  27     procedure sessionclosed(sender:tobject;error : word);\r
  28   end;\r
  29 var\r
  30   listensocket : tlsocket;\r
  31   serversocket : tlsocket;\r
  32   clientsocket : tlsocket;\r
  33   sc : tsc;\r
  34   task : tltask;\r
  35 procedure tsc.sessionavailable(sender: tobject;error : word);\r
  36 begin\r
  37   writeln('received connection');\r
  38   serversocket.dup(listensocket.accept);\r
  39 end;\r
  40 \r
  41 var\r
  42   receivebuf : string;\r
  43   receivecount : integer;\r
  44 procedure tsc.dataavailable(sender: tobject;error : word);\r
  45 var\r
  46   receiveddata : string;\r
  47   receivedon : string;\r
  48   line : string;\r
  49 begin\r
  50   receiveddata := tlsocket(sender).receivestr;\r
  51   if sender=clientsocket then begin\r
  52     receivedon := 'client socket';\r
  53   end else begin\r
  54     receivedon := 'server socket';\r
  55   end;\r
  56   writeln('received data '+receiveddata+' on '+receivedon);\r
  57 \r
  58   receivebuf := receivebuf+receiveddata;\r
  59 \r
  60   if receivebuf = 'hello world' then begin\r
  61     receivebuf := '';\r
  62     writeln('received hello world creating task');\r
  63     task := tltask.create(sc.taskrun,nil,0,0);\r
  64   end;\r
  65   receivecount := receivecount +1;\r
  66   if receivecount >50 then begin\r
  67     writeln('received over 50 bits of data, pausing to let the operator take a look');\r
  68     readln;\r
  69     receivecount := 0;\r
  70   end;\r
  71   while pos(#10,receivebuf) > 0 do begin\r
  72     line := receivebuf;\r
  73     setlength(line,pos(#10,receivebuf)-1);\r
  74     receivebuf := copy(receivebuf,pos(#10,receivebuf)+1,1000000);\r
  75     if uppercase(copy(line,1,4))='PING' then begin\r
  76       line[2] := 'o';\r
  77       writeln('send pong:'+line);\r
  78       clientsocket.sendstr(line+#10);\r
  79     end;\r
  80   end;\r
  81 end;\r
  82 \r
  83 procedure tsc.sessionconnected(sender: tobject;error : word);\r
  84 begin\r
  85   if error=0 then begin\r
  86     writeln('session is connected, local address is'+clientsocket.getxaddr);\r
  87 \r
  88     if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin\r
  89       clientsocket.sendstr('hello world');\r
  90     end else begin\r
  91       clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);\r
  92     end;\r
  93   end else begin\r
  94     writeln('connect failed');\r
  95   end;\r
  96 end;\r
  97 \r
  98 var\r
  99   das : tdnsasync;\r
 100 \r
 101 procedure tsc.taskrun(wparam,lparam:longint);\r
 102 var\r
 103   tempbinip : tbinip;\r
 104   dummy : integer;\r
 105 begin\r
 106   writeln('task ran');\r
 107   writeln('closing client socket');\r
 108   clientsocket.close;\r
 109 \r
 110   writeln('looking up irc.ipv6.p10link.net using dnsasync');\r
 111   das := tdnsasync.Create(nil);\r
 112   das.onrequestdone := sc.dnsrequestdone;\r
 113   //das.forwardfamily := af_inet6;\r
 114   das.forwardlookup('irc.ipv6.p10link.net');\r
 115 end;\r
 116 \r
 117 procedure tsc.dnsrequestdone(sender:tobject;error : word);\r
 118 begin\r
 119   writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');\r
 120   clientsocket.addr := das.dnsresult;\r
 121   clientsocket.port := '6667';\r
 122   clientsocket.connect;\r
 123   writeln(clientsocket.getxaddr);\r
 124   das.free;\r
 125 end;\r
 126 \r
 127 procedure tsc.timehandler(sender:tobject);\r
 128 begin\r
 129   //writeln('got timer event');\r
 130 end;\r
 131 procedure tsc.sessionclosed(sender:tobject;error : word);\r
 132 begin\r
 133   Writeln('session closed with error ',error);\r
 134 end;\r
 135 var\r
 136   timer : tltimer;\r
 137   ipbin : tbinip;\r
 138   dummy : integer;\r
 139 begin\r
 140   ipbin := forwardlookup('invalid.domain',5);\r
 141   writeln(ipbintostr(ipbin));\r
 142 \r
 143   ipbin := forwardlookup('p10link.net',5);\r
 144   writeln(ipbintostr(ipbin));\r
 145 \r
 146   ipstrtobin('80.68.89.68',ipbin);\r
 147   writeln('80.68.89.68 reverses to '+reverselookup(ipbin,5));\r
 148 \r
 149   ipstrtobin('2001:200::8002:203:47ff:fea5:3085',ipbin);\r
 150   writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));\r
 151   writeln('creating and setting up listen socket');\r
 152   listensocket := tlsocket.create(nil);\r
 153   listensocket.addr := '::';\r
 154   listensocket.port := '12345';\r
 155   listensocket.onsessionavailable := sc.sessionavailable;\r
 156   writeln('listening');\r
 157   listensocket.listen;\r
 158   writeln(listensocket.getxport);\r
 159   writeln('listen socket is number ', listensocket.fdhandlein);\r
 160   writeln('creating and setting up server socket');\r
 161   serversocket := tlsocket.create(nil);\r
 162   serversocket.ondataavailable := sc.dataavailable;\r
 163   writeln('creating and setting up client socket');\r
 164   clientsocket := tlsocket.create(nil);\r
 165   clientsocket.addr := '::1';{'127.0.0.1';}\r
 166   clientsocket.port := '12345';\r
 167   clientsocket.onsessionconnected := sc.sessionconnected;\r
 168   clientsocket.ondataAvailable := sc.dataavailable;\r
 169   clientsocket.onsessionclosed := sc.sessionclosed;\r
 170   writeln('connecting');\r
 171   clientsocket.connect;\r
 172   writeln('client socket is number ',clientsocket.fdhandlein);\r
 173   writeln('creating and setting up timer');\r
 174   timer := tltimer.create(nil);\r
 175   timer.interval := 1000;\r
 176   timer.ontimer := sc.timehandler;\r
 177   timer.enabled := true;\r
 178   writeln('entering message loop');\r
 179   messageloop;\r
 180   writeln('exiting cleanly');\r
 181 end.\r