Net/XMPP2/SimpleConnection.pm

package Net::XMPP2::SimpleConnection;
use IO::Socket::INET;
use Errno;
use Fcntl;
use Encode;
use Net::SSLeay;

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

=head1 NAME

Net::XMPP2::SimpleConnection - A 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>.

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = { disconnect_cb => sub {}, @_ };
   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->{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, ":utf8";

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

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

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

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

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

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

   print "er: ".Net::SSLeay::BIO_should_retry (Net::SSLeay::get_rbio ($self->{ssl}));
   print " ew: ".Net::SSLeay::BIO_should_retry (Net::SSLeay::get_wbio ($self->{ssl}));
   print " rr: ".Net::SSLeay::BIO_should_read (Net::SSLeay::get_rbio ($self->{ssl}));
   print " rw: ".Net::SSLeay::BIO_should_read (Net::SSLeay::get_wbio ($self->{ssl}));
   print " wr: ".Net::SSLeay::BIO_should_write (Net::SSLeay::get_rbio ($self->{ssl}));
   print " ww: ".Net::SSLeay::BIO_should_write (Net::SSLeay::get_wbio ($self->{ssl}))."\n";

   my $e = Net::SSLeay::BIO_should_retry (Net::SSLeay::get_wbio ($self->{ssl}))
           | Net::SSLeay::BIO_should_retry (Net::SSLeay::get_wbio ($self->{ssl}));
   my $w = Net::SSLeay::BIO_should_read (Net::SSLeay::get_wbio ($self->{ssl}))
           | Net::SSLeay::BIO_should_write (Net::SSLeay::get_wbio ($self->{ssl}));
   my $r = Net::SSLeay::BIO_should_read (Net::SSLeay::get_rbio ($self->{ssl}))
           | Net::SSLeay::BIO_should_write (Net::SSLeay::get_rbio ($self->{ssl}));

   print "TEST:$e $w $r\n";
 #  delete $self->{r};
 #  delete $self->{w};
 #  if ($w) { $self->make_ssl_write_watcher }
 #  if ($r) { $self->make_ssl_read_watcher }
 #  unless ($e) {
 #     $self->make_ssl_read_watcher;
 #     $self->make_ssl_write_watcher;
 #  }
}

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

   unless ($self->{ssl_out_buffer}) { # refill buffer
      $self->{ssl_out_buffer} = $self->{write_buffer};
      $self->{write_buffer} = "";
   }

   unless ($self->{ssl_out_buffer}) {
      delete $self->{w};
      return;
   }

   my $l = Net::SSLeay::write_nb ($self->{ssl},
              $self->{ssl_out_buffer}, length ($self->{ssl_out_buffer}));

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

      } else {
         my $err2 = Net::SSLeay::get_error $self->{ssl}, $l;
         #d# warn "write err[$err2]\n"; $self->dumpbio;
         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_cb}->($self->{host}, $self->{port},
               sprintf (
                  "Error while writing from server '$self->{host}:$self->{port}': (%d|%s|%s)",
               $err2, (Net::SSLeay::ERR_error_string $err), "$!")
            );
            $self->end_sockets;
            return;
         }
      }
      $self->make_ssl_read_watcher;
      return;
   } else {
      $self->debug_wrote_data (substr $self->{ssl_out_buffer}, 0, $l);
      $self->{ssl_out_buffer} = substr $self->{ssl_out_buffer}, $l;
   }
}

sub try_ssl_read {
   my ($self) = @_;
   my $l = Net::SSLeay::read_nb ($self->{ssl}, $self->{ssl_read_data});

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

      } else {
         my $err2 = Net::SSLeay::get_error $self->{ssl}, $l;
         #d# warn "read err[$err2]\n"; $self->dumpbio;
         if ($err2 == 2 || $err2 == 3) {
            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_cb}->($self->{host}, $self->{port},
               sprintf (
                  "Error while reading from server '$self->{host}:$self->{port}':"
                  ."(%d|%s|%s)",
                  $err2, (Net::SSLeay::ERR_error_string $err), "$!")
            );
            $self->end_sockets;
            return;
         }
      }
   } else {
      $self->{read_buffer} .= decode_utf8 ($self->{ssl_read_data});
      $self->handle_data (\$self->{read_buffer});
      $self->{ssl_read_data} = "";
   }

}

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 {
         #d# warn "read cb [$poll]\n";
         $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 {
         #warn "write cb [$poll]\n";
         $self->try_ssl_write;
         1;
      });
}

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

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

   unless ($self->{w}) {
      if (not $self->{ssl_enabled}) {
         $self->{w} =
            AnyEvent->io (poll => 'w', fh => $cl, cb => sub {
               if (my $data = $self->{write_buffer}) {
                  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 {
         unless ($self->{ssl_out_buffer}) {
            $self->{ssl_out_buffer} = encode_utf8 ($self->{write_buffer});
            $self->{write_buffer} = "";
            $self->make_ssl_write_watcher;
         }
      }
   }
}

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

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

   $self->{ssl_enabled} = 1;

   warn "START TLS!\n";

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

   $self->{ctx} = Net::SSLeay::CTX_new ();
   Net::SSLeay::CTX_set_mode($self->{ctx}, 1);
   $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;
}

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