view release on metacpan or  search on metacpan

lib/Net/OSCAR/Connection.pm  view on Meta::CPAN

		die "Proxying not support for listening sockets.\n";
	} else {
		$self->{socket} = gensym;
		socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));

		setsockopt($self->{socket}, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or return $self->{session}->crapout($self, "Couldn't set listen socket options: $!");
		
		my $sockaddr = sockaddr_in($self->{session}->{local_port} || $port || 0, inet_aton($self->{session}->{local_ip} || 0));
		bind($self->{socket}, $sockaddr) or return $self->{session}->crapout("Couldn't bind to desired IP: $!");
		$self->set_blocking(0);
		listen($self->{socket}, SOMAXCONN) or return $self->{session}->crapout("Couldn't listen: $!");

		$self->{state} = "read";
		$self->{rv}->{ft_state} = "listening";
	}

	binmode($self->{socket}) or return $self->{session}->crapout("Couldn't set binmode: $!");
	return 1;
}



sub get_filehandle($) { shift->{socket}; }

# $read/$write tell us if select indicated readiness to read and/or write
# Ditto for $error
sub process_one($;$$$) {
	my($self, $read, $write, $error) = @_;
	my $snac;

	if($error) {
		$self->{sockerr} = 1;
		return $self->disconnect();
	}

	if($write && $self->{outbuff}) {
		$self->log_print(OSCAR_DBG_DEBUG, "Flushing output buffer.");
		$self->flap_put();
	}

	if($write && !$self->{connected}) {
		$self->log_print(OSCAR_DBG_NOTICE, "Connected.");
		$self->{connected} = 1;
		$self->{state} = "read";
		$self->{session}->callback_connection_changed($self, "read");
		return 1;
	} elsif($read && !$self->{ready}) {
		$self->log_print(OSCAR_DBG_DEBUG, "Getting connack.");
		my $flap = $self->flap_get();
		if(!defined($flap)) {
			$self->log_print(OSCAR_DBG_NOTICE, "Couldn't connect.");
			return 0;
		} else {
			$self->log_print(OSCAR_DBG_DEBUG, "Got connack.");
		}

		return $self->{session}->crapout($self, "Got bad connack from server") unless $self->{channel} == FLAP_CHAN_NEWCONN;

		if($self->{conntype} == CONNTYPE_LOGIN) {
			$self->log_print(OSCAR_DBG_DEBUG, "Got connack.  Sending connack.");
			$self->flap_put(pack("N", 1), FLAP_CHAN_NEWCONN) unless $self->{session}->{svcdata}->{hashlogin};
			$self->log_print(OSCAR_DBG_SIGNON, "Connected to login server.");
			$self->{ready} = 1;
			$self->{families} = {23 => 1};

			if(!$self->{session}->{svcdata}->{hashlogin}) {
				$self->proto_send(protobit => "initial_signon_request",
					protodata => {screenname => $self->{session}->{screenname}},
					nopause => 1
				);
			} else {
				$self->proto_send(protobit => "ICQ_signon_request",
					protodata => {signon_tlv($self->{session}, delete($self->{auth}))},
					nopause => 1
				);
			}
		} else {
			$self->log_print(OSCAR_DBG_NOTICE, "Sending BOS-Signon.");
			$self->proto_send(protobit => "BOS_signon",
				reqid => 0x01000000 | (unpack("n", substr($self->{auth}, 0, 2)))[0],
				protodata => {cookie => substr(delete($self->{auth}), 2)},
				nopause => 1
			);
		}
		$self->log_print(OSCAR_DBG_DEBUG, "SNAC time.");
		$self->{ready} = 1;
	} elsif($read) {
		my $no_reread = 0;
		while(1) {
			if(!$self->{session}->{svcdata}->{hashlogin}) {
				$snac = $self->snac_get($no_reread) or return 0;
				Net::OSCAR::Callbacks::process_snac($self, $snac);
			} else {
				my $data = $self->flap_get($no_reread) or return 0;
				$snac = {data => $data, reqid => 0, family => 0x17, subtype => 0x3};
				if($self->{channel} == FLAP_CHAN_CLOSE) {
					$self->{conntype} = CONNTYPE_LOGIN;
					$self->{family} = 0x17;
					$self->{subtype} = 0x3;
					$self->{data} = $data;
					$self->{reqid} = 0;
					$self->{reqdata}->[0x17]->{pack("N", 0)} = "";
					Net::OSCAR::Callbacks::process_snac($self, $snac);
				} else {
					my $snac = $self->snac_decode($data);
					if($snac) {
						Net::OSCAR::Callbacks::process_snac($self, $snac);
					} else {
						return 0;
					}
				}
			}
		} continue {
			$no_reread = 1;
		}
	}
}

sub ready($) {
	my($self) = shift;

	return if $self->{sentready}++;
	send_versions($self, 1);
	$self->unpause();
}

sub session($) { return shift->{session}; }

sub peer_ip($) {
	my($self) = @_;

	my $sockaddr = getpeername($self->{socket});
	my($port, $iaddr) = sockaddr_in($sockaddr);
	return inet_ntoa($iaddr);
}

sub local_ip($) {
	my($self) = @_;

	my $sockaddr = getsockname($self->{socket});
	my($port, $iaddr) = sockaddr_in($sockaddr);
	return inet_ntoa($iaddr);
}

1;