/[lcore]/trunk/lsocket.pas
ViewVC logotype

Contents of /trunk/lsocket.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 60 - (show annotations)
Thu Nov 12 20:47:41 2009 UTC (10 years, 3 months ago) by plugwash
File size: 23638 byte(s)
add support for fpc 2.2.4rc1

1 {lsocket.pas}
2
3 {socket code by plugwash}
4
5 { Copyright (C) 2005 Bas Steendijk and Peter Green
6 For conditions of distribution and use, see copyright notice in zlib_license.txt
7 which is included in the package
8 ----------------------------------------------------------------------------- }
9 {
10 changes by plugwash (20030728)
11 * created handlefdtrigger virtual method in tlasio (overridden in tlsocket) and moved a lot of code from messageloop into it
12 * changed tlasio to tlasio
13 * split fdhandle into fdhandlein and fdhandleout
14 * i now use fdsrmaster and fdswmaster instead of rebuilding the lists every loop
15 * split lsocket.pas into lsocket.pas and lcore.pas
16
17
18 changes by beware (20030903)
19 * added getxaddr, getxport (local addr, port, as string)
20 * added getpeername, remote addr+port as binary
21 * added htons and htonl functions (endian swap, same interface as windows API)
22
23 beware (20030905)
24 * if connect failed (conn refused) set state to connected and call internalclose, to get closed handler (instead of fdclose)
25 * (lcore) if closing the fd's in internalcose, set fd's to -1 because closing an fd makes it invalid
26
27 beware (20030927)
28 * fixed: on connect failed, tried to close fdhandle's which were already set to -1, added check
29
30 beware (20031017)
31 * added getpeeraddr, getpeerport, remote addr+port as string
32 }
33
34
35 unit lsocket;
36 {$ifdef fpc}
37 {$mode delphi}
38 {$endif}
39
40 {$include lcoreconfig.inc}
41
42 interface
43 uses
44 sysutils,
45 {$ifdef win32}
46 windows,winsock,
47 {$else}
48
49 {$ifdef VER1_0}
50 linux,
51 {$else}
52 baseunix,unix,unixutil,
53 {$endif}
54 sockets,
55 {$endif}
56 classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync;
57
58 {$ifdef ipv6}
59 const
60 v4listendefault:boolean=false;
61 {$endif}
62
63
64 type
65 sunB = packed record
66 s_b1, s_b2, s_b3, s_b4: byte;
67 end;
68
69 SunW = packed record
70 s_w1, s_w2: word;
71 end;
72
73 TInAddr = packed record
74 case integer of
75 0: (S_un_b: SunB);
76 1: (S_un_w: SunW);
77 2: (S_addr: cardinal);
78 end;
79
80 type
81 TLsocket = class(tlasio)
82 public
83 //a: string;
84
85 inAddr : TInetSockAddrV;
86
87 biniplist:tbiniplist;
88 trymoreips:boolean;
89 currentip:integer;
90 connecttimeout:tltimer;
91
92 { inAddrSize:integer;}
93
94 //host : THostentry ;
95
96 //mainthread : boolean ; //for debuggin only
97 addr:string;
98 port:string;
99 localaddr:string;
100 localport:string;
101 proto:string;
102 udp,dgram:boolean;
103 listenqueue:integer;
104 {$ifdef secondlistener}
105 secondlistener:tlsocket;
106 lastsessionfromsecond:boolean;
107 procedure secondaccepthandler(sender:tobject;error:word);
108 procedure internalclose(error:word);override;
109 {$endif}
110 function getaddrsize:integer;
111 procedure connect; virtual;
112 procedure realconnect;
113 procedure bindsocket;
114 procedure listen;
115 function accept : longint;
116 function sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer; virtual;
117 function receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer; virtual;
118
119 procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;
120 function send(data:pointer;len:integer):integer;override;
121 procedure sendstr(const str : string);override;
122 function Receive(Buf:Pointer;BufSize:integer):integer; override;
123 function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;
124 procedure getXaddrbin(var binip:tbinip); virtual;
125 procedure getpeeraddrbin(var binip:tbinip); virtual;
126 function getXaddr:string; virtual;
127 function getpeeraddr:string; virtual;
128 function getXport:string; virtual;
129 function getpeerport:string; virtual;
130 constructor Create(AOwner: TComponent); override;
131
132 //this one has to be kept public for now because lcorewsaasyncselect calls it
133 procedure connectionfailedhandler(error:word);
134 private
135 procedure taskcallconnectionfailedhandler(wparam,lparam : longint);
136
137 procedure connecttimeouthandler(sender:tobject);
138 procedure connectsuccesshandler;
139 {$ifdef win32}
140 procedure myfdclose(fd : integer); override;
141 function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;
142 function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override;
143 {$endif}
144 end;
145 tsocket=longint; // for compatibility with twsocket
146
147 twsocket=tlsocket; {easy}
148
149
150 const
151 TCP_NODELAY=1;
152 IPPROTO_TCP=6;
153
154 implementation
155 {$include unixstuff.inc}
156
157
158 function tlsocket.getaddrsize:integer;
159 begin
160 result := inaddrsize(inaddr);
161 end;
162
163 //I used to use the system versions of these from within lsocket (which has
164 //functions whose name clashes with them) by using sockets.* and but I can't do
165 //that anymore since in some cases connect is now provided by unixstuff.inc
166 //hence these wrapper functions --plugwash
167 {$ifndef win32}
168 function system_Connect(Sock: LongInt;const Addr;Addrlen: LongInt):Boolean;
169 begin
170 result := connect(sock,addr,addrlen);
171 end;
172 function system_SendTo(Sock: LongInt; const Buf;BufLen: LongInt;Flags: LongInt;var Addr;AddrLen: LongInt):LongInt;
173 begin
174 result := sendto(sock,buf,buflen,flags,addr,addrlen);
175 end;
176 function system_getpeername(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
177 begin
178 result := getpeername(sock,addr,addrlen);
179 end;
180 function system_listen(Sock: LongInt; MaxConnect: LongInt):Boolean;
181 begin
182 result := listen(sock,maxconnect);
183 end;
184 function system_Accept(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
185 begin
186 result := accept(sock,addr,addrlen);
187 end;
188 {$endif}
189
190 procedure tlsocket.realconnect;
191 var
192 a,b:integer;
193 begin
194 //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);
195 makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr);
196 inc(currentip);
197 if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false;
198
199 udp := false;
200 if (uppercase(proto) = 'UDP') then begin
201 b := IPPROTO_UDP;
202 a := SOCK_DGRAM;
203 udp := true;
204 dgram := true;
205 end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin
206 b := IPPROTO_TCP;
207 a := SOCK_STREAM;
208 dgram := false;
209 end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin
210 b := strtointdef(proto,IPPROTO_ICMP);
211 a := SOCK_RAW;
212 dgram := true;
213 end else begin
214 raise ESocketException.create('unrecognised protocol');
215 end;
216
217 a := Socket(inaddr.inaddr.family,a,b);
218 //writeln(ord(inaddr.inaddr.family));
219 if a = -1 then begin
220 //unable to create socket, fire an error event (better to use an error event
221 //to avoid poor interaction with multilistener stuff.
222 //a socket value of -2 is a special value to say there is no socket but
223 //we want internalclose to act as if there was
224 fdhandlein := -2;
225 fdhandleout := -2;
226 tltask.create(taskcallconnectionfailedhandler,self,{$ifdef win32}wsagetlasterror{$else}socketerror{$endif},0);
227 exit;
228 end;
229 try
230 dup(a);
231 bindsocket;
232 if dgram then begin
233 {$ifndef win32}
234 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
235 {$else}
236 SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
237 {$endif}
238 state := wsconnected;
239 if assigned(onsessionconnected) then onsessionconnected(self,0);
240
241 eventcore.rmasterset(fdhandlein,false);
242 eventcore.wmasterclr(fdhandleout);
243 end else begin
244 state :=wsconnecting;
245 {$ifdef win32}
246 //writeln(inaddr.inaddr.port);
247 winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
248 {$else}
249 system_Connect(fdhandlein,inADDR,getaddrsize);
250 {$endif}
251 eventcore.rmasterset(fdhandlein,false);
252 eventcore.wmasterset(fdhandleout);
253 if trymoreips then connecttimeout.enabled := true;
254 end;
255 //sendq := '';
256 except
257 on e: exception do begin
258 fdcleanup;
259 raise; //reraise the exception
260 end;
261 end;
262
263 end;
264
265 procedure tlsocket.connecttimeouthandler(sender:tobject);
266 begin
267 connecttimeout.enabled := false;
268 destroying := true; //hack to not cause handler to trigger
269 internalclose(0);
270 destroying := false;
271 realconnect;
272 end;
273
274
275
276
277 procedure tlsocket.connect;
278 var
279 a:integer;
280 ip:tbinip;
281 begin
282 if state <> wsclosed then close;
283 //prevtime := 0;
284 if isbiniplist(addr) then biniplist := addr else biniplist := forwardlookuplist(addr,0);
285 if biniplist_getcount(biniplist) = 0 then raise exception.create('unable to resolve '+addr);
286
287 //makeinaddrv(addr,port,inaddr);
288
289 currentip := 0;
290 if not assigned(connecttimeout) then begin
291 connecttimeout := tltimer.create(self);
292 connecttimeout.ontimer := connecttimeouthandler;
293 connecttimeout.interval := 2500;
294 connecttimeout.enabled := false;
295 end;
296 realconnect;
297 end;
298
299 procedure tlsocket.sendstr(const str : string);
300 begin
301 if dgram then begin
302 send(@str[1],length(str))
303 end else begin
304 inherited sendstr(str);
305 end;
306 end;
307
308 function tlsocket.send(data:pointer;len:integer):integer;
309 begin
310 if dgram then begin
311 // writeln('sending to '+ipbintostr(inaddrvtobinip(inaddr)),' ',htons(inaddr.inaddr.port),' ',len,' bytes');
312 result := sendto(inaddr,getaddrsize,data,len);
313
314 // writeln('send result ',result);
315 // writeln('errno',errno);
316 end else begin
317 result := inherited send(data,len);
318 end;
319 end;
320
321
322 function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;
323 begin
324 if dgram then begin
325 {$ifdef secondlistener}
326 if lastsessionfromsecond then begin
327 result := secondlistener.receive(buf,bufsize);
328 lastsessionfromsecond := false;
329 end else
330 {$endif}
331 result := myfdread(self.fdhandlein,buf^,bufsize);
332 end else begin
333 result := inherited receive(buf,bufsize);
334 end;
335 end;
336
337 procedure tlsocket.bindsocket;
338 var
339 a:integer;
340 inAddrtemp:TInetSockAddrV;
341 inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
342 inaddrtempsize:integer;
343 begin
344 try
345 if (localaddr <> '') or (localport <> '') then begin
346 if localaddr = '' then begin
347 {$ifdef ipv6}
348 if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else
349 {$endif}
350 localaddr := '0.0.0.0';
351 end;
352 //gethostbyname(localaddr,host);
353 inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp);
354
355 If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin
356 state := wsclosed;
357 lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
358 raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror));
359 end;
360 state := wsbound;
361 end;
362 except
363 on e: exception do begin
364 fdcleanup;
365 raise; //reraise the exception
366 end;
367 end;
368 end;
369
370 procedure tlsocket.listen;
371 var
372 yes:longint;
373 socktype:integer;
374 biniptemp:tbinip;
375 origaddr:string;
376 begin
377 if state <> wsclosed then close;
378 udp := uppercase(proto) = 'UDP';
379 if udp then begin
380 socktype := SOCK_DGRAM;
381 dgram := true;
382 end else socktype := SOCK_STREAM;
383 origaddr := addr;
384
385 if addr = '' then begin
386 {$ifdef ipv6}
387 if not v4listendefault then begin
388 addr := '::';
389 end else
390 {$endif}
391 addr := '0.0.0.0';
392 end;
393 if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10);
394 addr := ipbintostr(biniptemp);
395 fdhandlein := socket(biniptemp.family,socktype,0);
396 {$ifdef ipv6}
397 if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
398 addr := '0.0.0.0';
399 fdhandlein := socket(AF_INET,socktype,0);
400 end;
401 {$endif}
402
403 if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef win32}+' error='+inttostr(wsagetlasterror){$endif});
404 dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things
405 //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup
406 state := wsclosed; // then set this back as it was an undesired side effect of dup
407
408 try
409 yes := $01010101; {Copied this from existing code. Value is empiric,
410 but works. (yes=true<>0) }
411 {$ifndef win32}
412 if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
413 raise ESocketException.create('unable to set socket options');
414 end;
415 {$endif}
416 localaddr := addr;
417 localport := port;
418 bindsocket;
419
420 if not udp then begin
421 {!!! allow custom queue length? default 5}
422 if listenqueue = 0 then listenqueue := 5;
423 If {$ifdef win32}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise
424 esocketexception.create('unable to listen');
425 state := wsListening;
426 end else begin
427 {$ifndef win32}
428 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
429 {$else}
430 SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
431 {$endif}
432 state := wsconnected;
433 end;
434
435 {$ifdef secondlistener}
436 //listening on ::. try to listen on 0.0.0.0 as well for platforms which don't already do that
437 if addr = '::' then begin
438 secondlistener := tlsocket.create(nil);
439 secondlistener.proto := proto;
440 secondlistener.addr := '0.0.0.0';
441 secondlistener.port := port;
442 if udp then begin
443 secondlistener.ondataavailable := secondaccepthandler;
444 end else begin
445 secondlistener.onsessionAvailable := secondaccepthandler;
446 end;
447 try
448 secondlistener.listen;
449 except
450 secondlistener.destroy;
451 secondlistener := nil;
452 end;
453 end;
454 {$endif}
455 finally
456 if state = wsclosed then begin
457 if fdhandlein >= 0 then begin
458 {one *can* get here without fd -beware}
459 eventcore.rmasterclr(fdhandlein);
460 myfdclose(fdhandlein); // we musnt leak file discriptors
461 eventcore.setfdreverse(fdhandlein,nil);
462 fdhandlein := -1;
463 end;
464 end else begin
465 eventcore.rmasterset(fdhandlein,not udp);
466 end;
467 if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
468 end;
469 //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein);
470 end;
471
472 {$ifdef secondlistener}
473 procedure tlsocket.internalclose(error:word);
474 begin
475 if assigned(secondlistener) then begin
476 secondlistener.destroy;
477 secondlistener := nil;
478 end;
479 inherited internalclose(error);
480 end;
481
482 procedure tlsocket.secondaccepthandler;
483 begin
484 lastsessionfromsecond := true;
485 if udp then begin
486 ondataavailable(self,error);
487 end else begin
488 if assigned(onsessionavailable) then onsessionavailable(self,error);
489 end;
490 end;
491 {$endif}
492
493 function tlsocket.accept : longint;
494 var
495 FromAddrSize : LongInt; // i don't realy know what to do with these at this
496 FromAddr : TInetSockAddrV; // at this point time will tell :)
497 a:integer;
498 begin
499 {$ifdef secondlistener}
500 if (lastsessionfromsecond) then begin
501 lastsessionfromsecond := false;
502 result := secondlistener.accept;
503 exit;
504 end;
505 {$endif}
506
507 FromAddrSize := Sizeof(FromAddr);
508 {$ifdef win32}
509 result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
510 {$else}
511 result := system_accept(fdhandlein,fromaddr,fromaddrsize);
512 {$endif}
513 //now we have accepted one request start monitoring for more again
514 eventcore.rmasterset(fdhandlein,true);
515
516 if result = -1 then begin
517 raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting');
518 end;
519 if result > absoloutemaxs then begin
520 myfdclose(result);
521 a := result;
522 result := -1;
523 raise esocketexception.create('file discriptor out of range: '+inttostr(a));
524 end;
525 end;
526
527
528 function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer;
529 var
530 destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute dest;
531 begin
532 {$ifdef secondlistener}
533 if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin
534 result := secondlistener.sendto(dest,destlen,data,len);
535 exit;
536 end;
537 {$endif}
538 result := {$ifdef win32}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx,destlen);
539 end;
540
541
542 function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer;
543 var
544 tempsrc:TInetSockAddrV;
545 tempsrclen:integer;
546 srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc;
547 biniptemp:tbinip;
548 begin
549 {$ifdef secondlistener}
550 if assigned(secondlistener) then if lastsessionfromsecond then begin
551 lastsessionfromsecond := false;
552 result := secondlistener.receivefrom(data,len,src,srclen);
553 exit;
554 end;
555 {$endif}
556 tempsrclen := sizeof(tempsrc);
557 result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen);
558
559 {$ifdef ipv6}
560 biniptemp := inaddrvtobinip(tempsrc);
561 if needconverttov4(biniptemp) then begin
562 converttov4(biniptemp);
563 tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc);
564 end;
565 {$endif}
566
567 move(tempsrc,src,srclen);
568 srclen := tempsrclen;
569 end;
570
571 procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);
572 begin
573 connectionfailedhandler(wparam);
574 end;
575
576 procedure tlsocket.connectionfailedhandler(error:word);
577 begin
578 if trymoreips then begin
579 // writeln('failed with error ',error);
580 connecttimeout.enabled := false;
581 destroying := true;
582 state := wsconnected;
583 self.internalclose(0);
584 destroying := false;
585 realconnect;
586 end else begin
587 state := wsconnected;
588 if assigned(onsessionconnected) then onsessionconnected(self,error);
589 self.internalclose(0);
590 recvq.del(maxlongint);
591 end;
592 end;
593
594 procedure tlsocket.connectsuccesshandler;
595 begin
596 trymoreips := false;
597 connecttimeout.enabled := false;
598 if assigned(onsessionconnected) then onsessionconnected(self,0);
599 end;
600
601
602 procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
603 var
604 tempbuf:array[0..receivebufsize-1] of byte;
605 begin
606 // writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger,' state=',integer(state));
607 if (state =wslistening) and readtrigger then begin
608 { debugout('listening socket triggered on read');}
609 eventcore.rmasterclr(fdhandlein);
610 if assigned(onsessionAvailable) then onsessionAvailable(self,0);
611 end;
612 if dgram and readtrigger then begin
613 if assigned(ondataAvailable) then ondataAvailable(self,0);
614 {!!!test}
615 exit;
616 end;
617 if (state =wsconnecting) and writetrigger then begin
618 // code for dealing with the reults of a non-blocking connect is
619 // rather complex
620 // if just write is triggered it means connect suceeded
621 // if both read and write are triggered it can mean 2 things
622 // 1: connect ok and data availible
623 // 2: connect fail
624 // to find out which you must read from the socket and look for errors
625 // there if we read successfully we drop through into the code for fireing
626 // the read event
627 if not readtrigger then begin
628 state := wsconnected;
629 connectsuccesshandler;
630 end else begin
631 numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
632 if numread <> -1 then begin
633 state := wsconnected;
634 connectsuccesshandler;
635 //connectread := true;
636 recvq.add(@tempbuf,numread);
637 end else begin
638 connectionfailedhandler({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});
639 exit;
640 end;
641 // if things went well here we are now in the state wsconnected with data sitting in our receive buffer
642 // so we drop down into the processing for data availible
643 end;
644 if fdhandlein >= 0 then begin
645 if state = wsconnected then begin
646 eventcore.rmasterset(fdhandlein,false);
647 end else begin
648 eventcore.rmasterclr(fdhandlein);
649 end;
650 end;
651 if fdhandleout >= 0 then begin
652 if sendq.size = 0 then begin
653 //don't clear the bit in fdswmaster if data is in the sendq
654 eventcore.wmasterclr(fdhandleout);
655 end;
656 end;
657
658 end;
659 inherited handlefdtrigger(readtrigger,writetrigger);
660 end;
661
662 constructor tlsocket.Create(AOwner: TComponent);
663 begin
664 inherited create(aowner);
665 closehandles := true;
666 trymoreips := true;
667 end;
668
669
670
671 function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
672 var
673 addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
674 begin
675 result := {$ifdef win32}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen);
676 end;
677
678 procedure tlsocket.getxaddrbin(var binip:tbinip);
679 var
680 addr:tinetsockaddrv;
681 i:integer;
682 begin
683 i := sizeof(addr);
684 fillchar(addr,sizeof(addr),0);
685
686 {$ifdef win32}
687 winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
688 {$else}
689 getsocketname(self.fdhandlein,addr,i);
690 {$endif}
691 binip := inaddrvtobinip(addr);
692 converttov4(binip);
693 end;
694
695 procedure tlsocket.getpeeraddrbin(var binip:tbinip);
696 var
697 addr:tinetsockaddrv;
698 i:integer;
699 begin
700 i := sizeof(addr);
701 fillchar(addr,sizeof(addr),0);
702 {$ifdef win32}
703 winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
704 {$else}
705 system_getpeername(self.fdhandlein,addr,i);
706 {$endif}
707
708 binip := inaddrvtobinip(addr);
709 converttov4(binip);
710 end;
711
712 function tlsocket.getXaddr:string;
713 var
714 biniptemp:tbinip;
715 begin
716 getxaddrbin(biniptemp);
717 result := ipbintostr(biniptemp);
718 if result = '' then result := 'error';
719 end;
720
721 function tlsocket.getpeeraddr:string;
722 var
723 biniptemp:tbinip;
724 begin
725 getpeeraddrbin(biniptemp);
726 result := ipbintostr(biniptemp);
727 if result = '' then result := 'error';
728 end;
729
730 function tlsocket.getXport:string;
731 var
732 addr:tinetsockaddrv;
733 i:integer;
734 begin
735 i := sizeof(addr);
736 {$ifdef win32}
737 winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
738
739 {$else}
740 getsocketname(self.fdhandlein,addr,i);
741
742 {$endif}
743 result := inttostr(htons(addr.InAddr.port));
744 end;
745
746 function tlsocket.getpeerport:string;
747 var
748 addr:tinetsockaddrv;
749 i:integer;
750 begin
751 i := sizeof(addr);
752 {$ifdef win32}
753 winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i);
754
755 {$else}
756 system_getpeername(self.fdhandlein,addr,i);
757
758 {$endif}
759 result := inttostr(htons(addr.InAddr.port));
760 end;
761
762 {$ifdef win32}
763 procedure tlsocket.myfdclose(fd : integer);
764 begin
765 closesocket(fd);
766 end;
767 function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
768 begin
769 result := winsock.send(fd,(@buf)^,size,0);
770 end;
771 function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
772 begin
773 result := winsock.recv(fd,buf,size,0);
774 end;
775 {$endif}
776
777 end.
778

Properties

Name Value
svn:executable

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