File Coverage

blib/lib/IPChains/PortFW.pm

Criterion	Covered	Total	%
statement	20	86	23.2
branch	1	52	1.9
condition	1	9	11.1
subroutine	6	13	46.1
pod	7	8	87.5
total	35	168	20.8

#
#    PortFW.pm - Perl module to interface with ipmasqadm portfw command.
#
#    This file is part of Fwctl.
#
#    Author: Francis J. Lacoste
#
#    Copyright (C) 1999,2000 iNsu Innovations Inc.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
package IPChains::PortFW;

use strict;

use Carp;
use Symbol;

use vars qw( $VERSION $IPMASQADM );

BEGIN {

  ($VERSION) = '$Revision: 1.4 $' =~ /Revision: ([0-9.]+)/;

}

my %VALID_OPTIONS = map { $_ => 1 } qw( LocalAddr LocalPort RemAddr RemPort
					Proto Pref
					);

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %args = @_;
    my $self = { };

    # Look for ipmasqadm
    my ($path) = grep { -x "$_/ipmasqadm" } split /:/, "/sbin:/bin:/usr/sbin:/usr/bin:$ENV{PATH}";
    die ( "Couldn't find ipmasqadm in PATH ($ENV{PATH})\n" ) unless $path;
    $self->{ipmasqadm} = "$path/ipmasqadm";

    bless $self, $class;

    while ( my ($key,$value) = each %args ) {
	$self->attribute( $key, $value );
    }

    $self;
}

sub attribute {
    my ($self,$key,$value) = @_;

    if ( @_ == 3 ) {
	if ( $VALID_OPTIONS{$key} ) {
	    $self->{$key} = $value;
	} else {
	    carp "Unknown option : $key";
	}
    }

    return $self->{$key};
}

sub clopts {
    my ( $self ) = shift;

    foreach my $key ( keys %VALID_OPTIONS ) {
	delete $self->{$key};
    }
}

sub run_portfw {
    my ( $self, @args ) = @_;

    my ($r_fh,$w_fh) = (gensym,gensym);
    pipe $r_fh, $w_fh
      or die "can't pipe: $!\n";

    my $pid = fork;
    die "can't fork: $!\n" unless defined $pid;

    if ( $pid ) {
	# Don't need this one
	close $w_fh;

	# Collect STDOUT and STDERR
	my $output;
	while ( my $line = <$r_fh> ) {
	    $output .= $line;
	}

	# Collect exit status
	waitpid $pid,0;

	die "ipmasq exit with non zero status:\n$output\n" if $?;

	$output;
    } else {
	# Don't need this one
	close $r_fh;

	# Redirect STDOUT and STDERR to parent
	open ( STDOUT, ">&" . fileno $w_fh )
	  or die "can't redirect STDOUT to proper pipe: $!\n";
	open ( STDERR, ">&" . fileno $w_fh )
	  or die "can't redirect STDERR to proper output fd: $!\n";
	exec( $self->{ipmasqadm}, "portfw", @args )
	  or die "can't exec ipmasqadm: $!";
    }
}

sub append {
    my ( $self ) = shift;

    my @args = ( "-a" );
    croak "missing protocol"	    unless exists $self->{Proto};
    croak "invalid protocol"	    unless $self->{Proto} =~ /udp|tcp|6|17/i;
    croak "missing local address"   unless exists $self->{LocalAddr};
    croak "missing local port"	    unless exists $self->{LocalPort};
    croak "missing remote address"  unless exists $self->{RemAddr};
    croak "missing remote port"	    unless exists $self->{RemPort};
    if ( exists $self->{Pref} ) {
	croak "invalid preference"  unless $self->{Pref} =~ /\d+/ &&
					   $self->{Pref} >= 0;
    }

    push @args, "-P", lc $self->{Proto}, "-L", $self->{LocalAddr},
      $self->{LocalPort}, "-R", $self->{RemAddr}, $self->{RemPort};
    push @args, "-p", $self->{Pref} if exists $self->{Pref};

    $self->run_portfw( @args );
}

sub delete {
    my ( $self ) = shift;

    my @args = ( "-d" );
    croak "missing protocol"	    unless exists $self->{Proto};
    croak "invalid protocol"	    unless $self->{Proto} =~ /udp|tcp|6|17/i;
    croak "missing local address"   unless exists $self->{LocalAddr};
    croak "missing local port"	    unless exists $self->{LocalPort};

    push @args, "-P", lc $self->{Proto}, "-L", $self->{LocalAddr},
      $self->{LocalPort};
    push @args, "-R", $self->{RemAddr}, $self->{RemPort}
      if exists $self->{RemAddr};

    $self->run_portfw( @args );

}

sub flush {
    $_[0]->run_portfw( "-f" );
}

sub list {
    my ($self, $use_dns) = @_;

    my @args = ( "-l" );
    push @args, "-n" unless defined $use_dns && $use_dns;

    my $output = $self->run_portfw( @args );
    return () unless defined $output;

    # Parse output
    my @lines = split /\n/, $output;

    # Skip header line
    shift @lines;

    my @rules = ();
    foreach my $line ( @lines ) {
	my ( $prot, $laddr, $raddr, $lport, $rport, $ignored, $pref ) =
	  split / +/, $line;
	push @rules, $self->new( Proto	    => lc $prot,
				  LocalAddr => $laddr,
				  RemAddr   => $raddr,
				  LocalPort => $lport,
				  RemPort   => $rport,
				);
    }

    @rules;
}

1;

__END__