/usr/share/perl5/AnyEvent/XMPP/SimpleConnection.pm is in libanyevent-xmpp-perl 0.55-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | package AnyEvent::XMPP::SimpleConnection;
use strict;
no warnings;
use AnyEvent;
use IO::Handle;
use Encode;
use AnyEvent::Socket;
use AnyEvent::Handle;
=head1 NAME
AnyEvent::XMPP::SimpleConnection - Low level TCP/TLS connection
=head1 SYNOPSIS
package foo;
use AnyEvent::XMPP::SimpleConnection;
our @ISA = qw/AnyEvent::XMPP::SimpleConnection/;
=head1 DESCRIPTION
This module only implements the basic low level socket and SSL handling stuff.
It is used by L<AnyEvent::XMPP::Connection> and you shouldn't mess with it :-)
(NOTE: This is the part of AnyEvent::XMPP which I feel least confident about :-)
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {
disconnect_cb => sub {},
@_
};
bless $self, $class;
return $self;
}
sub connect {
my ($self, $host, $service, $timeout) = @_;
$self->{handle}
and return 1;
$self->{handle} = tcp_connect $host, $service, sub {
my ($fh, $peerhost, $peerport) = @_;
unless ($fh) {
$self->disconnect ("Couldn't create socket to $host:$service: $!");
return;
}
$self->{peer_host} = $peerhost;
$self->{peer_port} = $peerport;
binmode $fh, ":raw";
$self->{handle} =
AnyEvent::Handle->new (
fh => $fh,
on_eof => sub {
$self->disconnect ("EOF on connection to $self->{peer_host}:$self->{peer_port}: $!");
},
autocork => 1,
on_error => sub {
$self->disconnect ("Error on connection to $self->{peer_host}:$self->{peer_port}: $!");
},
on_read => sub {
my ($hdl) = @_;
my $data = $hdl->rbuf;
$hdl->rbuf = '';
$data = decode_utf8 $data;
$self->handle_data (\$data);
},
);
$self->connected
}, sub {
$timeout
};
return 1;
}
sub connected {
# subclass responsibility
}
sub send_buffer_empty {
# subclass responsibility
}
sub block_until_send_buffer_empty {
# subclass responsibility
}
sub debug_wrote_data {
# subclass responsibility
}
sub end_sockets {
my ($self) = @_;
delete $self->{handle};
}
sub write_data {
my ($self, $data) = @_;
$self->{handle}->push_write (encode_utf8 ($data));
$self->debug_wrote_data (encode_utf8 ($data));
$self->{handle}->on_drain (sub {
$self->send_buffer_empty;
});
}
sub enable_ssl {
my ($self) = @_;
$self->{handle}->starttls ('connect');
$self->{ssl_enabled} = 1;
}
sub disconnect {
my ($self, $msg) = @_;
$self->end_sockets;
$self->{disconnect_cb}->($self->{peer_host}, $self->{peer_port}, $msg);
$self->remove_all_callbacks;
}
1;
|