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