1
package ProtoWrap;
# CLASS ProtoWrap
#
# Class attributes:
#
# REQUIRED:
# listenPort - Port on which it should listen (if standalone
# == 1)
# destAddr - Wrapped server's IP address (if destType eq 'ip')
# destPort - Wrapped server's destination port (if destType
# eq 'ip')
# pipeCmd - Command to pipe communication to (if destType eq
# 'pipe')
#
# OPTIONAL:
# standalone - True if ProtoWrap will act in standalone mode.
# False if it is to be called by inetd. Defaults to
# true.
# destType - The type of connection to be opened to the server.
# 'ip' for IP connections, 'pipe' for pipes opened to
# Unix commands. Defaults to 'ip'.
# maxLineLength - Maximum line length allowed. Setting it to
# zero disables checking. Defaults to 200.
# logLevel - Logging detail (0=none, 3=extra-verbose)
# Defaults to 2.
# testLine - Reference to the function that will test each line
# recieved from the client. If undefined, a default
# testLine function is provided.
# testReply - Whether the data recieved from the server should
# be checked (1) or only the data generated at the
# client (0). Defaults to 0.
# logName - The service name to write to syslog with. If not
# supplied, defaults to 'ProtoWrap'.
# setUidTo - Which user ID should the wrapper run as (numeric).
# Defaults to current UID. Will not allow 0 (root).
# runSrvSuid - Whether to run the server program as root (1) or
# to drop privileges just after acquired the
# listening port (0). Defaults to 0.
# Useful only if running with standalone=1 and
# destType='pipe', ignored otherwise.
#
# GENERATED BY THE OBJECT:
# pid - PID of process handling the wrapper
# srcPort - Source port of the incomming connection
# srcIpAddr - Source IP address of the incomming connection
# srcName - Name of the remote host (resolved from srcIpAddr)
# Class public methods:
#
# new - creates a new ProtoWrap. Takes as argument a hash containing
# the attributes and associated values for this wrapper
# object.
# If the object was not successfully created, returns undef.
# getProp - returns a hash with the wrapper object's attributes.
# set_maxLineLength - Modifies the maximum line length allowed for
# client to server communication
# set_logLevel - Modifies the detail of logging to be done
# startServer - Starts the wrapper server for this particular
# instance
# stopServer - Stops the wrapper server for this particular
# instance
# version - Returns ProtoWrap's version
use strict;
use IO::Handle;
use IO::Socket;
use IO::Select;
use IPC::Open2;
use POSIX qw(:sys_wait_h :signal_h);
use Sys::Syslog qw(:DEFAULT setlogsock);
$SIG{CHLD} = 'IGNORE';
$^W=1;
sub new {
my $class = shift;
my $self = { @_ };
bless $self, $class;
my (%needed,@optional,@destTypes,%userParams);
# Test that all needed attributes are given, give the
# default values to the optional values which were not
# filled in, and check for the correct destination type
# (IP or pipe).
@destTypes = qw(ip pipe);
$needed{ip} = ['destAddr', 'destPort'];
$needed{pipe} = ['pipeCmd'];
@optional = qw(standalone logLevel testLine maxLineLength
destType testReply logName setUidTo runSrvSuid);
foreach (@optional) {
if ($_ eq 'destType') {
$self->{$_} = 'ip' unless defined $self->{$_};
} elsif ($_ eq 'standalone') {
$self->{$_} = 1 unless defined $self->{$_};
} elsif ($_ eq 'logLevel') {
$self->{$_} = 2 unless defined $self->{$_};
} elsif ($_ eq 'testLine') {
$self->{$_} = \&defaultTestLine unless defined $self->{$_};
} elsif ($_ eq 'maxLineLength') {
$self->{$_} = 200 unless defined $self->{$_};
} elsif ($_ eq 'testReply') {
$self->{$_} = 0 unless defined $self->{$_};
} elsif ($_ eq 'logName') {
$self->{$_} = 'ProtoWrap' unless defined $self->{$_};
} elsif ($_ eq 'setUidTo') {
$self->{$_} = $> unless defined $self->{$_};
} elsif ($_ eq 'runSrvSuid') {
$self->{$_} = 0 unless defined $self->{$_};
} else {
# We should never hit this spot...
# If we do, we'd better die.
die "Unexpected optional parameter $_";
}
}
setlogsock('unix');
openlog($self->{logName},'cons,pid','ProtoWrap');
push (@{$needed{$self->{destType}}},'listenPort') if ($self->{standalone});
foreach (@{$needed{$self->{destType}}}) {
if (not defined($self->{$_})) {
$self->log (0,"$_ is a required parameter and was not supplied. ".
'ProtoWrap not started.');
return undef;
}
}
# Check if wrapper is being run as root. If so, refuse to
# continue if setUidTo is not set. We do not switch to a
# normal user yet - Root may be needed to listen on a low
# port or to run the server program.
if ($> == 0 && $self->{setUidTo} == 0) {
$self->log (0,'Refusing to start - Running as root and setUidTo is not set');
return undef;
}
# If a UID change is expected and we are not root, we
# will fail later on - It is better to fail early.
if ($> != $self->{setUidTo} && $> != 0) {
$self->log (0,"Regular user (uid $>) will not be able to set UID to ".
$self->{setUidTo});
return undef;
}
# runSrvSuid is set to 0 (drop privileges as soon as possible
# unless standalone=1 and destType='pipe'
$self->{runSrvSuid} = 0 unless ($self->{standalone} == 1 &&
$self->{destType} eq 'pipe');
# We now check if there are any unexpected arguments
# supplied by the user.
# If so, we refuse to create the object and return undefined.
%userParams = $self->getProp;
foreach (@optional,@{$needed{$self->{destType}}}) {
delete $userParams{$_};
}
if (keys(%userParams)) {
$self->log (0,'Unexpected parameters: '.join (', ',keys(%userParams)).
' - Refusing to continue.');
return undef;
}
return $self;
}
sub DESTROY {
my $self = shift;
close $self->{listSock} if defined($self->{listSock});
}
sub set_maxLineLength {
$_[0]->{maxLineLength} = $_[1];
}
sub set_logLevel {
$_[0]->{logLevel} = $_[1];
}
sub getProp {
return %{$_[0]};
}
sub startServer {
my $self = shift;
my ($error,$child);
$error=0;
if ($self->{standalone} == 1) {
$self->{listSock} = IO::Socket::INET->new(
LocalPort => $self->{listenPort},
Type => SOCK_STREAM,
Reuse => 1,
Listen => 10)
or $self->log(0,"Couldn't be a TCP server on port $self->{listenPort}") &&
($error = 1);
return undef if $error;
$self->log(0,"Can't fork to accept incoming connections!: $@ $!") if
(!defined($child=fork()));
# If runSrvSuid is 0, we can drop privileges right now,
# before any forking takes place
# Check if UID change succeeded, and die otherwise.
if ($self->{runSrvSuid} == 0) {
$> = $self->{setUidTo};
if ($> != $self->{setUidTo}) {
$self->log(0,"UID change failed! UID is still $>, should be ".
$self->{setUidTo}.
" - Aborting execution.");
die $self->{logName}.": UID change failed! UID is $>, should be ".
$self->{setUidTo};
} else {
$self->log(4,"UID changed - RUID: $<, EUID: $>, setUidTo ".
$self->{setUidTo});
}
}
if ($child == 0) {
# Child process - take care of the connection
$self->getConn();
} else {
# Parent process - return the child process' PID
$self->{pid} = $child;
}
} else {
$self->getConn();
}
}
sub stopServer {
my $self=shift;
$self->log(1,"Stopping server on port $self->{listenPort}");
close $self->{listSock};
kill ('TERM',$self->{pid});
# We clear the PID attribute - The user-given attributes are
# preserved in case the server is to be restarted or reused.
delete $self->{pid};
$self=undef;
}
sub getConn {
my $self = shift;
my ($cl_char, $src_conn, $child, $server_rd,$server_wr,
$src_iaddr,$read_handles, $fromclient, $fromserver);
while (my ($client_rd,$client_wr) = &getClient($self)) {
if (!defined $client_rd || !defined $client_wr) {
$self->log(0,'Error ocurred when setting up client connection - rd: '.
"$client_rd wr: $client_wr");
next;
}
if ($self->{standalone} == 1) {
# Standalone mode - Every recieved connection should get
# its own server
$self->log(0,"Can't fork to handle incoming client connection!: $@ $!") if
(!defined ($child=fork()));
} else {
# inetd mode - The forking is done by inetd, so we act as
# the child process
$child = 0;
}
if ($child == 0) {
# Child process - take care of the connection.
if ($self->{standalone} == 1) {
$src_conn=getpeername($client_rd);
($self->{srcPort},$src_iaddr)=unpack_sockaddr_in($src_conn);
$self->{srcIpAddr} = inet_ntoa($src_iaddr);
$self->{srcName} = gethostbyaddr($src_iaddr, AF_INET) ||
'---unresolvable---';
$self->log(1,'Connection recieved from '.$self->{srcName}.' ('.
$self->{srcIpAddr}.'), source port '.$self->{srcPort});
}
if ($self->{destType} eq 'ip') {
# IO::Socket:INET->new opens a bidirectional socket,
# so after assigning it to $server_rd, we assign
# $server_rd to $server_wr
$server_rd = IO::Socket::INET->new(
PeerAddr => $self->{destAddr},
PeerPort => $self->{destPort},
Proto => 'tcp',
Type => SOCK_STREAM) or die "$! - $@";
$server_wr = $server_rd;
$self->log(4,'Server answered');
} elsif ($self->{destType} eq 'pipe') {
my $cmdFile = $self->{pipeCmd};
# Get only the command name, without any arguments
$cmdFile =~ s/^(.+)\s.+$/$1/;
if (-x $cmdFile) {
# Clear any potentially dangerous enviroment variables
$ENV{PATH} = '/bin:/usr/bin';
$ENV{BASH_ENV} = '';
($server_rd,$server_wr) = (IO::Handle->new,IO::Handle->new);
open2($server_rd,$server_wr,$self->{pipeCmd});
} else {
$self->log(0,$cmdFile . ' has invalid permissions (execution).');
}
} else {
$self->log(0,'destType is not ip, is not pipe... What should I do with '.
$self->{destType}.'?');
}
# Server has started, we now set the UID to the low privilege
# user (if running as root). Check if UID change succeeded,
# and die otherwise.
$> = $self->{setUidTo};
if ($> != $self->{setUidTo}) {
$self->log(0,"UID change failed! UID is still $>, should be ".
$self->{setUidTo}." - Aborting execution.");
die $self->{logName}.": UID change failed! UID is $>, should be ".
$self->{setUidTo};
} else {
$self->log(4,"UID changed - RUID: $<, EUID: $>, setUidTo ".
$self->{setUidTo});
}
# IO::Select allows us to listen to many different
# filehandles (in this case, sockets) at once. We
# will listen to $client_rd and $server_rd.
$read_handles = IO::Select->new($client_rd,$server_rd);
$self->log(4,"client: $client_rd $client_wr, server: $server_rd $server_wr");
while (1) {
my @readable;
@readable = $read_handles->can_read();
$self->log(0,"Error in select $!") unless @readable;
foreach my $sock (@readable) {
my ($buff,$testResult);
if ($sock eq $client_rd) {
my $readed = sysread($client_rd,$buff,4096);
unless($readed) {
close $client_rd;
close $client_wr;
close $server_rd;
close $server_wr;
$self->log(3,'Closing communication with client '.
$self->{srcName}.' ('.$self->{srcIpAddr}.
') port '.$self->{srcPort});
exit 0;
}
$fromclient .= $buff;
while((my $idx = index($fromclient,"\n")) != -1) {
my ($cl_line,$tmp_cl_line);
$cl_line = substr($fromclient,0,$idx+1,'');
# $cl_line can be modified by the
# testing function. $tmp_cl_line
# should be used for logging.
$tmp_cl_line = $cl_line;
# We test the line. If the test
# returns 0, we should not send
# the line to the server. We pass the
# client socket so error messages can
# be reported back directly from the
# routine.
#
# A negative return value indicates
# the line was handled by the
# routine, and we can ignore it.
$testResult = $self->{testLine}->($self,\$cl_line,
$client_wr,0);
if ($testResult > 0) {
# Positive value - success
#
# \n at end of line could have
# been chopped at testLine, so
# append it if needed.
$cl_line .= "\n" if (index($cl_line,"\n") == 1);
$server_wr->print($cl_line);
$self->log(5,"From client: $cl_line");
} elsif ($testResult == 0) {
# Zero returned - failure
$self->log(1,'Line test failed');
$self->log(2,"Offending line: $tmp_cl_line");
} elsif ($testResult < 0) {
# Negative value - handled by
# test routine
$self->log(3,"Handled by wrapper: $tmp_cl_line");
}
}
} elsif ($sock eq $server_rd) {
my $readed = sysread($server_rd,$buff,4096);
unless($readed) {
close $client_rd;
close $client_wr;
close $server_rd;
close $server_wr;
my $string = 'Closing communication with client';
$string .= ' '.$self->{srcName} if defined $self->{srcName};
$string .= ' ('.$self->{srcIpAddr}.')' if
defined $self->{srcIpAddr};
$string .= ' port '.$self->{srcPort} if
defined $self->{srcPort};
$self->log(2,$string);
exit 0;
}
$fromserver .= $buff;
while((my $idx = index($fromserver,"\n")) != -1) {
my $sr_line = substr($fromserver,0,$idx+1,'');
if ($self->{testReply}) {
$testResult = $self->{testLine}->($self,\$sr_line,
$server_wr,1);
}
$client_wr->print($sr_line);
$self->log(5,"From SERVER: $sr_line");
}
} else {
$self->log(0,"Something happened - $sock not client nor server!");
exit 0;
}
}
}
} else {
# Parent process - Clear $client_rd and $client_wr (they will
# be handled only by the child process) and wait for more
# incoming connections
$client_rd = $client_wr = undef;
}
}
}
sub getClient {
my ($self,$conn_rd,$conn_wr);
$self=shift;
if ($self->{standalone} == 1) {
# Standalone mode - We wait for a connection and then return
# two references to the connection (the same object, to be used
# for reading and writing)
$conn_rd = $conn_wr = $self->{listSock}->accept();
} elsif ($self->{standalone} == 0) {
# inetd mode - I/O will be carried using STDIN/STDOUT, so we
# reference the filehandles.
$|=1;
$conn_rd = *STDIN;
$conn_wr = *STDOUT;
} else {
# We should never hit this spot
$self->log(0,'Invalid value for standalone: '.$self->{standalone}.
'. Unable to process connections.');
}
return ($conn_rd,$conn_wr);
}
sub defaultTestLine {
# $line holds a reference to the line to be processed
# $socket holds the socket from which the line came
# $who indicates whether the line should be treated as a
# client-originated line (0, strict) or as a
# server-originated line (1, loose).
# We return 0 if the test failed and we want ProtoWrap to issue an
# error, a positive value if the test succeeded, and a
# negative value if the answer was handled by the client and
# we do not want ProtoWrap to pass it on.
my($self,$line,$socket,$who) = @_;
if (length($$line) > $self->{maxLineLength} && $self->{maxLineLength} > 0) {
$$line = substr($$line,0,$self->{maxLineLength});
$self->log(1,"Line too long\nChopping to:\n$$line");
}
return 1;
}
sub log {
my($self,$level,$data,$appendTxt)=@_;
# warn "$data\n" if $level <= $self->{logLevel};
$data =~ s/[\r\n]//;
$appendTxt = '- stage '.$self->{stage} if (defined $self->{stage});
if ($level == 0) {
syslog('err',"error: $data $appendTxt");
} elsif ($level == 1) {
syslog('info',"info: $data $appendTxt") if ($self->{logLevel} >= 1);
} elsif ($level == 2) {
syslog('notice',"notice: $data $appendTxt") if ($self->{logLevel} >= 2);
} elsif ($level == 3) {
syslog('debug',"debug: $data $appendTxt") if ($self->{logLevel} >= 3);
} elsif ($level == 4) {
syslog('debug',"debug: $data $appendTxt") if ($self->{logLevel} >= 4);
} elsif ($level >= 5) {
syslog('debug',"debug: $data $appendTxt") if ($self->{logLevel} >= 5);
} else {
# Better to be too verbose and not too terse
# if unsure about log level desired
syslog('debug',"debug: $data $appendTxt");
}
}
sub version {
return '0.5';
}
1;