/usr/local/CPAN/DJabberd/DJabberd/Connection/ClientIn.pm
package DJabberd::Connection::ClientIn;
use strict;
use base 'DJabberd::Connection';
use fields (
# {=server-needs-client-wanted-roster-state}
'requested_roster', # bool: if user has requested their roster,
'got_initial_presence', # bool: if user has already sent their initial presence
'is_available', # bool: is an "available resource"
'directed_presence', # the jids we have sent directed presence too
'pend_in_subscriptions', # undef or arrayref of presence type='subscribe' packets to be redelivered when we become available
);
sub note_pend_in_subscription {
my ($self, $pres_packet) = @_;
if ($self->is_available) {
# can send it now if we're online
$pres_packet->deliver($self->vhost);
} else {
# keep it on a list and deliver it later, when we get initial presence
push @{$self->{pend_in_subscriptions} ||= []}, $pres_packet;
}
}
sub directed_presence {
my $self = shift;
return keys %{$self->{directed_presence}};
}
sub add_directed_presence {
my ($self, $to_jid) = @_;
($self->{directed_presence} ||= {})->{$to_jid} = 1;
}
sub clear_directed_presence {
my $self = shift;
delete $self->{directed_presence};
}
sub requested_roster {
my $self = shift;
return $self->{requested_roster};
}
sub set_requested_roster {
my ($self, $val) = @_;
$self->{requested_roster} = $val;
}
sub set_available {
my ($self, $val) = @_;
$self->{is_available} = $val;
}
sub is_available {
my $self = shift;
return $self->{is_available};
}
# called when a presence broadcast is received. on first time,
# returns tru.
sub is_initial_presence {
my $self = shift;
return 0 if $self->{got_initial_presence};
return $self->{got_initial_presence} = 1;
}
sub on_initial_presence {
my $self = shift;
$self->send_resource_presences;
$self->send_presence_probes;
$self->send_pending_sub_requests;
$self->vhost->hook_chain_fast('OnInitialPresence',
[ $self ], {});
}
sub send_resource_presences {
my $self = shift;
my $vhost = $self->vhost;
my $my_jid = $self->bound_jid;
$vhost->check_presence($my_jid, sub {
my $map = shift;
foreach my $from_jid_str (keys %$map) {
next if $from_jid_str eq $my_jid->as_string;
my $stanza = $map->{$from_jid_str};
my $to_send = $stanza->clone;
#$to_send->set_from($from_jid_str); # set_from is happy to recieve a string instead of a JID object
$to_send->set_to($my_jid);
$to_send->deliver($self);
}
});
}
sub send_presence_probes {
my $self = shift;
my $send_probes = sub {
my $roster = shift;
# go through rosteritems who we're subscribed to
my $from_jid = $self->bound_jid;
foreach my $it ($roster->to_items) {
my $probe = DJabberd::Presence->probe(to => $it->jid, from => $from_jid);
# if we know the other side trusts us, let's avoid us internally not
# trusting ourselves and doing more work in Presence.pm than we need to,
# reloading lots of roster items and such.
if ($it->subscription->sub_from) {
$probe->{dont_load_rosteritem} = 1;
}
$probe->procdeliver($self->vhost);
}
};
$self->vhost->get_roster($self->bound_jid, on_success => $send_probes);
}
sub send_pending_sub_requests {
my $self = shift;
return unless $self->{pend_in_subscriptions};
foreach my $pkt (@{ $self->{pend_in_subscriptions} }) {
$pkt->deliver($self->vhost);
}
$self->{pend_in_subscriptions} = undef;
}
sub close {
my $self = shift;
return if $self->{closed};
# send an unavailable presence broadcast if we've gone away
if ($self->is_available) {
# set unavailable here, BEFORE we sent out unavailable stanzas,
# so if the stanzas 'bounce' or otherwise write back to our full JID,
# they'll either drop/bounce instead of writing to what will
# soon be a dead full JID.
$self->set_available(0);
my $unavail = DJabberd::Presence->unavailable_stanza;
$unavail->broadcast_from($self);
}
if (my $jid = $self->bound_jid) {
$self->vhost->unregister_jid($jid, $self);
DJabberd::Presence->forget_last_presence($jid);
}
if ($self->vhost && $self->vhost->are_hooks("ConnectionClosing")) {
$self->vhost->run_hook_chain(phase => "ConnectionClosing",
args => [ $self ],
methods => {
fallback => sub {
},
},
);
}
$self->SUPER::close;
}
sub namespace {
return "jabber:client";
}
sub on_stream_start {
my DJabberd::Connection $self = shift;
my $ss = shift;
return $self->close unless $ss->xmlns eq $self->namespace; # FIXME: should be stream error
$self->{in_stream} = 1;
my $to_host = $ss->to;
DJabberd::Log->get_logger->info($to_host);
my $vhost = $self->server->lookup_vhost($to_host);
return $self->close_no_vhost($to_host)
unless ($vhost);
$self->set_vhost($vhost);
# FIXME: bitch if we're starting a stream when we already have one, and we aren't
# expecting a new stream to start (like after SSL or SASL)
my %opts = ( namespace => 'jabber:client' );
## If sasl successfully completed, we shouldn't propose deprecated iq-auth method anymore
if ($self->sasl && $self->sasl->authenticated_jid) {
$opts{features} = qq{<bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'><required/></bind>};
# The protocol for session establishment was determined to be unnecessary and
# therefore the content previously defined in Section 3 of RFC 3921
# was removed. However, for the sake of backward-compatibility server
# implementations are encouraged to advertise support for the feature,
# even though session establishment is a "no-op".
$opts{features} .= qq{<session xmlns='urn:ietf:params:xml:ns:xmpp-session'/>};
}
else {
$opts{features} = qq{<auth xmlns='http://jabber.org/features/iq-auth'/>};
}
$self->start_stream_back($ss, %opts);
}
sub is_server { 0 }
my %element2class = (
"{jabber:client}iq" => 'DJabberd::IQ',
"{jabber:client}message" => 'DJabberd::Message',
"{jabber:client}presence" => 'DJabberd::Presence',
"{urn:ietf:params:xml:ns:xmpp-tls}starttls" => 'DJabberd::Stanza::StartTLS',
);
sub on_stanza_received {
my ($self, $node) = @_;
if ($self->xmllog->is_info) {
$self->log_incoming_data($node);
}
my $class = $element2class{$node->element};
$self->log->debug("node is " . $node->as_xml);
#warn $node->as_xml;
$self->vhost->hook_chain_fast("HandleStanza",
[ $node, $self ],
{
handle => sub {
my ($self, $handling_class) = @_;
$class = $handling_class;
},
}
) unless $class;
return $self->stream_error("unsupported-stanza-type") unless $class;
$DJabberd::Stats::counter{"ClientIn:$class"}++;
# same variable as $node, but down(specific)-classed.
my $stanza = $class->downbless($node, $self);
$self->vhost->hook_chain_fast("filter_incoming_client",
[ $stanza, $self ],
{
reject => sub { }, # just stops the chain
},
\&filter_incoming_client_builtin,
);
}
sub is_authenticated_jid {
my ($self, $jid) = @_;
my $bj = $self->bound_jid;
return 0 unless $jid && $bj;
return $bj->as_bare_string eq $jid->as_bare_string if $jid->is_bare;
return $bj->as_string eq $jid->as_string;
}
# This is not really a method, but gets invoked as a hookchain item
# so if you subclass this class, this will still get called
sub filter_incoming_client_builtin {
my ($vhost, $cb, $stanza, $self) = @_;
# <invalid-from/> -- the JID or hostname provided in a 'from'
# address does not match an authorized JID or validated domain
# negotiated between servers via SASL or dialback, or between a
# client and a server via authentication and resource binding.
#{=clientin-invalid-from}
my $from = $stanza->from_jid;
if ($from && ! $self->is_authenticated_jid($from)) {
# make sure it is from them, if they care to tell us who they are.
# (otherwise further processing should assume it's them anyway)
# libgaim quirks bug. libgaim sends bogus from on IQ errors.
# see doc/quirksmode.txt.
if ($vhost->quirksmode && $stanza->isa("DJabberd::IQ") &&
$stanza->type eq "error" && $stanza->from eq $stanza->to) {
# fix up from address
$from = $self->bound_jid;
$stanza->set_from($from);
} else {
return $self->stream_error('invalid-from');
}
}
# if no from, we set our own
if (! $from) {
my $bj = $self->bound_jid;
$stanza->set_from($bj->as_string) if $bj;
}
$vhost->hook_chain_fast("switch_incoming_client",
[ $stanza ],
{
process => sub { $stanza->process($self) },
deliver => sub { $stanza->deliver($self) },
},
sub {
$stanza->on_recv_from_client($self);
});
}
1;