next up previous contents
Next: ProtoWrap/SMTP.pm Up: ProtoWrap program code Previous: Makefile.PL   Contents


ProtoWrap.pm

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;



Gunnar Wolf
2001-03-12