ipc.pm

linux集群服务器软件代码包

package heartbeat::clplumbing::ipc;

use 5.008001;
use strict;
use warnings;
use Carp qw(croak);
use heartbeat::cl_raw;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

our @EXPORT_OK = ( );

our @EXPORT = qw(
	$IPC_OK $IPC_FAIL $IPC_BROKEN $IPC_INTR
	$IPC_CONNECT $IPC_WAIT $IPC_DISCONNECT $IPC_DISC_PENDING
);

our $VERSION = '0.01';

our $IPC_CONNECT = $heartbeat::cl_raw::IPC_CONNECT;
our $IPC_WAIT = $heartbeat::cl_raw::IPC_WAIT;
our $IPC_DISCONNECT = $heartbeat::cl_raw::IPC_DISCONNECT;
our $IPC_DISC_PENDING = $heartbeat::cl_raw::IPC_DISC_PENDING;
our $IPC_OK = $heartbeat::cl_raw::IPC_OK;
our $IPC_FAIL = $heartbeat::cl_raw::IPC_FAIL;
our $IPC_BROKEN = $heartbeat::cl_raw::IPC_BROKEN;
our $IPC_INTR = $heartbeat::cl_raw::IPC_INTR;

=head1 NAME

heartbeat::clplumbing::ipc - Perl extension for heartbeat IPC code

=head1 SYNOPSIS

=over

  use heartbeat::clplumbing::ipc;
  
  if ($rc == $IPC_CONNECT) ...
  
=back

=head1 DESCRIPTION

This module provides a wrapper for the heartbeat IPC code. It exports
the C<IPC_CONNECT, IPC_WAIT, IPC_DISCONNECT, IPC_DISC_PENDING> and
C<IPC_OK, IPC_FAIL, IPC_BROKEN, IPC_INTR> codes by default and provides
some more classes for easily dealing with the non-blocking IPC layer,
which are explained further below.

=cut

package heartbeat::clplumbing::ipc::message;

=head2 heartbeat::clplumbing::ipc::message

IPC_Message abstraction providing the basic functions of heartbeat
messages. Note that this cleans up after itself, ie messages are
automatically freed when they go out of scope.

=over

=item my $msg = heartbeat::clplumbing::ipc::message-E<gt>new($ch, $s);

Simply create a message with the scalar data provided; the length
attribute is automatically filled into the message.

You need to provide the message constructor with a
C<heartbeat::clplumbing::ipc::channel> reference to fully fill in the
lower level structures.

=item my $body = $msg-E<gt>body();

Returns the message body with a maximum size of the message length.

=item my $len = $msg-E<gt>len();

Returns the length of the message data. Probably not needed all that
often in Perl, as all data structures are dynamic anyway.

=back

=cut

use Carp qw(croak);

sub new {
	my ($class, $ch, $data) = @_;
	ref ($class) and croak "class name needed";
	ref($ch) or croak "Instance variable needed";
	UNIVERSAL::isa($ch, "heartbeat::clplumbing::ipc::channel")
		or croak "Wrong object type for argument, not an IPC channel";

	# By default, we assume we need to clean up after ourselves.
	my $self = { cleanup => 1, };
	
	$self->{raw} = heartbeat::cl_raw::ipc_msg_constructor(
		$ch->{raw},
		length($data), $data);
	
	bless $self, $class;

	return $self;
}

sub new_from_raw {
	my ($class, $msg) = @_;
	ref ($class) and croak "class name needed";
	
	$msg =~ /^_p_IPC_Message/o or 
		croak("Need to supply a raw IPC_Message reference!");
	
	# By default, we assume we need to clean up after ourselves.
	my $self = { cleanup => 1, };
	
	$self->{raw} = $msg;

	bless $self, $class;
	return $self;
}

sub body {
	my ($self) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::message")
		or croak "Wrong object type, not an IPC message";
	
	my $len = $self->len();
	my $data = heartbeat::cl_raw::ipc_msg_get_body($self->{raw});
	# Additional sanity checking for the message length:
	if (length($data) > $len) {
		$data = substr($data,0,$len);
	}
	return $data;
}

sub len {
	my ($self) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::message")
		or croak "Wrong object type, not an IPC message";
	
	return
	heartbeat::cl_rawc::IPC_MESSAGE_msg_len_get($self->{raw}); 
}

sub DESTROY {
	my ($self) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::message")
		or croak "Wrong object type, not an IPC message";

	if ($self->{'cleanup'} == 1) {
		heartbeat::cl_raw::ipc_msg_done($self->{raw});
	}
}

package heartbeat::clplumbing::ipc::auth;
use Carp qw(croak);

=head2 heartbeat::clplumbing::ipc::auth

Wrap the IPC_Auth functionality.

=over 

=item my $auth = heartbeat::clplumbing::ipc::auth-E<gt>new();

Construct a new IPC_Auth object, with an initially empty set of uid /
gid lists.

=cut

sub new {
	my ($class) = @_;
	ref ($class) and croak "class name needed";
	
	my $self = { };
	
	$self->{raw} = heartbeat::cl_raw::helper_create_auth();
	
	bless $self, $class;

	return $self;
}

=item $auth-E<gt>add_uid($uid);

Add the specified uid to the object.

The UID must be numeric.

=cut

sub add_uid {
	my ($self, $uid) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::auth")
		or croak "Wrong object type, not an IPC auth";
	
	if ($uid !~ /^\d+$/) {
		croak "add_uid called with non-integer uid!";
	}

	heartbeat::cl_raw::helper_add_auth_uid($self->{raw}, $uid);
}

=item $auth-E<gt>add_gid($uid);

Add the specified gid to the object.

The GID must be numeric.

=cut

sub add_gid {
	my ($self, $gid) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::auth")
		or croak "Wrong object type, not an IPC auth";
	
	if ($gid !~ /^\d+$/) {
		croak "add_gid called with non-integer uid!";
	}

	heartbeat::cl_raw::helper_add_auth_uid($self->{raw}, $gid);
}

sub DESTROY {
	my ($self) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::auth")
		or croak "Wrong object type, not an IPC auth";
	
	heartbeat::cl_raw::ipc_destroy_auth($self->{raw});

}

=back

=cut

package heartbeat::clplumbing::ipc::server;
use Carp qw(croak);

=head2 heartbeat::clplumbing::ipc::server

Wrap the IPC_WaitConnection functionality.

=over 

=item my $wc = heartbeat::clplumbing::ipc::server-E<gt>new($path);

Construct a new WaitConnection object of type Unix Domain Socket
listening on the given path.

=cut

sub new {
	my ($class, $path) = @_;
	ref ($class) and croak "class name needed";
	
	my $self = { };
	
	my $h = heartbeat::cl_raw::simple_hash_new();
	
	heartbeat::cl_raw::simple_hash_insert($h,
		$heartbeat::cl_raw::IPC_PATH_ATTR,
		$path);
	$self->{raw} = heartbeat::cl_raw::ipc_channel_constructor(
                $heartbeat::cl_raw::IPC_DOMAIN_SOCKET,$h);
	heartbeat::cl_raw::simple_hash_destroy($h);
	
	bless $self, $class;

	return $self;
}

=item my $fd = $wc-E<gt>get_select_fd();

Get the filehandle for the wait connection which can be used with
C<select()> to wait for incoming connections.

=cut
sub get_select_fd {
	my ($self) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::server")
		or croak "Wrong object type, not an IPC WaitConnection";

	return heartbeat::cl_raw::ipc_wc_get_select_fd($self->{raw});
}

=item my $ch = $wc-E<gt>accept_connection($auth);

Returns the C<heartbeat::clplumbing::ipc::channel> object for the
accepted connection, if the connection passed the authentication test.

C<$auth> must be a C<heartbeat::clplumbing::ipc::auth> object.

=cut

sub accept_connection {
	my ($self, $auth) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::server")
		or croak "Wrong object type, not an IPC WaitConnection";
	UNIVERSAL::isa($auth, "heartbeat::clplumbing::ipc::auth")
		or croak "Wrong object type, not an IPC Auth";

	my $raw_ch = heartbeat::cl_raw::ipc_wc_accept_connection($self->{raw}, $auth);
	
	if ($raw_ch) {
		return heartbeat::clplumbing::ipc::channel->new_from_raw($raw_ch);
	} else {
		return -1;
	}
}

sub DESTROY {
	my ($self, $auth) = @_;
	ref($self) or croak "Instance variable needed";
	UNIVERSAL::isa($self, "heartbeat::clplumbing::ipc::server")
		or croak "Wrong object type, not an IPC WaitConnection";

	heartbeat::clplumbing::ipc::ipc_wc_destroy($self->{raw});
}

=back

=cut

package heartbeat::clplumbing::ipc::channel;
use Carp qw(croak);

=head2 heartbeat::clplumbing::ipc::channel

IPC_Channel abstraction providing the basic functions of heartbeat
messages. Note that this cleans up after itself, ie messages are
automatically freed when they go out of scope.

=over

=cut

=item my $ch = heartbeat::clplumbing::ipc::channel-E<gt>new($path);