Net/XMPP2/SimpleConnection.pm

package Net::XMPP2::SimpleConnection;
use strict;

use IO::Socket::INET;
use Errno;
use Fcntl;
use Encode;
use Net::SSLeay;
use IO::Handle;

BEGIN {
   Net::SSLeay::load_error_strings ();
   Net::SSLeay::SSLeay_add_ssl_algorithms ();
   Net::SSLeay::randomize ();
}

=head1 NAME

Net::XMPP2::SimpleConnection - Low level TCP/TLS connection

=head1 SYNOPSIS

   package foo;
   use Net::XMPP2::SimpleConnection;

   our @ISA = qw/Net::XMPP2::SimpleConnection/;

=head1 DESCRIPTION

This module only implements the basic low level socket and SSL handling stuff.
It is used by L<Net::XMPP2::Connection> and you shouldn't mess with it :-)

(NOTE: This is the part of Net::XMPP2 which I feel least confident about :-)

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = {
      disconnect_cb => sub {},
      max_write_length => 4096,
      @_
   };
   bless $self, $class;
   return $self;
}

sub set_block {
   my ($self) = @_;
   my $flags = 0;
   fcntl($self->{socket}, F_GETFL, $flags)
       or die "Couldn't get flags for HANDLE : $!\n";
   $flags &= ~O_NONBLOCK;
   fcntl($self->{socket}, F_SETFL, $flags)
       or die "Couldn't set flags for HANDLE: $!\n";
}

sub set_noblock {
   my ($self) = @_;
   my $flags = 0;
   fcntl($self->{socket}, F_GETFL, $flags)
       or die "Couldn't get flags for HANDLE : $!\n";
   $flags |= O_NONBLOCK;
   fcntl($self->{socket}, F_SETFL, $flags)
       or die "Couldn't set flags for HANDLE: $!\n";
}

sub connect {
   my ($self, $host, $port) = @_;

   $self->{max_write_length} ||= 4000;

   $self->{socket}
      and return 1;

   my $sock = IO::Socket::INET->new (
      PeerAddr => $host,
      PeerPort => $port,
      Proto    => 'tcp',
      Blocking => 1
   );
   return undef unless $sock;;

   $self->{socket} = $sock;
   $self->{host}   = $host;
   $self->{port}   = $port;

   $self->set_noblock;

   binmode $sock, ":raw";

   $self->{r} =
      AnyEvent->io (poll => 'r', fh => $sock, cb => sub {
         my $l = sysread $sock, my $data, 1024;

         if ($l) {
            $self->{read_buffer} .= decode_utf8 $data;
            $self->handle_data (\$self->{read_buffer});

         } else {
            return if $! == Errno::EAGAIN;
            if (defined $l) {
               $self->disconnect ("EOF from server '$self->{host}:$self->{port}'");
               return;

            } else {
               $self->disconnect ("Error while reading from server '$self->{host}:$port': $!");
               return;
            }
         }
      });
   return 1;
}

sub end_sockets {
   my ($self) = @_;
   delete $self->{r};
   delete $self->{w};
   if (delete $self->{ssl_enabled}) {
      Net::SSLeay::free ($self->{ssl});
      delete $self->{ssl};
      Net::SSLeay::CTX_free ($self->{ctx});
      delete $self->{ctx};
   }
   close ($self->{socket});
   delete $self->{socket};
}

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

   my $data = substr $self->{write_buffer}, 0, $self->{max_write_length};
   my $l = Net::SSLeay::write ($self->{ssl}, $data);

   if ($l <= 0) {
      if ($l == 0) {
         $self->disconnect ("unexpected EOF from server (ssl) '$self->{host}:$self->{port}'");
         return;

      } else {
         my $err2 = Net::SSLeay::get_error $self->{ssl}, $l;
         if ($err2 == 2 || $err2 == 3) {
            delete $self->{w};
            $self->make_ssl_write_watcher ($err2 == 2 ? 'r' : 'w');
            return;
         }

         if ($! != Errno::EAGAIN
             or my $err = Net::SSLeay::ERR_get_error) {

            $self->disconnect (
               sprintf (
                  "Error while writing from server '$self->{host}:$self->{port}': (%d|%s|%s)",
               $err2, (Net::SSLeay::ERR_error_string $err), "$!")
            );
            return;
         }
      }
   } else {
      $self->debug_wrote_data (substr $self->{write_buffer}, 0, $l);
      $self->{write_buffer} = substr $self->{write_buffer}, $l;
      if (length ($self->{write_buffer}) <= 0) {
         delete $self->{w};
      }
   }
}

sub try_ssl_read {
   my ($self) = @_;
   my $r = Net::SSLeay::read ($self->{ssl});

   if (defined $r) {
      if ($r eq '') {
         if (my $err = Net::SSLeay::ERR_get_error) {
            $self->disconnect (
               sprintf (
                  "Error while reading from server '$self->{host}:$self->{port}':"
                  ."(%s|%s)",
                  (Net::SSLeay::ERR_error_string $err), "$!")
            );
            return;
         }
         # is this right? $r = '' => EOF? sucky Net::SSLeay... arg...
         $self->disconnect ("EOF from server '$self->{host}:$self->{port}'.");
         return;
      }

      $self->{read_buffer} .= decode_utf8 ($r);
      $self->handle_data (\$self->{read_buffer});
   } else {
      my $err2 = Net::SSLeay::get_error $self->{ssl}, $r;
      if ($err2 == 2 || $err2 == 3) {
         #d# warn "READ RETRY $err2\n";
         delete $self->{r};
         $self->make_ssl_read_watcher ($err2 == 2 ? 'r' : 'w');
         return;
      }

      if ($! != Errno::EAGAIN
          or my $err = Net::SSLeay::ERR_get_error) {

         $self->disconnect (
            sprintf (
               "Error while reading from server '$self->{host}:$self->{port}':"
               ."(%d|%s|%s)",
               $err2, (Net::SSLeay::ERR_error_string $err), "$!")
         );
         return;
      }
   }
}

sub write_data {
   my ($self, $data) = @_;
   #return unless $self->{r};

   my $cl = $self->{socket};
   $self->{write_buffer} .= encode_utf8 ($data);

   unless ($self->{w}) {
      $self->{w} =
         AnyEvent->io (poll => 'w', fh => $cl, cb => sub {
            if (not $self->{ssl_enabled}) {
               if (my $data = $self->{write_buffer}) {
                  $data = substr $data, 0, $self->{max_write_length};
                  my $len = syswrite $cl, $data;
                  unless ($len) {
                     return if $! == Errno::EAGAIN;
                     if (not defined $len) {
                        warn "error when writing data on $self->{host}:$self->{port}: $!";
                        return;
                     } else {
                        delete $self->{w};
                     }
                  }

                  if ($len == length $self->{write_buffer}) {
                     delete $self->{w};
                  }

                  $self->debug_wrote_data (substr $self->{write_buffer}, 0, $len);
                  $self->{write_buffer} = substr $self->{write_buffer}, $len;
               }
            } else {
               $self->try_ssl_write;
            }
         });
   }
}

sub make_ssl_read_watcher {
   my ($self, $poll) = @_;
   return if $self->{r};

   $poll ||= 'r';
   $self->{r} =
      AnyEvent->io (poll => $poll, fh => $self->{socket}, cb => sub {
         $self->try_ssl_read;
      });
}

sub make_ssl_write_watcher {
   my ($self, $poll) = @_;
   return if $self->{w};

   $poll ||= 'w';
   $self->{w} =
      AnyEvent->io (poll => $poll, fh => $self->{socket}, cb => sub {
         $self->try_ssl_write;
      });
}

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

   $Net::SSLeay::ssl_version = 10; # Insist on TLSv1

   $self->{ssl_enabled} = 1;

   #d# warn "START TLS!\n";

   $self->{r} = undef;
   $self->{w} = undef;

   $self->{ctx} = Net::SSLeay::CTX_new ();

   # enable SSL_MODE_ENABLE_PARTIAL_WRITE and SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER
   Net::SSLeay::CTX_set_mode($self->{ctx}, 1 | 2);

   $self->{ssl} = Net::SSLeay::new ($self->{ctx});

   Net::SSLeay::set_fd ($self->{ssl}, fileno $self->{socket});
   #d# warn "CONNECT\n";
   Net::SSLeay::connect $self->{ssl};
   #d# warn "CONNECT END\n";
   binmode $self->{socket}, ":bytes";

   $self->{ssl_read_data} = "";
   $self->make_ssl_read_watcher;
}

sub disconnect {
   my ($self, $msg) = @_;
   $self->end_sockets;
   $self->{disconnect_cb}->($self->{host}, $self->{port}, $msg);
}

1;
Revision:	1.10
Committed:	Fri Jul 6 09:40:15 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.9:	+10 -2 lines
Log Message:	added simxml() function for simpler xml writing and made writing of data segmented.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::SimpleConnection;
2	elmex	1.7	use strict;
3
4	elmex	1.1	use IO::Socket::INET;
5			use Errno;
6			use Fcntl;
7			use Encode;
8			use Net::SSLeay;
9	elmex	1.5	use IO::Handle;
10	elmex	1.1
11			BEGIN {
12			Net::SSLeay::load_error_strings ();
13			Net::SSLeay::SSLeay_add_ssl_algorithms ();
14			Net::SSLeay::randomize ();
15			}
16
17			=head1 NAME
18
19	elmex	1.9	Net::XMPP2::SimpleConnection - Low level TCP/TLS connection
20	elmex	1.1
21			=head1 SYNOPSIS
22
23			package foo;
24			use Net::XMPP2::SimpleConnection;
25
26			our @ISA = qw/Net::XMPP2::SimpleConnection/;
27
28			=head1 DESCRIPTION
29
30			This module only implements the basic low level socket and SSL handling stuff.
31	elmex	1.8	It is used by L<Net::XMPP2::Connection> and you shouldn't mess with it :-)
32
33			(NOTE: This is the part of Net::XMPP2 which I feel least confident about :-)
34	elmex	1.1
35			=cut
36
37			sub new {
38			my $this = shift;
39			my $class = ref($this) \|\| $this;
40	elmex	1.10	my $self = {
41			disconnect_cb => sub {},
42			max_write_length => 4096,
43			@_
44			};
45	elmex	1.1	bless $self, $class;
46			return $self;
47			}
48
49			sub set_block {
50			my ($self) = @_;
51			my $flags = 0;
52			fcntl($self->{socket}, F_GETFL, $flags)
53			or die "Couldn't get flags for HANDLE : $!\n";
54			$flags &= ~O_NONBLOCK;
55			fcntl($self->{socket}, F_SETFL, $flags)
56			or die "Couldn't set flags for HANDLE: $!\n";
57			}
58
59			sub set_noblock {
60			my ($self) = @_;
61			my $flags = 0;
62			fcntl($self->{socket}, F_GETFL, $flags)
63			or die "Couldn't get flags for HANDLE : $!\n";
64			$flags \|= O_NONBLOCK;
65			fcntl($self->{socket}, F_SETFL, $flags)
66			or die "Couldn't set flags for HANDLE: $!\n";
67			}
68
69			sub connect {
70			my ($self, $host, $port) = @_;
71
72	elmex	1.10	$self->{max_write_length} \|\|= 4000;
73
74	elmex	1.1	$self->{socket}
75			and return 1;
76
77			my $sock = IO::Socket::INET->new (
78			PeerAddr => $host,
79			PeerPort => $port,
80			Proto => 'tcp',
81			Blocking => 1
82			);
83			return undef unless $sock;;
84
85			$self->{socket} = $sock;
86			$self->{host} = $host;
87			$self->{port} = $port;
88
89			$self->set_noblock;
90
91	elmex	1.4	binmode $sock, ":raw";
92	elmex	1.1
93			$self->{r} =
94			AnyEvent->io (poll => 'r', fh => $sock, cb => sub {
95			my $l = sysread $sock, my $data, 1024;
96
97			if ($l) {
98	elmex	1.4	$self->{read_buffer} .= decode_utf8 $data;
99	elmex	1.1	$self->handle_data (\$self->{read_buffer});
100
101			} else {
102			return if $! == Errno::EAGAIN;
103			if (defined $l) {
104	elmex	1.5	$self->disconnect ("EOF from server '$self->{host}:$self->{port}'");
105	elmex	1.1	return;
106
107			} else {
108	elmex	1.5	$self->disconnect ("Error while reading from server '$self->{host}:$port': $!");
109	elmex	1.1	return;
110			}
111			}
112			});
113			return 1;
114			}
115
116			sub end_sockets {
117			my ($self) = @_;
118			delete $self->{r};
119			delete $self->{w};
120			if (delete $self->{ssl_enabled}) {
121			Net::SSLeay::free ($self->{ssl});
122			delete $self->{ssl};
123			Net::SSLeay::CTX_free ($self->{ctx});
124			delete $self->{ctx};
125			}
126	elmex	1.5	close ($self->{socket});
127			delete $self->{socket};
128	elmex	1.1	}
129
130			sub try_ssl_write {
131			my ($self) = @_;
132
133	elmex	1.10	my $data = substr $self->{write_buffer}, 0, $self->{max_write_length};
134			my $l = Net::SSLeay::write ($self->{ssl}, $data);
135	elmex	1.1
136			if ($l <= 0) {
137			if ($l == 0) {
138	elmex	1.5	$self->disconnect ("unexpected EOF from server (ssl) '$self->{host}:$self->{port}'");
139	elmex	1.1	return;
140
141			} else {
142			my $err2 = Net::SSLeay::get_error $self->{ssl}, $l;
143			if ($err2 == 2 \|\| $err2 == 3) {
144			delete $self->{w};
145			$self->make_ssl_write_watcher ($err2 == 2 ? 'r' : 'w');
146			return;
147			}
148
149			if ($! != Errno::EAGAIN
150			or my $err = Net::SSLeay::ERR_get_error) {
151
152	elmex	1.5	$self->disconnect (
153	elmex	1.1	sprintf (
154			"Error while writing from server '$self->{host}:$self->{port}': (%d\|%s\|%s)",
155			$err2, (Net::SSLeay::ERR_error_string $err), "$!")
156			);
157			return;
158			}
159			}
160			} else {
161	elmex	1.2	$self->debug_wrote_data (substr $self->{write_buffer}, 0, $l);
162			$self->{write_buffer} = substr $self->{write_buffer}, $l;
163			if (length ($self->{write_buffer}) <= 0) {
164			delete $self->{w};
165			}
166	elmex	1.1	}
167			}
168
169			sub try_ssl_read {
170			my ($self) = @_;
171	elmex	1.2	my $r = Net::SSLeay::read ($self->{ssl});
172
173			if (defined $r) {
174	elmex	1.7	if ($r eq '') {
175			if (my $err = Net::SSLeay::ERR_get_error) {
176			$self->disconnect (
177			sprintf (
178			"Error while reading from server '$self->{host}:$self->{port}':"
179			."(%s\|%s)",
180			(Net::SSLeay::ERR_error_string $err), "$!")
181			);
182			return;
183			}
184			# is this right? $r = '' => EOF? sucky Net::SSLeay... arg...
185			$self->disconnect ("EOF from server '$self->{host}:$self->{port}'.");
186			return;
187			}
188
189	elmex	1.2	$self->{read_buffer} .= decode_utf8 ($r);
190			$self->handle_data (\$self->{read_buffer});
191			} else {
192	elmex	1.7	my $err2 = Net::SSLeay::get_error $self->{ssl}, $r;
193	elmex	1.2	if ($err2 == 2 \|\| $err2 == 3) {
194	elmex	1.6	#d# warn "READ RETRY $err2\n";
195	elmex	1.2	delete $self->{r};
196			$self->make_ssl_read_watcher ($err2 == 2 ? 'r' : 'w');
197			return;
198			}
199
200			if ($! != Errno::EAGAIN
201			or my $err = Net::SSLeay::ERR_get_error) {
202	elmex	1.1
203	elmex	1.5	$self->disconnect (
204	elmex	1.2	sprintf (
205			"Error while reading from server '$self->{host}:$self->{port}':"
206			."(%d\|%s\|%s)",
207			$err2, (Net::SSLeay::ERR_error_string $err), "$!")
208			);
209	elmex	1.1	return;
210			}
211			}
212			}
213
214			sub write_data {
215			my ($self, $data) = @_;
216			#return unless $self->{r};
217
218			my $cl = $self->{socket};
219	elmex	1.4	$self->{write_buffer} .= encode_utf8 ($data);
220	elmex	1.1
221			unless ($self->{w}) {
222	elmex	1.2	$self->{w} =
223			AnyEvent->io (poll => 'w', fh => $cl, cb => sub {
224			if (not $self->{ssl_enabled}) {
225	elmex	1.1	if (my $data = $self->{write_buffer}) {
226	elmex	1.10	$data = substr $data, 0, $self->{max_write_length};
227	elmex	1.1	my $len = syswrite $cl, $data;
228			unless ($len) {
229			return if $! == Errno::EAGAIN;
230			if (not defined $len) {
231			warn "error when writing data on $self->{host}:$self->{port}: $!";
232			return;
233			} else {
234			delete $self->{w};
235			}
236			}
237
238			if ($len == length $self->{write_buffer}) {
239			delete $self->{w};
240			}
241
242			$self->debug_wrote_data (substr $self->{write_buffer}, 0, $len);
243			$self->{write_buffer} = substr $self->{write_buffer}, $len;
244			}
245	elmex	1.2	} else {
246			$self->try_ssl_write;
247			}
248			});
249			}
250			}
251
252			sub make_ssl_read_watcher {
253			my ($self, $poll) = @_;
254			return if $self->{r};
255	elmex	1.1
256	elmex	1.2	$poll \|\|= 'r';
257			$self->{r} =
258			AnyEvent->io (poll => $poll, fh => $self->{socket}, cb => sub {
259			$self->try_ssl_read;
260			});
261			}
262
263			sub make_ssl_write_watcher {
264			my ($self, $poll) = @_;
265			return if $self->{w};
266
267			$poll \|\|= 'w';
268			$self->{w} =
269			AnyEvent->io (poll => $poll, fh => $self->{socket}, cb => sub {
270			$self->try_ssl_write;
271			});
272	elmex	1.1	}
273
274			sub enable_ssl {
275			my ($self) = @_;
276
277			$Net::SSLeay::ssl_version = 10; # Insist on TLSv1
278
279			$self->{ssl_enabled} = 1;
280
281	elmex	1.3	#d# warn "START TLS!\n";
282	elmex	1.1
283			$self->{r} = undef;
284			$self->{w} = undef;
285
286			$self->{ctx} = Net::SSLeay::CTX_new ();
287	elmex	1.3
288	elmex	1.2	# enable SSL_MODE_ENABLE_PARTIAL_WRITE and SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER
289			Net::SSLeay::CTX_set_mode($self->{ctx}, 1 \| 2);
290	elmex	1.3
291	elmex	1.1	$self->{ssl} = Net::SSLeay::new ($self->{ctx});
292
293			Net::SSLeay::set_fd ($self->{ssl}, fileno $self->{socket});
294			#d# warn "CONNECT\n";
295			Net::SSLeay::connect $self->{ssl};
296			#d# warn "CONNECT END\n";
297			binmode $self->{socket}, ":bytes";
298
299			$self->{ssl_read_data} = "";
300			$self->make_ssl_read_watcher;
301			}
302
303	elmex	1.5	sub disconnect {
304			my ($self, $msg) = @_;
305			$self->end_sockets;
306			$self->{disconnect_cb}->($self->{host}, $self->{port}, $msg);
307			}
308
309	elmex	1.1	1;