[7a1c90d] | 1 | =pod |
---|
| 2 | |
---|
| 3 | Net::OSCAR::Connection -- individual Net::OSCAR service connection |
---|
| 4 | |
---|
| 5 | =cut |
---|
| 6 | |
---|
| 7 | package Net::OSCAR::Connection; |
---|
| 8 | |
---|
| 9 | $VERSION = '1.925'; |
---|
| 10 | $REVISION = '$Revision: 1.95 $'; |
---|
| 11 | |
---|
| 12 | use strict; |
---|
| 13 | use vars qw($VERSION); |
---|
| 14 | use Carp; |
---|
| 15 | use Socket; |
---|
| 16 | use Symbol; |
---|
| 17 | use Digest::MD5; |
---|
| 18 | use Fcntl; |
---|
| 19 | use POSIX qw(:errno_h); |
---|
| 20 | use Scalar::Util qw(weaken); |
---|
| 21 | use List::Util qw(max); |
---|
| 22 | |
---|
| 23 | use Net::OSCAR::Common qw(:all); |
---|
| 24 | use Net::OSCAR::Constants; |
---|
| 25 | use Net::OSCAR::Utility; |
---|
| 26 | use Net::OSCAR::TLV; |
---|
| 27 | use Net::OSCAR::Callbacks; |
---|
| 28 | use Net::OSCAR::XML; |
---|
| 29 | |
---|
| 30 | if($^O eq "MSWin32") { |
---|
| 31 | eval '*F_GETFL = sub {0};'; |
---|
| 32 | eval '*F_SETFL = sub {0};'; |
---|
| 33 | eval '*O_NONBLOCK = sub {0}; '; |
---|
| 34 | } |
---|
| 35 | |
---|
| 36 | sub 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 | |
---|
| 59 | sub pause($) { |
---|
| 60 | my $self = shift; |
---|
| 61 | $self->{pause_queue} ||= []; |
---|
| 62 | $self->{paused} = 1; |
---|
| 63 | } |
---|
| 64 | |
---|
| 65 | sub 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 | |
---|
| 80 | sub 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 | |
---|
| 114 | sub fileno($) { |
---|
| 115 | my $self = shift; |
---|
| 116 | return undef unless $self->{socket}; |
---|
| 117 | return fileno $self->{socket}; |
---|
| 118 | } |
---|
| 119 | |
---|
| 120 | sub 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 | |
---|
| 131 | sub 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 | |
---|
| 163 | sub 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 |
---|
| 182 | sub 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 | |
---|
| 235 | sub 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 | |
---|
| 271 | sub 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 | |
---|
| 287 | sub 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 | |
---|
| 321 | sub 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 | |
---|
| 327 | sub 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 | |
---|
| 340 | sub snac_dump($$) { |
---|
| 341 | my($self, $snac) = @_; |
---|
| 342 | return "family=".$snac->{family}." subtype=".$snac->{subtype}; |
---|
| 343 | } |
---|
| 344 | |
---|
| 345 | sub disconnect($) { |
---|
| 346 | my($self) = @_; |
---|
| 347 | |
---|
| 348 | $self->{session}->delconn($self); |
---|
| 349 | } |
---|
| 350 | |
---|
| 351 | sub 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 | |
---|
| 376 | sub 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 | |
---|
| 488 | sub 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 | |
---|
| 519 | sub get_filehandle($) { shift->{socket}; } |
---|
| 520 | |
---|
| 521 | # $read/$write tell us if select indicated readiness to read and/or write |
---|
| 522 | # Ditto for $error |
---|
| 523 | sub 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 | |
---|
| 615 | sub ready($) { |
---|
| 616 | my($self) = shift; |
---|
| 617 | |
---|
| 618 | return if $self->{sentready}++; |
---|
| 619 | send_versions($self, 1); |
---|
| 620 | $self->unpause(); |
---|
| 621 | } |
---|
| 622 | |
---|
| 623 | sub session($) { return shift->{session}; } |
---|
| 624 | |
---|
| 625 | sub 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 | |
---|
| 633 | sub 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 | |
---|
| 641 | 1; |
---|