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