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;