SubProcBackChannel.pm [plain text]
package Mail::SpamAssassin::SubProcBackChannel;
use strict;
use warnings;
use bytes;
use IO::Socket;
use Mail::SpamAssassin::Util;
use Mail::SpamAssassin::Constants qw(:sa);
use vars qw {
};
my @ISA = qw();
=head1 NAME
Mail::SpamAssassin::SubProcBackChannel - back-channel for communication between a master and multiple slave processes
=head1 METHODS
=over 4
=cut
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = shift;
if (!defined $self) { $self = { }; }
bless ($self, $class);
$self->{kids} = { };
$self->{fileno_to_fh} = { };
$self;
}
sub set_selector {
my ($self, $sel) = @_;
$self->{selector} = $sel;
}
sub setup_backchannel_parent_pre_fork {
my ($self) = @_;
my $io = IO::Socket->new();
($self->{latest_kid_fh}, $self->{parent}) =
$io->socketpair(AF_UNIX,SOCK_STREAM,PF_UNSPEC)
or die "backchannel: socketpair failed: $!";
$self->{parent}->blocking(0)
or die "backchannel: set non-blocking failed: $!";
$self->{latest_kid_fh}->blocking(0)
or die "backchannel: set non-blocking failed: $!";
}
sub setup_backchannel_parent_post_fork {
my ($self, $pid) = @_;
my $fh = $self->{latest_kid_fh};
close $self->{parent};
my ($old) = select($fh);
$|++;
select($old);
$self->{kids}->{$pid} = $fh;
$self->add_to_selector($fh);
}
sub add_to_selector {
my ($self, $fh) = @_;
if (!defined $fh) {
warn "undef fh in add_to_selector"; return;
}
my $fno = fileno($fh);
$self->{fileno_to_fh}->{$fno} = $fh;
vec (${$self->{selector}}, $fno, 1) = 1;
}
sub remove_from_selector {
my ($self, $fh) = @_;
if (!defined $fh) {
warn "undef fh in remove_from_selector"; return;
}
my $fno = fileno($fh);
delete $self->{fileno_to_fh}->{$fno};
vec (${$self->{selector}}, $fno, 1) = 0;
}
sub select_vec_to_fh_list {
my ($self, $vec) = @_;
my $i = -1;
return grep {
defined
} map {
$i++;
($_ ? $self->{fileno_to_fh}->{$i} : undef);
} split (//, unpack ("b*", $vec));
}
sub get_socket_for_child {
my ($self, $pid) = @_;
return $self->{kids}->{$pid};
}
sub delete_socket_for_child {
my ($self, $pid) = @_;
delete $self->{kids}->{$pid};
}
sub setup_backchannel_child_post_fork {
my ($self) = @_;
close $self->{latest_kid_fh};
my $old = select($self->{parent});
$| = 1; select($old);
}
sub get_parent_socket {
my ($self) = @_;
return $self->{parent};
}
1;
__END__
=back
=head1 SEE ALSO
C<Mail::SpamAssassin>
C<Mail::SpamAssassin::ArchiveIterator>
C<Mail::SpamAssassin::SpamdPreforkScaling>
C<spamassassin>
C<spamd>
C<mass-check>