1package DJabberd::SAXHandler;
2use strict;
3use base qw(XML::SAX::Base);
4use DJabberd::XMLElement;
5use DJabberd::StreamStart;
6use Scalar::Util qw(weaken);
7use Time::HiRes ();
8
9sub new {
10    my ($class, $conn) = @_;
11    my $self = $class->SUPER::new;
12
13    if ($conn) {
14        $self->{"ds_conn"} = $conn;
15        weaken($self->{ds_conn});
16    }
17
18    $self->{"capture_depth"} = 0;  # on transition from 1 to 0, stop capturing
19    $self->{"on_end_capture"} = undef;  # undef or $subref->($doc)
20    $self->{"events"} = [];  # capturing events
21    return $self;
22}
23
24sub set_connection {
25    my ($self, $conn) = @_;
26    $self->{ds_conn} = $conn;
27    if ($conn) {
28        weaken($self->{ds_conn});
29    } else {
30        # when sax handler is being put back onto the freelist...
31        $self->{on_end_capture} = undef;
32    }
33}
34
35# called when somebody is about to destroy their reference to us, to make
36# us clean up.
37sub cleanup {
38    my $self = shift;
39    $self->{on_end_capture} = undef;
40}
41
42sub depth {
43    return $_[0]{capture_depth};
44}
45
46use constant EVT_START_ELEMENT => 1;
47use constant EVT_END_ELEMENT   => 2;
48use constant EVT_CHARS         => 3;
49
50sub start_element {
51    my ($self, $data) = @_;
52    my $conn = $self->{ds_conn};
53
54    # {=xml-stream}
55    if ($data->{NamespaceURI} eq "http://etherx.jabber.org/streams" &&
56        $data->{LocalName} eq "stream") {
57
58        my $ss = DJabberd::StreamStart->new($data);
59
60        # when Connection.pm is prepping a new dummy root node, we legitimately
61        # get here without a connection, so we need to test for it:
62        $conn->on_stream_start($ss) if $conn;
63        return;
64    }
65
66    # need a connection past this point.
67    return unless $conn;
68
69    # if they're not in a stream yet, bail.
70    unless ($conn->{in_stream}) {
71        $conn->stream_error('invalid-namespace');
72        return;
73    }
74
75    if ($self->{capture_depth}) {
76        push @{$self->{events}}, [EVT_START_ELEMENT, $data];
77        $self->{capture_depth}++;
78        return;
79    }
80
81    # start capturing...
82    $self->{"events"} = [
83                         [EVT_START_ELEMENT, $data],
84                         ];
85    $self->{capture_depth} = 1;
86
87    Scalar::Util::weaken($conn);
88    $self->{on_end_capture} = sub {
89        my ($doc, $events) = @_;
90        my $nodes = _nodes_from_events($events);
91        # {=xml-stanza}
92        my $t1 = Time::HiRes::time();
93        $conn->on_stanza_received($nodes->[0]) if $conn;
94        my $td = Time::HiRes::time() - $t1;
95
96        # ring buffers for latency stats:
97        if ($td > $DJabberd::Stats::latency_log_threshold) {
98            $DJabberd::Stats::stanza_process_latency_log[ $DJabberd::Stats::latency_log_index =
99                                                          ($DJabberd::Stats::latency_log_index + 1)
100                                                          % $DJabberd::Stats::latency_log_max_size
101                                                          ] = [$td, $nodes->[0]->as_xml];
102        }
103
104        $DJabberd::Stats::stanza_process_latency[ $DJabberd::Stats::latency_index =
105                                                  ($DJabberd::Stats::latency_index + 1)
106                                                   % $DJabberd::Stats::latency_max_size
107                                                  ] = $td;
108    };
109    return;
110}
111
112sub characters {
113    my ($self, $data) = @_;
114
115    if ($self->{capture_depth}) {
116        push @{$self->{events}}, [EVT_CHARS, $data];
117    }
118
119    # TODO: disconnect client if character data between stanzas?  as
120    # long as it's not whitespace, because that's permitted as a
121    # keep-alive.
122
123}
124
125sub end_element {
126    my ($self, $data) = @_;
127
128    if ($data->{NamespaceURI} eq "http://etherx.jabber.org/streams" &&
129        $data->{LocalName} eq "stream") {
130        $self->{ds_conn}->end_stream if $self->{ds_conn};
131        return;
132    }
133
134    if ($self->{capture_depth}) {
135        push @{$self->{events}}, [EVT_END_ELEMENT, $data];
136        $self->{capture_depth}--;
137        return if $self->{capture_depth};
138        my $doc = undef;
139        if (my $cb = $self->{on_end_capture}) {
140            $cb->($doc, $self->{events});
141        }
142        return;
143    }
144}
145
146sub _nodes_from_events {
147    my ($evlist, $i, $end) = @_;
148    $i   ||= 0;
149    $end ||= scalar @$evlist;
150    my $nodelist = [];    # what we're returning (nodes are text or XMLElement nodes)
151
152    while ($i < $end) {
153        my $ev = $evlist->[$i++];
154
155        if ($ev->[0] == EVT_CHARS) {
156            my $text = $ev->[1]{Data};
157            if (@$nodelist == 0 || ref $nodelist->[-1]) {
158                push @$nodelist, $text;
159            } else {
160                $nodelist->[-1] .= $text;
161            }
162            next;
163        }
164
165        if ($ev->[0] == EVT_START_ELEMENT) {
166            my $depth = 1;
167            my $start_idx = $i;  # index of first potential body node
168
169            while ($depth && $i < $end) {
170                my $child = $evlist->[$i++];
171
172                if ($child->[0] == EVT_START_ELEMENT) {
173                    $depth++;
174                } elsif ($child->[0] == EVT_END_ELEMENT) {
175                    $depth--;
176                }
177            }
178            die "Finished events without reaching depth 0!" if $depth;
179
180            my $end_idx = $i - 1;  # (end - start) == number of child elements
181
182            my $attr_sax = $ev->[1]{Attributes};
183            my $attr = {};
184            while (my $key = each %$attr_sax) {
185                $attr->{$key} = $attr_sax->{$key}{Value};
186            }
187
188            push @$nodelist, DJabberd::XMLElement->new($ev->[1]{NamespaceURI},
189                                                       $ev->[1]{LocalName},
190                                                       $attr,
191                                                       _nodes_from_events($evlist, $start_idx, $end_idx),
192                                                       undef,
193                                                       $ev->[1]{Prefix});
194            next;
195        }
196
197        die "Unknown event in stream: $ev->[0]\n";
198    }
199    return $nodelist;
200}
201
202
2031;
204