lcoretest.dpr

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