/[lcore]/trunk/httpserver_20080306/lcoretest.dpr
ViewVC logotype

Contents of /trunk/httpserver_20080306/lcoretest.dpr

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Fri Mar 28 02:26:58 2008 UTC (13 years, 2 months ago) by plugwash
File size: 4785 byte(s)
initial import

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

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.26