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

Contents of /trunk/lsocket.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (show annotations)
Wed Feb 10 03:34:48 2010 UTC (10 years, 3 months ago) by beware
File size: 23805 byte(s)
getsockname fixes. getXaddr was returning peer addr
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_getsocketname(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
181 begin
182 result := getsocketname(sock,addr,addrlen);
183 end;
184 function system_listen(Sock: LongInt; MaxConnect: LongInt):Boolean;
185 begin
186 result := listen(sock,maxconnect);
187 end;
188 function system_Accept(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
189 begin
190 result := accept(sock,addr,addrlen);
191 end;
192 {$endif}
193
194 procedure tlsocket.realconnect;
195 var
196 a,b:integer;
197 begin
198 //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);
199 makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr);
200 inc(currentip);
201 if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false;
202
203 udp := false;
204 if (uppercase(proto) = 'UDP') then begin
205 b := IPPROTO_UDP;
206 a := SOCK_DGRAM;
207 udp := true;
208 dgram := true;
209 end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin
210 b := IPPROTO_TCP;
211 a := SOCK_STREAM;
212 dgram := false;
213 end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin
214 b := strtointdef(proto,IPPROTO_ICMP);
215 a := SOCK_RAW;
216 dgram := true;
217 end else begin
218 raise ESocketException.create('unrecognised protocol');
219 end;
220
221 a := Socket(inaddr.inaddr.family,a,b);
222 //writeln(ord(inaddr.inaddr.family));
223 if a = -1 then begin
224 //unable to create socket, fire an error event (better to use an error event
225 //to avoid poor interaction with multilistener stuff.
226 //a socket value of -2 is a special value to say there is no socket but
227 //we want internalclose to act as if there was
228 fdhandlein := -2;
229 fdhandleout := -2;
230 tltask.create(taskcallconnectionfailedhandler,self,{$ifdef win32}wsagetlasterror{$else}socketerror{$endif},0);
231 exit;
232 end;
233 try
234 dup(a);
235 bindsocket;
236 if dgram then begin
237 {$ifndef win32}
238 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
239 {$else}
240 SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
241 {$endif}
242 state := wsconnected;
243 if assigned(onsessionconnected) then onsessionconnected(self,0);
244
245 eventcore.rmasterset(fdhandlein,false);
246 eventcore.wmasterclr(fdhandleout);
247 end else begin
248 state :=wsconnecting;
249 {$ifdef win32}
250 //writeln(inaddr.inaddr.port);
251 winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
252 {$else}
253 system_Connect(fdhandlein,inADDR,getaddrsize);
254 {$endif}
255 eventcore.rmasterset(fdhandlein,false);
256 eventcore.wmasterset(fdhandleout);
257 if trymoreips then connecttimeout.enabled := true;
258 end;
259 //sendq := '';
260 except
261 on e: exception do begin
262 fdcleanup;
263 raise; //reraise the exception
264 end;
265 end;
266
267 end;
268
269 procedure tlsocket.connecttimeouthandler(sender:tobject);
270 begin
271 connecttimeout.enabled := false;
272 destroying := true; //hack to not cause handler to trigger
273 internalclose(0);
274 destroying := false;
275 realconnect;
276 end;
277
278
279
280
281 procedure tlsocket.connect;
282 var
283 a:integer;
284 ip:tbinip;
285 begin
286 if state <> wsclosed then close;
287 //prevtime := 0;
288 if isbiniplist(addr) then biniplist := addr else biniplist := forwardlookuplist(addr,0);
289 if biniplist_getcount(biniplist) = 0 then raise exception.create('unable to resolve '+addr);
290
291 //makeinaddrv(addr,port,inaddr);
292
293 currentip := 0;
294 if not assigned(connecttimeout) then begin
295 connecttimeout := tltimer.create(self);
296 connecttimeout.ontimer := connecttimeouthandler;
297 connecttimeout.interval := 2500;
298 connecttimeout.enabled := false;
299 end;
300 realconnect;
301 end;
302
303 procedure tlsocket.sendstr(const str : string);
304 begin
305 if dgram then begin
306 send(@str[1],length(str))
307 end else begin
308 inherited sendstr(str);
309 end;
310 end;
311
312 function tlsocket.send(data:pointer;len:integer):integer;
313 begin
314 if dgram then begin
315 // writeln('sending to '+ipbintostr(inaddrvtobinip(inaddr)),' ',htons(inaddr.inaddr.port),' ',len,' bytes');
316 result := sendto(inaddr,getaddrsize,data,len);
317
318 // writeln('send result ',result);
319 // writeln('errno',errno);
320 end else begin
321 result := inherited send(data,len);
322 end;
323 end;
324
325
326 function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;
327 begin
328 if dgram then begin
329 {$ifdef secondlistener}
330 if lastsessionfromsecond then begin
331 result := secondlistener.receive(buf,bufsize);
332 lastsessionfromsecond := false;
333 end else
334 {$endif}
335 result := myfdread(self.fdhandlein,buf^,bufsize);
336 end else begin
337 result := inherited receive(buf,bufsize);
338 end;
339 end;
340
341 procedure tlsocket.bindsocket;
342 var
343 a:integer;
344 inAddrtemp:TInetSockAddrV;
345 inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
346 inaddrtempsize:integer;
347 begin
348 try
349 if (localaddr <> '') or (localport <> '') then begin
350 if localaddr = '' then begin
351 {$ifdef ipv6}
352 if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else
353 {$endif}
354 localaddr := '0.0.0.0';
355 end;
356 //gethostbyname(localaddr,host);
357 inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp);
358
359 If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin
360 state := wsclosed;
361 lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
362 raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror));
363 end;
364 state := wsbound;
365 end;
366 except
367 on e: exception do begin
368 fdcleanup;
369 raise; //reraise the exception
370 end;
371 end;
372 end;
373
374 procedure tlsocket.listen;
375 var
376 yes:longint;
377 socktype:integer;
378 biniptemp:tbinip;
379 origaddr:string;
380 begin
381 if state <> wsclosed then close;
382 udp := uppercase(proto) = 'UDP';
383 if udp then begin
384 socktype := SOCK_DGRAM;
385 dgram := true;
386 end else socktype := SOCK_STREAM;
387 origaddr := addr;
388
389 if addr = '' then begin
390 {$ifdef ipv6}
391 if not v4listendefault then begin
392 addr := '::';
393 end else
394 {$endif}
395 addr := '0.0.0.0';
396 end;
397 if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10);
398 addr := ipbintostr(biniptemp);
399 fdhandlein := socket(biniptemp.family,socktype,0);
400 {$ifdef ipv6}
401 if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
402 addr := '0.0.0.0';
403 fdhandlein := socket(AF_INET,socktype,0);
404 end;
405 {$endif}
406
407 if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef win32}+' error='+inttostr(wsagetlasterror){$endif});
408 dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things
409 //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup
410 state := wsclosed; // then set this back as it was an undesired side effect of dup
411
412 try
413 yes := $01010101; {Copied this from existing code. Value is empiric,
414 but works. (yes=true<>0) }
415 {$ifndef win32}
416 if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
417 raise ESocketException.create('unable to set socket options');
418 end;
419 {$endif}
420 localaddr := addr;
421 localport := port;
422 bindsocket;
423
424 if not udp then begin
425 {!!! allow custom queue length? default 5}
426 if listenqueue = 0 then listenqueue := 5;
427 If {$ifdef win32}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise
428 esocketexception.create('unable to listen');
429 state := wsListening;
430 end else begin
431 {$ifndef win32}
432 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
433 {$else}
434 SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
435 {$endif}
436 state := wsconnected;
437 end;
438
439 {$ifdef secondlistener}
440 //listening on ::. try to listen on 0.0.0.0 as well for platforms which don't already do that
441 if addr = '::' then begin
442 secondlistener := tlsocket.create(nil);
443 secondlistener.proto := proto;
444 secondlistener.addr := '0.0.0.0';
445 secondlistener.port := port;
446 if udp then begin
447 secondlistener.ondataavailable := secondaccepthandler;
448 end else begin
449 secondlistener.onsessionAvailable := secondaccepthandler;
450 end;
451 try
452 secondlistener.listen;
453 except
454 secondlistener.destroy;
455 secondlistener := nil;
456 end;
457 end;
458 {$endif}
459 finally
460 if state = wsclosed then begin
461 if fdhandlein >= 0 then begin
462 {one *can* get here without fd -beware}
463 eventcore.rmasterclr(fdhandlein);
464 myfdclose(fdhandlein); // we musnt leak file discriptors
465 eventcore.setfdreverse(fdhandlein,nil);
466 fdhandlein := -1;
467 end;
468 end else begin
469 eventcore.rmasterset(fdhandlein,not udp);
470 end;
471 if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
472 end;
473 //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein);
474 end;
475
476 {$ifdef secondlistener}
477 procedure tlsocket.internalclose(error:word);
478 begin
479 if assigned(secondlistener) then begin
480 secondlistener.destroy;
481 secondlistener := nil;
482 end;
483 inherited internalclose(error);
484 end;
485
486 procedure tlsocket.secondaccepthandler;
487 begin
488 lastsessionfromsecond := true;
489 if udp then begin
490 ondataavailable(self,error);
491 end else begin
492 if assigned(onsessionavailable) then onsessionavailable(self,error);
493 end;
494 end;
495 {$endif}
496
497 function tlsocket.accept : longint;
498 var
499 FromAddrSize : LongInt; // i don't realy know what to do with these at this
500 FromAddr : TInetSockAddrV; // at this point time will tell :)
501 a:integer;
502 begin
503 {$ifdef secondlistener}
504 if (lastsessionfromsecond) then begin
505 lastsessionfromsecond := false;
506 result := secondlistener.accept;
507 exit;
508 end;
509 {$endif}
510
511 FromAddrSize := Sizeof(FromAddr);
512 {$ifdef win32}
513 result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
514 {$else}
515 result := system_accept(fdhandlein,fromaddr,fromaddrsize);
516 {$endif}
517 //now we have accepted one request start monitoring for more again
518 eventcore.rmasterset(fdhandlein,true);
519
520 if result = -1 then begin
521 raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting');
522 end;
523 if result > absoloutemaxs then begin
524 myfdclose(result);
525 a := result;
526 result := -1;
527 raise esocketexception.create('file discriptor out of range: '+inttostr(a));
528 end;
529 end;
530
531
532 function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer;
533 var
534 destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute dest;
535 begin
536 {$ifdef secondlistener}
537 if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin
538 result := secondlistener.sendto(dest,destlen,data,len);
539 exit;
540 end;
541 {$endif}
542 result := {$ifdef win32}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx,destlen);
543 end;
544
545
546 function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer;
547 var
548 tempsrc:TInetSockAddrV;
549 tempsrclen:integer;
550 srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc;
551 biniptemp:tbinip;
552 begin
553 {$ifdef secondlistener}
554 if assigned(secondlistener) then if lastsessionfromsecond then begin
555 lastsessionfromsecond := false;
556 result := secondlistener.receivefrom(data,len,src,srclen);
557 exit;
558 end;
559 {$endif}
560 tempsrclen := sizeof(tempsrc);
561 result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen);
562
563 {$ifdef ipv6}
564 biniptemp := inaddrvtobinip(tempsrc);
565 if needconverttov4(biniptemp) then begin
566 converttov4(biniptemp);
567 tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc);
568 end;
569 {$endif}
570
571 move(tempsrc,src,srclen);
572 srclen := tempsrclen;
573 end;
574
575 procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);
576 begin
577 connectionfailedhandler(wparam);
578 end;
579
580 procedure tlsocket.connectionfailedhandler(error:word);
581 begin
582 if trymoreips then begin
583 // writeln('failed with error ',error);
584 connecttimeout.enabled := false;
585 destroying := true;
586 state := wsconnected;
587 self.internalclose(0);
588 destroying := false;
589 realconnect;
590 end else begin
591 state := wsconnected;
592 if assigned(onsessionconnected) then onsessionconnected(self,error);
593 self.internalclose(0);
594 recvq.del(maxlongint);
595 end;
596 end;
597
598 procedure tlsocket.connectsuccesshandler;
599 begin
600 trymoreips := false;
601 connecttimeout.enabled := false;
602 if assigned(onsessionconnected) then onsessionconnected(self,0);
603 end;
604
605
606 procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
607 var
608 tempbuf:array[0..receivebufsize-1] of byte;
609 begin
610 // writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger,' state=',integer(state));
611 if (state =wslistening) and readtrigger then begin
612 { debugout('listening socket triggered on read');}
613 eventcore.rmasterclr(fdhandlein);
614 if assigned(onsessionAvailable) then onsessionAvailable(self,0);
615 end;
616 if dgram and readtrigger then begin
617 if assigned(ondataAvailable) then ondataAvailable(self,0);
618 {!!!test}
619 exit;
620 end;
621 if (state =wsconnecting) and writetrigger then begin
622 // code for dealing with the reults of a non-blocking connect is
623 // rather complex
624 // if just write is triggered it means connect suceeded
625 // if both read and write are triggered it can mean 2 things
626 // 1: connect ok and data availible
627 // 2: connect fail
628 // to find out which you must read from the socket and look for errors
629 // there if we read successfully we drop through into the code for fireing
630 // the read event
631 if not readtrigger then begin
632 state := wsconnected;
633 connectsuccesshandler;
634 end else begin
635 numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
636 if numread <> -1 then begin
637 state := wsconnected;
638 connectsuccesshandler;
639 //connectread := true;
640 recvq.add(@tempbuf,numread);
641 end else begin
642 connectionfailedhandler({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});
643 exit;
644 end;
645 // if things went well here we are now in the state wsconnected with data sitting in our receive buffer
646 // so we drop down into the processing for data availible
647 end;
648 if fdhandlein >= 0 then begin
649 if state = wsconnected then begin
650 eventcore.rmasterset(fdhandlein,false);
651 end else begin
652 eventcore.rmasterclr(fdhandlein);
653 end;
654 end;
655 if fdhandleout >= 0 then begin
656 if sendq.size = 0 then begin
657 //don't clear the bit in fdswmaster if data is in the sendq
658 eventcore.wmasterclr(fdhandleout);
659 end;
660 end;
661
662 end;
663 inherited handlefdtrigger(readtrigger,writetrigger);
664 end;
665
666 constructor tlsocket.Create(AOwner: TComponent);
667 begin
668 inherited create(aowner);
669 closehandles := true;
670 trymoreips := true;
671 end;
672
673
674
675 function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
676 var
677 addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
678 begin
679 result := {$ifdef win32}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen);
680 end;
681
682 procedure tlsocket.getxaddrbin(var binip:tbinip);
683 var
684 addr:tinetsockaddrv;
685 i:integer;
686 begin
687 i := sizeof(addr);
688 fillchar(addr,sizeof(addr),0);
689
690 {$ifdef win32}
691 winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
692 {$else}
693 system_getsocketname(self.fdhandlein,addr,i);
694 {$endif}
695 binip := inaddrvtobinip(addr);
696 converttov4(binip);
697 end;
698
699 procedure tlsocket.getpeeraddrbin(var binip:tbinip);
700 var
701 addr:tinetsockaddrv;
702 i:integer;
703 begin
704 i := sizeof(addr);
705 fillchar(addr,sizeof(addr),0);
706 {$ifdef win32}
707 winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
708 {$else}
709 system_getpeername(self.fdhandlein,addr,i);
710 {$endif}
711
712 binip := inaddrvtobinip(addr);
713 converttov4(binip);
714 end;
715
716 function tlsocket.getXaddr:string;
717 var
718 biniptemp:tbinip;
719 begin
720 getxaddrbin(biniptemp);
721 result := ipbintostr(biniptemp);
722 if result = '' then result := 'error';
723 end;
724
725 function tlsocket.getpeeraddr:string;
726 var
727 biniptemp:tbinip;
728 begin
729 getpeeraddrbin(biniptemp);
730 result := ipbintostr(biniptemp);
731 if result = '' then result := 'error';
732 end;
733
734 function tlsocket.getXport:string;
735 var
736 addr:tinetsockaddrv;
737 i:integer;
738 begin
739 i := sizeof(addr);
740 {$ifdef win32}
741 winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
742
743 {$else}
744 system_getsocketname(self.fdhandlein,addr,i);
745
746 {$endif}
747 result := inttostr(htons(addr.InAddr.port));
748 end;
749
750 function tlsocket.getpeerport:string;
751 var
752 addr:tinetsockaddrv;
753 i:integer;
754 begin
755 i := sizeof(addr);
756 {$ifdef win32}
757 winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i);
758
759 {$else}
760 system_getpeername(self.fdhandlein,addr,i);
761
762 {$endif}
763 result := inttostr(htons(addr.InAddr.port));
764 end;
765
766 {$ifdef win32}
767 procedure tlsocket.myfdclose(fd : integer);
768 begin
769 closesocket(fd);
770 end;
771 function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
772 begin
773 result := winsock.send(fd,(@buf)^,size,0);
774 end;
775 function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
776 begin
777 result := winsock.recv(fd,buf,size,0);
778 end;
779 {$endif}
780
781 end.
782

Properties

Name Value
svn:eol-style CRLF
svn:executable

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