* fixed NT services not working. app must now call lcoreinit() at some point before...
[lcore.git] / 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     \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   \r
86   if error=0 then begin\r
87     writeln('session is connected, local address is'+clientsocket.getxaddr);\r
88 \r
89     if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin\r
90       clientsocket.sendstr('hello world');\r
91     end else begin\r
92       clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);\r
93     end;\r
94   end else begin\r
95     writeln('connect failed');\r
96   end;\r
97 end;\r
98 \r
99 var\r
100   das : tdnsasync;\r
101 \r
102 procedure tsc.taskrun(wparam,lparam:longint);\r
103 var\r
104   tempbinip : tbinip;\r
105   dummy : integer;\r
106 begin\r
107   writeln('task ran');\r
108   writeln('closing client socket');\r
109   clientsocket.close;\r
110 \r
111   writeln('looking up irc.ipv6.p10link.net using dnsasync');\r
112   das := tdnsasync.Create(nil);\r
113   das.onrequestdone := sc.dnsrequestdone;\r
114   //das.forwardfamily := af_inet6;\r
115   das.forwardlookup('irc.ipv6.p10link.net');\r
116   \r
117 end;\r
118 \r
119 procedure tsc.dnsrequestdone(sender:tobject;error : word);\r
120 var\r
121   tempbinip : tbinip;\r
122   tempbiniplist : tbiniplist;\r
123 begin\r
124   writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');\r
125   das.dnsresultbin(tempbinip);\r
126   tempbiniplist := biniplist_new;\r
127   biniplist_add(tempbiniplist,tempbinip);\r
128   clientsocket.addr := tempbiniplist;\r
129   clientsocket.port := '6667';\r
130   clientsocket.connect;\r
131   //writeln(clientsocket.getxaddr);\r
132   das.free;\r
133 end;\r
134 \r
135 procedure tsc.timehandler(sender:tobject);\r
136 begin\r
137   //writeln('got timer event');\r
138 end;\r
139 procedure tsc.sessionclosed(sender:tobject;error : word);\r
140 begin\r
141   Writeln('session closed with error ',error);\r
142 end;\r
143 var\r
144   timer : tltimer;\r
145   ipbin : tbinip;\r
146   dummy : integer;\r
147 begin\r
148   ipbin := forwardlookup('invalid.domain',5);\r
149   writeln(ipbintostr(ipbin));\r
150 \r
151   ipbin := forwardlookup('p10link.net',5);\r
152   writeln(ipbintostr(ipbin));\r
153 \r
154   ipstrtobin('80.68.89.68',ipbin);\r
155   writeln('80.68.89.68 reverses to '+reverselookup(ipbin,5));\r
156 \r
157   ipstrtobin('2001:200::8002:203:47ff:fea5:3085',ipbin);\r
158   writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));\r
159   writeln('creating and setting up listen socket');\r
160   listensocket := tlsocket.create(nil);\r
161   listensocket.addr := '::';\r
162   listensocket.port := '12345';\r
163   listensocket.onsessionavailable := sc.sessionavailable;\r
164   writeln('listening');\r
165   listensocket.listen;\r
166   writeln(listensocket.getxport);\r
167   writeln('listen socket is number ', listensocket.fdhandlein);\r
168   writeln('creating and setting up server socket');\r
169   serversocket := tlsocket.create(nil);\r
170   serversocket.ondataavailable := sc.dataavailable;\r
171   writeln('creating and setting up client socket');\r
172   clientsocket := tlsocket.create(nil);\r
173   clientsocket.addr := '::1';{'127.0.0.1';}\r
174   clientsocket.port := '12345';\r
175   clientsocket.onsessionconnected := sc.sessionconnected;\r
176   clientsocket.ondataAvailable := sc.dataavailable;\r
177   clientsocket.onsessionclosed := sc.sessionclosed;\r
178   writeln('connecting');\r
179   clientsocket.connect;\r
180   writeln('client socket is number ',clientsocket.fdhandlein);\r
181   writeln('creating and setting up timer');\r
182   timer := tltimer.create(nil);\r
183   timer.interval := 1000;\r
184   timer.ontimer := sc.timehandler;\r
185   timer.enabled := true;\r
186   writeln('entering message loop');\r
187   messageloop;\r
188   writeln('exiting cleanly');\r
189 end.\r