source: perl/modules/AIM/lib/Net/OSCAR/Connection.pm @ 7a1c90d

barnowl_perlaim
Last change on this file since 7a1c90d was 7a1c90d, checked in by Geoffrey Thomas <geofft@mit.edu>, 16 years ago
Skeleton AIM module, and Net::OSCAR 1.925
  • Property mode set to 100644
File size: 18.1 KB
Line 
1=pod
2
3Net::OSCAR::Connection -- individual Net::OSCAR service connection
4
5=cut
6
7package Net::OSCAR::Connection;
8
9$VERSION = '1.925';
10$REVISION = '$Revision: 1.95 $';
11
12use strict;
13use vars qw($VERSION);
14use Carp;
15use Socket;
16use Symbol;
17use Digest::MD5;
18use Fcntl;
19use POSIX qw(:errno_h);
20use Scalar::Util qw(weaken);
21use List::Util qw(max);
22
23use Net::OSCAR::Common qw(:all);
24use Net::OSCAR::Constants;
25use Net::OSCAR::Utility;
26use Net::OSCAR::TLV;
27use Net::OSCAR::Callbacks;
28use Net::OSCAR::XML;
29
30if($^O eq "MSWin32") {
31        eval '*F_GETFL = sub {0};';
32        eval '*F_SETFL = sub {0};';
33        eval '*O_NONBLOCK = sub {0}; ';
34}
35
36sub new($@) {
37        my($class, %data) = @_;
38        $class = ref($class) || $class || "Net::OSCAR::Connection";
39        my $self = { %data };
40
41        # Avoid circular references
42        weaken($self->{session});
43
44        bless $self, $class;
45        $self->{seqno} = 0;
46        $self->{icq_seqno} = 0;
47        $self->{outbuff} = "";
48        $self->{state} ||= "write";
49        $self->{paused} = 0 unless $self->{paused};
50        $self->{families} = {};
51        $self->{buffsize} = 65535;
52        $self->{buffer} = \"";
53
54        $self->connect($self->{peer}) if exists($self->{peer});
55
56        return $self;
57}
58
59sub pause($) {
60        my $self = shift;
61        $self->{pause_queue} ||= [];
62        $self->{paused} = 1;
63}
64
65sub unpause($) {
66        my $self = shift;
67        return unless $self->{paused};
68        $self->{paused} = 0;
69
70        $self->log_print(OSCAR_DBG_WARN, "Flushing pause queue");
71        foreach my $item(@{$self->{pause_queue}}) {
72                $self->log_printf(OSCAR_DBG_WARN, "Flushing SNAC 0x%04X/0x%04X", $item->{family}, $item->{subtype});
73                $self->snac_put(%$item);
74        }
75        $self->log_print(OSCAR_DBG_WARN, "Pause queue flushed");
76
77        delete $self->{pause_queue};
78}
79
80sub proto_send($%) {
81        my($self, %data) = @_;
82        $data{protodata} ||= {};
83
84        my %snac = protobit_to_snac($data{protobit}); # or croak "Couldn't find protobit $data{protobit}";
85        confess "BAD SELF!" unless ref($self);
86        confess "BAD DATA!" unless ref($data{protodata});
87
88        $snac{data} = protoparse($self->{session}, $data{protobit})->pack(%{$data{protodata}});
89        foreach (qw(reqdata reqid flags1 flags2)) {
90                $snac{$_} = $data{$_} if exists($data{$_});
91        }
92
93        if(exists($snac{family})) {
94                if($snac{family} == -1 and exists($data{family})) {
95                        $snac{family} = $data{family};
96                }
97
98                if($self->{paused} and !$data{nopause}) {
99                        $self->log_printf(OSCAR_DBG_WARN, "Adding SNAC 0x%04X/0x%04X to pause queue", $snac{family}, $snac{subtype});
100                        push @{$self->{pause_queue}}, \%snac;
101                } else {
102                        $self->log_printf(OSCAR_DBG_DEBUG, "Put SNAC 0x%04X/0x%04X: %s", $snac{family}, $snac{subtype}, $data{protobit});
103                        $self->snac_put(%snac);
104                }
105        } else {
106                $snac{channel} ||= 0+FLAP_CHAN_SNAC;
107                $self->log_printf(OSCAR_DBG_DEBUG, "Putting raw FLAP: %s", $data{protobit});
108                $self->flap_put($snac{data}, $snac{channel});
109        }
110}
111
112
113
114sub fileno($) {
115        my $self = shift;
116        return undef unless $self->{socket};
117        return fileno $self->{socket};
118}
119
120sub flap_encode($$;$) {
121        my ($self, $msg, $channel) = @_;
122
123        $channel ||= FLAP_CHAN_SNAC;
124        return protoparse($self->{session}, "flap")->pack(
125                channel => $channel,
126                seqno => ++$self->{seqno},
127                msg => $msg
128        );
129}
130
131sub write($$) {
132        my($self, $data) = @_;
133
134        my $had_outbuff = 1 if $self->{outbuff};
135        $self->{outbuff} .= $data;
136
137        my $nchars = syswrite($self->{socket}, $self->{outbuff}, length($self->{outbuff}));
138        if(!defined($nchars)) {
139                return "" if $! == EAGAIN;
140                $self->log_print(OSCAR_DBG_NOTICE, "Couldn't write to socket: $!");
141                $self->{sockerr} = 1;
142                $self->disconnect();
143                return undef;
144        }
145
146        my $wrote = substr($self->{outbuff}, 0, $nchars, "");
147
148        if($self->{outbuff}) {
149                $self->log_print(OSCAR_DBG_NOTICE, "Couldn't do complete write - had to buffer ", length($self->{outbuff}), " bytes.");
150                $self->{state} = "readwrite";
151                $self->{session}->callback_connection_changed($self, "readwrite");
152                return 0;
153        } elsif($had_outbuff) {
154                $self->{state} = "read";
155                $self->{session}->callback_connection_changed($self, "read");
156                return 1;
157        }
158        $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Put '", hexdump($wrote), "'" });
159
160        return 1;
161}
162
163sub flap_put($;$$) {
164        my($self, $msg, $channel) = @_;
165        my $had_outbuff = 0;
166
167        $channel ||= FLAP_CHAN_SNAC;
168
169        return unless $self->{socket} and CORE::fileno($self->{socket}) and getpeername($self->{socket}); # and !$self->{socket}->error;
170
171        $msg = $self->flap_encode($msg, $channel) if $msg;
172        $self->write($msg);
173}
174
175# We need to do non-buffered reading so that stdio's buffers don't screw up select, poll, etc.
176# Thus, for efficiency, we do our own buffering.
177# To prevent a single OSCAR conneciton from monopolizing processing time, for instance if it has
178# a flood of incoming data wide enough that we never run out of stuff to read, we'll only fill
179# the buffer once per call to process_one.
180#
181# no_reread value of 2 indicates that we should only read if we have to
182sub read($$;$) {
183        my($self, $len, $no_reread) = @_;
184        $no_reread ||= 0;
185
186        $self->{buffsize} ||= $len;
187        my $buffsize = $self->{buffsize};
188        $buffsize = $len if $len > $buffsize;
189        my $readlen;
190        if($no_reread == 2) {
191                $readlen = $len - length(${$self->{buffer}});
192        } else {
193                $readlen = $buffsize - length(${$self->{buffer}});
194        }
195
196        if($readlen > 0 and $no_reread != 1) {
197                my $buffer = "";
198                my $nchars = sysread($self->{socket}, $buffer, $buffsize - length(${$self->{buffer}}));
199                if(${$self->{buffer}}) {
200                        ${$self->{buffer}} .= $buffer;
201                } else {
202                        $self->{buffer} = \$buffer;
203                }
204
205                if(!${$self->{buffer}} and !defined($nchars)) {
206                        return "" if $! == EAGAIN;
207                        $self->log_print(OSCAR_DBG_NOTICE, "Couldn't read from socket: $!");
208                        $self->{sockerr} = 1;
209                        $self->disconnect();
210                        return undef;
211                } elsif(!${$self->{buffer}} and $nchars == 0) { # EOF
212                        $self->log_print(OSCAR_DBG_NOTICE, "Got EOF on socket");
213                        $self->{sockerr} = 1;
214                        $self->disconnect();
215                        return undef;
216                }
217        }
218
219        if(length(${$self->{buffer}}) < $len) {
220                return "";
221        } else {
222                my $ret;
223                delete $self->{buffsize};
224                if(length(${$self->{buffer}}) == $len) {
225                        $ret = $self->{buffer};
226                        $self->{buffer} = \"";
227                } else {
228                        $ret = \substr(${$self->{buffer}}, 0, $len, "");
229                }
230                $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Got '", hexdump($$ret), "'" });
231                return $$ret;
232        }
233}
234
235sub flap_get($;$) {
236        my ($self, $no_reread) = @_;
237        my $socket = $self->{socket};
238        my ($buffer, $channel, $len);
239        my $nchars;
240
241        if(!$self->{buff_gotflap}) {
242                my $header = $self->read(6, $no_reread);
243                if(!defined($header)) {
244                        return undef;
245                } elsif($header eq "") {
246                        return "";
247                }
248
249                $self->{buff_gotflap} = 1;
250                (undef, $self->{channel}, undef, $self->{flap_size}) =
251                        unpack("CCnn", $header);
252        }
253
254        if($self->{flap_size} > 0) {
255                my $data = $self->read($self->{flap_size}, $no_reread || 2);
256                if(!defined($data)) {
257                        return undef;
258                } elsif($data eq "") {
259                        return "";
260                }
261
262                $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Got ", hexdump($data) });
263                delete $self->{buff_gotflap};
264                return $data;
265        } else {
266                delete $self->{buff_gotflap};
267                return "";
268        }
269}
270
271sub snac_encode($%) {
272        my($self, %snac) = @_;
273
274        $snac{family} ||= 0;
275        $snac{subtype} ||= 0;
276        $snac{flags1} ||= 0;
277        $snac{flags2} ||= 0;
278        $snac{data} ||= "";
279        $snac{reqdata} ||= "";
280        $snac{reqid} ||= ($snac{subtype}<<16) | (unpack("n", randchars(2)))[0];
281        $self->{reqdata}->[$snac{family}]->{pack("N", $snac{reqid})} = $snac{reqdata} if $snac{reqdata};
282
283        my $snac = protoparse($self->{session}, "snac")->pack(%snac);
284        return $snac;
285}
286
287sub snac_put($%) {
288        my($self, %snac) = @_;
289
290        if($snac{family} and !$self->{families}->{$snac{family}}) {
291                $self->log_printf(OSCAR_DBG_WARN, "Tried to send unsupported SNAC 0x%04X/0x%04X", $snac{family}, $snac{subtype});
292
293                my $newconn = $self->{session}->connection_for_family($snac{family});
294                if($newconn) {
295                        return $newconn->snac_put(%snac);
296                } else {
297                        $self->{session}->crapout($self, "Couldn't find supported connection for SNAC 0x%04X/0x%04X", $snac{family}, $snac{subtype});
298                }
299        } else {
300                $snac{channel} ||= 0+FLAP_CHAN_SNAC;
301                confess "No family/subtype" unless exists($snac{family}) and exists($snac{subtype});
302
303                if($self->{session}->{rate_manage_mode} != OSCAR_RATE_MANAGE_NONE and $self->{rate_limits}) {
304                        my $key = $self->{rate_limits}->{classmap}->{pack("nn", $snac{family}, $snac{subtype})};
305                        if($key) {
306                                my $rinfo = $self->{rate_limits}->{$key};
307                                if($rinfo) {
308                                        $rinfo->{current_state} = max(
309                                                $rinfo->{max},
310                                                $self->{session}->_compute_rate($rinfo)
311                                        );
312                                        $rinfo->{last_time} = millitime() - $rinfo->{time_offset};
313                                }
314                        }
315                }
316
317                $self->flap_put($self->snac_encode(%snac), $snac{channel});
318        }
319}
320
321sub snac_get($;$) {
322        my($self, $no_reread) = @_;
323        my $snac = $self->flap_get($no_reread) or return 0;
324        return $self->snac_decode($snac);
325}
326
327sub snac_decode($$) {
328        my($self, $snac) = @_;
329        my(%data) = protoparse($self->{session}, "snac")->unpack($snac);
330
331        if($data{flags1} & 0x80) {
332                my($minihdr_len) = unpack("n", $data{data});
333                $self->log_print(OSCAR_DBG_DEBUG, "Got miniheader of length $minihdr_len");
334                substr($data{data}, 0, 2+$minihdr_len) = "";
335        }
336
337        return \%data;
338}
339
340sub snac_dump($$) {
341        my($self, $snac) = @_;
342        return "family=".$snac->{family}." subtype=".$snac->{subtype};
343}
344
345sub disconnect($) {
346        my($self) = @_;
347
348        $self->{session}->delconn($self);
349}
350
351sub set_blocking($$) {
352        my $self = shift;
353        my $blocking = shift;
354        my $flags = 0;
355
356        if($^O ne "MSWin32") {
357                fcntl($self->{socket}, F_GETFL, $flags);
358                if($blocking) {
359                        $flags &= ~O_NONBLOCK;
360                } else {
361                        $flags |= O_NONBLOCK;
362                }
363                fcntl($self->{socket}, F_SETFL, $flags);
364        } else {
365                # Cribbed from http://nntp.x.perl.org/group/perl.perl5.porters/42198
366                ioctl($self->{socket},
367                        0x80000000 | (4 << 16) | (ord('f') << 8) | 126,
368                        $blocking
369                ) or warn "Couldn't set Win32 blocking: $!\n";
370        }
371
372        return $self->{socket};
373}
374
375
376sub connect($$) {
377        my($self, $host) = @_;
378        my $temp;
379        my $port;
380
381        return $self->{session}->crapout($self, "Empty host!") unless $host;
382        $host =~ s/:(.+)//;
383        if(!$1) {
384                if(exists($self->{session})) {
385                        $port = $self->{session}->{port};
386                } else {
387                        return $self->{session}->crapout($self, "No port!");
388                }
389        } else {
390                $port = $1;
391                if($port =~ /^[^0-9]/) {
392                        $port = $self->{session}->{port};
393                }
394        }
395        $self->{host} = $host;
396        $self->{port} = $port;
397
398        $self->log_print(OSCAR_DBG_NOTICE, "Connecting to $host:$port.");
399        if(defined($self->{session}->{proxy_type})) {
400                if($self->{session}->{proxy_type} eq "SOCKS4" or $self->{session}->{proxy_type} eq "SOCKS5") {
401                        require Net::SOCKS or die "SOCKS proxying not available - couldn't load Net::SOCKS: $!\n";
402
403                        my $socksver;
404                        if($self->{session}->{proxy_type} eq "SOCKS4") {
405                                $socksver = 4;
406                        } else {
407                                $socksver = 5;
408                        }
409
410                        my %socksargs = (
411                                socks_addr => $self->{session}->{proxy_host},
412                                socks_port => $self->{session}->{proxy_port} || 1080,
413                                protocol_version => $socksver
414                        );
415                        $socksargs{user_id} = $self->{session}->{proxy_username} if exists($self->{session}->{proxy_username});
416                        $socksargs{user_password} = $self->{session}->{proxy_password} if exists($self->{session}->{proxy_password});
417                        $self->{socks} = new Net::SOCKS(%socksargs) or return $self->{session}->crapout($self, "Couldn't connect to SOCKS proxy: $@");
418
419                        $self->{socket} = $self->{socks}->connect(peer_addr => $host, peer_port => $port) or return $self->{session}->crapout({}, "Couldn't establish connection via SOCKS: $@\n");
420
421                        $self->{ready} = 0;
422                        $self->{connected} = 1;
423                        $self->set_blocking(0);
424                } elsif($self->{session}->{proxy_type} eq "HTTP" or $self->{session}->{proxy_type} eq "HTTPS") {
425
426                        require MIME::Base64;
427
428                        my $authen   =  $self->{session}->{proxy_username};
429                           $authen  .= ":$self->{session}->{proxy_password}"  if $self->{session}->{proxy_password};
430                           $authen   = encode_base64 $authen if $authen;
431
432                        my $request  = "CONNECT $host:$port HTTP/1.1\r\n";
433                           $request .= "Proxy-Authorization: Basic $authen\r\n" if $authen;
434                           $request .= "User-Agent: Net::OSCAR\r\n";
435                           $request .= "\r\n";
436
437                        $self->{socket} = gensym;
438                        socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
439                        if($self->{session}->{local_ip}) {
440                                bind($self->{socket}, sockaddr_in(0, inet_aton($self->{session}->{local_ip}))) or croak "Couldn't bind to desired IP: $!\n";
441                        }
442                        $self->set_blocking(0);
443
444                        my $addr = inet_aton($self->{session}{proxy_host}) or return $self->{session}->crapout($self, "Couldn't resolve $self->{session}{proxy_host}.");
445                        if(!connect($self->{socket}, sockaddr_in($self->{session}{proxy_port}, $addr))) {
446                                return $self->{session}->crapout($self, "Couldn't connect to $self->{session}{proxy_host}:$self->{session}{proxy_port}: $!")
447                                    unless $! == EINPROGRESS;
448                        }
449
450                        # TODO: I don't know what happens if authentication or connection fails
451                        #
452                        my $buffer;
453                        syswrite ($self->{socket}, $request); 
454                        sysread  ($self->{socket}, $buffer, 1024)
455                                or return $self->{session}->crapout($self, "Couldn't read from $self->{session}{proxy_host}:$self->{session}{proxy_port}: $!");
456
457                        return $self->{session}->crapout($self, "Couldn't connect to proxy: $self->{session}{proxy_host}:$self->{session}{proxy_port}: $!")
458                                unless $buffer =~ /connection\s+established/i;
459
460                        $self->set_blocking(0);
461                        $self->{ready} = 0;
462                        $self->{connected} = 1;
463                } else {
464                        die "Unknown proxy_type $self->{session}->{proxy_type} - valid types are SOCKS4, SOCKS5, HTTP, and HTTPS\n";
465                }
466        } else {
467                $self->{socket} = gensym;
468                socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
469                if($self->{session}->{local_ip}) {
470                        bind($self->{socket}, sockaddr_in(0, inet_aton($self->{session}->{local_ip}))) or croak "Couldn't bind to desired IP: $!\n";
471                }
472                $self->set_blocking(0);
473
474                my $addr = inet_aton($host) or return $self->{session}->crapout($self, "Couldn't resolve $host.");
475                if(!connect($self->{socket}, sockaddr_in($port, $addr))) {
476                        return 1 if $! == EINPROGRESS;
477                        return $self->{session}->crapout($self, "Couldn't connect to $host:$port: $!");
478                }
479
480                $self->{ready} = 0;
481                $self->{connected} = 0;
482        }
483
484        binmode($self->{socket}) or return $self->{session}->crapout($self, "Couldn't set binmode: $!");
485        return 1;
486}
487
488sub listen($$) {
489        my($self, $port) = @_;
490        my $temp;
491
492        $self->{host} = $self->{local_addr} || "0.0.0.0";
493        $self->{port} = $port;
494
495        $self->log_print(OSCAR_DBG_NOTICE, "Listening.");
496        if(defined($self->{session}->{proxy_type})) {
497                die "Proxying not support for listening sockets.\n";
498        } else {
499                $self->{socket} = gensym;
500                socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
501
502                setsockopt($self->{socket}, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or return $self->{session}->crapout($self, "Couldn't set listen socket options: $!");
503               
504                my $sockaddr = sockaddr_in($self->{session}->{local_port} || $port || 0, inet_aton($self->{session}->{local_ip} || 0));
505                bind($self->{socket}, $sockaddr) or return $self->{session}->crapout("Couldn't bind to desired IP: $!");
506                $self->set_blocking(0);
507                listen($self->{socket}, SOMAXCONN) or return $self->{session}->crapout("Couldn't listen: $!");
508
509                $self->{state} = "read";
510                $self->{rv}->{ft_state} = "listening";
511        }
512
513        binmode($self->{socket}) or return $self->{session}->crapout("Couldn't set binmode: $!");
514        return 1;
515}
516
517
518
519sub get_filehandle($) { shift->{socket}; }
520
521# $read/$write tell us if select indicated readiness to read and/or write
522# Ditto for $error
523sub process_one($;$$$) {
524        my($self, $read, $write, $error) = @_;
525        my $snac;
526
527        if($error) {
528                $self->{sockerr} = 1;
529                return $self->disconnect();
530        }
531
532        if($write && $self->{outbuff}) {
533                $self->log_print(OSCAR_DBG_DEBUG, "Flushing output buffer.");
534                $self->flap_put();
535        }
536
537        if($write && !$self->{connected}) {
538                $self->log_print(OSCAR_DBG_NOTICE, "Connected.");
539                $self->{connected} = 1;
540                $self->{state} = "read";
541                $self->{session}->callback_connection_changed($self, "read");
542                return 1;
543        } elsif($read && !$self->{ready}) {
544                $self->log_print(OSCAR_DBG_DEBUG, "Getting connack.");
545                my $flap = $self->flap_get();
546                if(!defined($flap)) {
547                        $self->log_print(OSCAR_DBG_NOTICE, "Couldn't connect.");
548                        return 0;
549                } else {
550                        $self->log_print(OSCAR_DBG_DEBUG, "Got connack.");
551                }
552
553                return $self->{session}->crapout($self, "Got bad connack from server") unless $self->{channel} == FLAP_CHAN_NEWCONN;
554
555                if($self->{conntype} == CONNTYPE_LOGIN) {
556                        $self->log_print(OSCAR_DBG_DEBUG, "Got connack.  Sending connack.");
557                        $self->flap_put(pack("N", 1), FLAP_CHAN_NEWCONN) unless $self->{session}->{svcdata}->{hashlogin};
558                        $self->log_print(OSCAR_DBG_SIGNON, "Connected to login server.");
559                        $self->{ready} = 1;
560                        $self->{families} = {23 => 1};
561
562                        if(!$self->{session}->{svcdata}->{hashlogin}) {
563                                $self->proto_send(protobit => "initial_signon_request",
564                                        protodata => {screenname => $self->{session}->{screenname}},
565                                        nopause => 1
566                                );
567                        } else {
568                                $self->proto_send(protobit => "ICQ_signon_request",
569                                        protodata => {signon_tlv($self->{session}, delete($self->{auth}))},
570                                        nopause => 1
571                                );
572                        }
573                } else {
574                        $self->log_print(OSCAR_DBG_NOTICE, "Sending BOS-Signon.");
575                        $self->proto_send(protobit => "BOS_signon",
576                                reqid => 0x01000000 | (unpack("n", substr($self->{auth}, 0, 2)))[0],
577                                protodata => {cookie => substr(delete($self->{auth}), 2)},
578                                nopause => 1
579                        );
580                }
581                $self->log_print(OSCAR_DBG_DEBUG, "SNAC time.");
582                $self->{ready} = 1;
583        } elsif($read) {
584                my $no_reread = 0;
585                while(1) {
586                        if(!$self->{session}->{svcdata}->{hashlogin}) {
587                                $snac = $self->snac_get($no_reread) or return 0;
588                                Net::OSCAR::Callbacks::process_snac($self, $snac);
589                        } else {
590                                my $data = $self->flap_get($no_reread) or return 0;
591                                $snac = {data => $data, reqid => 0, family => 0x17, subtype => 0x3};
592                                if($self->{channel} == FLAP_CHAN_CLOSE) {
593                                        $self->{conntype} = CONNTYPE_LOGIN;
594                                        $self->{family} = 0x17;
595                                        $self->{subtype} = 0x3;
596                                        $self->{data} = $data;
597                                        $self->{reqid} = 0;
598                                        $self->{reqdata}->[0x17]->{pack("N", 0)} = "";
599                                        Net::OSCAR::Callbacks::process_snac($self, $snac);
600                                } else {
601                                        my $snac = $self->snac_decode($data);
602                                        if($snac) {
603                                                Net::OSCAR::Callbacks::process_snac($self, $snac);
604                                        } else {
605                                                return 0;
606                                        }
607                                }
608                        }
609                } continue {
610                        $no_reread = 1;
611                }
612        }
613}
614
615sub ready($) {
616        my($self) = shift;
617
618        return if $self->{sentready}++;
619        send_versions($self, 1);
620        $self->unpause();
621}
622
623sub session($) { return shift->{session}; }
624
625sub peer_ip($) {
626        my($self) = @_;
627
628        my $sockaddr = getpeername($self->{socket});
629        my($port, $iaddr) = sockaddr_in($sockaddr);
630        return inet_ntoa($iaddr);
631}
632
633sub local_ip($) {
634        my($self) = @_;
635
636        my $sockaddr = getsockname($self->{socket});
637        my($port, $iaddr) = sockaddr_in($sockaddr);
638        return inet_ntoa($iaddr);
639}
640
6411;
Note: See TracBrowser for help on using the repository browser.