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