[ipfire-2.x.git] / html / cgi-bin / connections.cgi

#!/usr/bin/perl
#
# (c) 2001 Jack Beglinger <jackb_guppy@yahoo.com>
#
# (c) 2003 Dave Roberts <countzerouk@hotmail.com> - colour coded netfilter/iptables rewrite for 1.3
#
# (c) 2006 Franck - add sorting+filtering capability
#
# $Id: connections.cgi,v 1.6.2.12 2006/02/27 19:48:46 franck78 Exp $
#

# Setup GREEN, ORANGE, IPCOP, VPN CIDR networks, masklengths and colours only once

my @network=();
my @masklen=();
my @colour=();

use Net::IPv4Addr qw( :all );

use strict;

# enable only the following on debugging purpose
#use warnings;
#use CGI::Carp 'fatalsToBrowser';

require 'CONFIG_ROOT/general-functions.pl';
require "${General::swroot}/lang.pl";
require "${General::swroot}/header.pl";

#workaround to suppress a warning when a variable is used only once
my @dummy = ( ${Header::table1colour} );
undef (@dummy);

# Read various files

my %netsettings=();
&General::readhash("${General::swroot}/ethernet/settings", \%netsettings);

open (ACTIVE, "/proc/net/ip_conntrack") or die 'Unable to open ip_conntrack';
my @active = <ACTIVE>;
close (ACTIVE);

my @vpn = ('none');
open (ACTIVE, "/proc/net/ipsec_eroute") and @vpn = <ACTIVE>;
close (ACTIVE);

my $aliasfile = "${General::swroot}/ethernet/aliases";
open(ALIASES, $aliasfile) or die 'Unable to open aliases file.';
my @aliases = <ALIASES>;
close(ALIASES);

# Add Green Firewall Interface
push(@network, $netsettings{'GREEN_ADDRESS'});
push(@masklen, "255.255.255.255" );
push(@colour, ${Header::colourfw} );

# Add Green Network to Array
push(@network, $netsettings{'GREEN_NETADDRESS'});
push(@masklen, $netsettings{'GREEN_NETMASK'} );
push(@colour, ${Header::colourgreen} );

# Add Green Routes to Array
my @routes = `/sbin/route -n | /bin/grep $netsettings{'GREEN_DEV'}`;
foreach my $route (@routes) {
	chomp($route);
	my @temp = split(/[\t ]+/, $route);
	push(@network, $temp[0]);
	push(@masklen, $temp[2]);
	push(@colour, ${Header::colourgreen} );
}

# Add Firewall Localhost 127.0.0.1
push(@network, '127.0.0.1');
push(@masklen, '255.255.255.255' );
push(@colour, ${Header::colourfw} );

# Add Orange Network
if ($netsettings{'ORANGE_DEV'}) {
	push(@network, $netsettings{'ORANGE_NETADDRESS'});
	push(@masklen, $netsettings{'ORANGE_NETMASK'} );
	push(@colour, ${Header::colourorange} );
	# Add Orange Routes to Array
	@routes = `/sbin/route -n | /bin/grep $netsettings{'ORANGE_DEV'}`;
	foreach my $route (@routes) {
  		chomp($route);
		my @temp = split(/[\t ]+/, $route);
		push(@network, $temp[0]);
		push(@masklen, $temp[2]);
		push(@colour, ${Header::colourorange} );
	}
}

# Add Blue Network
if ($netsettings{'BLUE_DEV'}) {
	push(@network, $netsettings{'BLUE_NETADDRESS'});
	push(@masklen, $netsettings{'BLUE_NETMASK'} );
	push(@colour, ${Header::colourblue} );
	# Add Blue Routes to Array
	@routes = `/sbin/route -n | /bin/grep $netsettings{'BLUE_DEV'}`;
	foreach my $route (@routes) {
  		chomp($route);
		my @temp = split(/[\t ]+/, $route);
		push(@network, $temp[0]);
		push(@masklen, $temp[2]);
		push(@colour, ${Header::colourblue} );
	}
}

# Add STATIC RED aliases
if ($netsettings{'RED_DEV'}) {
	# We have a RED eth iface
	if ($netsettings{'RED_TYPE'} eq 'STATIC') {
		# We have a STATIC RED eth iface
		foreach my $line (@aliases)
		{
			chomp($line);
			my @temp = split(/\,/,$line);
			if ( $temp[0] ) {
				push(@network, $temp[0]);
				push(@masklen, $netsettings{'RED_NETMASK'} );
				push(@colour, ${Header::colourfw} );
			}
		}
	}
}

# Add VPNs
if ( $vpn[0] ne 'none' ) {
	foreach my $line (@vpn) {
		my @temp = split(/[\t ]+/,$line);
		my @temp1 = split(/[\/:]+/,$temp[3]);
		push(@network, $temp1[0]);
		push(@masklen, ipv4_cidr2msk($temp1[1]));
		push(@colour, ${Header::colourvpn} );
	}
}
if (open(IP, "${General::swroot}/red/local-ipaddress")) {
	my $redip = <IP>;
	close(IP);
	chomp $redip;
	push(@network, $redip);
	push(@masklen, '255.255.255.255' );
	push(@colour, ${Header::colourfw} );
}


#Establish simple filtering&sorting boxes on top of table

our %cgiparams;
&Header::getcgihash(\%cgiparams);

my @list_proto = ($Lang::tr{'all'}, 'icmp', 'udp', 'tcp');
my @list_state = ($Lang::tr{'all'}, 'SYN_SENT', 'SYN_RECV', 'ESTABLISHED', 'FIN_WAIT',
		    'CLOSE_WAIT', 'LAST_ACK', 'TIME_WAIT', 'CLOSE', 'LISTEN');
my @list_mark = ($Lang::tr{'all'}, '[ASSURED]', '[UNREPLIED]');
my @list_sort = ('orgsip','protocol', 'expires', 'status', 'orgdip', 'orgsp',
		    'orgdp', 'exsip', 'exdip', 'exsp', 'exdp');

# init or silently correct unknown value...
if ( ! grep ( /^$cgiparams{'SEE_PROTO'}$/ , @list_proto )) { $cgiparams{'SEE_PROTO'} = $list_proto[0] };
if ( ! grep ( /^$cgiparams{'SEE_STATE'}$/ , @list_state )) { $cgiparams{'SEE_STATE'} = $list_state[0] };
if ( ! grep ( /^$cgiparams{'SEE_MARK'}$/  , @list_mark ))  { $cgiparams{'SEE_MARK'}  = $list_mark[0] };
if ( ! grep ( /^$cgiparams{'SEE_SORT'}$/  , @list_sort ))  { $cgiparams{'SEE_SORT'}  = $list_sort[0] };
# *.*.*.* or a valid IP
if ( $cgiparams{'SEE_SRC'}  !~ /^(\*\.\*\.\*\.\*\.|\d+\.\d+\.\d+\.\d+)$/) {  $cgiparams{'SEE_SRC'} = '*.*.*.*' };
if ( $cgiparams{'SEE_DEST'} !~ /^(\*\.\*\.\*\.\*\.|\d+\.\d+\.\d+\.\d+)$/) {  $cgiparams{'SEE_DEST'} = '*.*.*.*' };


our %entries = ();	# will hold the lines analyzed correctly
my $unknownlines = '';	# should be empty all the time...
my $index = 0;		# just a counter to make unique entryies in entries

foreach my $line (@active) {
	my $protocol='';
	my $expires='';
	my $status='';
	my $orgsip='';
	my $orgdip='';
	my $orgsp='';
	my $orgdp='';
	my $exsip='';
	my $exdip='';
	my $exsp='';
	my $exdp='';
	my $marked='';
	my $use='';

	chomp($line);
	my @temp = split(' ',$line);

   	if ($temp[0] eq 'icmp') {
        	$protocol  = $temp[0];
        	$status    = $Lang::tr{'all'};
        	$orgsip   = substr $temp[3], 4;
             	$orgdip   = substr $temp[4], 4;
             	$marked   = $temp[8] eq '[UNREPLIED]' ? '[UNREPLIED]' : ' ';
      	}
   	if ($temp[0] eq 'udp') {
        	$protocol  = $temp[0];
        	$status  = $Lang::tr{'all'};
        	$orgsip = substr $temp[3], 4;
             	$orgdip  = substr $temp[4], 4;
             	$marked   = $temp[7] eq '[UNREPLIED]' ? '[UNREPLIED]' : defined ($temp[12]) ? $temp[11] : ' ';
      	}
	if ($temp[0] eq 'tcp') {
		$protocol  = $temp[0];
		$status  = $temp[3];
		$orgsip = substr $temp[4], 4;
		$orgdip   = substr $temp[5], 4;
             	$marked   = $temp[8] eq '[UNREPLIED]' ? '[UNREPLIED]' : defined ($temp[13]) ? $temp[12] : ' ';
	}

	# filter the line if we found a known proto
	next if( !(
		   (($cgiparams{'SEE_PROTO'}  eq $Lang::tr{'all'}) || ($protocol  eq $cgiparams{'SEE_PROTO'} ))
		&& (($cgiparams{'SEE_STATE'}  eq $Lang::tr{'all'}) || ($status    eq $cgiparams{'SEE_STATE'} ))
		&& (($cgiparams{'SEE_MARK'}   eq $Lang::tr{'all'}) || ($marked    eq $cgiparams{'SEE_MARK'}  ))
		&& (($cgiparams{'SEE_SRC'}    eq "*.*.*.*")        || ($orgsip    eq $cgiparams{'SEE_SRC'}   ))
		&& (($cgiparams{'SEE_DEST'}   eq "*.*.*.*")    	   || ($orgdip    eq $cgiparams{'SEE_DEST'}  ))
		));

	if ($temp[0] eq 'icmp') {
		my $offset = 0;
    		$protocol = $temp[0] . " (" . $temp[1] . ")";
    		$expires = $temp[2];
		$status = ' ';
    		if ($temp[8] eq '[UNREPLIED]' ) {
			$offset = +1;
		}	
    		$orgsip = substr $temp[3], 4;
    		$orgdip = substr $temp[4], 4;
    		$orgsp = &General::GetIcmpDescription(substr( $temp[5], 5)) . "/" . substr( $temp[6], 5);;
    		$orgdp = 'id=' . substr( $temp[7], 3);
    		$exsip = substr $temp[8 + $offset], 4;
    		$exdip = substr $temp[9 + $offset], 4;
	        $exsp = &General::GetIcmpDescription(substr( $temp[10 + $offset], 5)). "/" . substr( $temp[11 + $offset], 5); 
	        $exdp = 'id=' . substr( $temp[11 + $offset], 5);
             	$marked   = $temp[8] eq '[UNREPLIED]' ? '[UNREPLIED]' : ' ';
		$use = substr( $temp[13 + $offset], 4 );
	}
	if ($temp[0] eq 'udp') {
		my $offset = 0;
		$marked = '';
		$protocol = $temp[0] . " (" . $temp[1] . ")";
		$expires = $temp[2];
		$status = ' ';
		$orgsip = substr $temp[3], 4;
		$orgdip = substr $temp[4], 4;
		$orgsp = substr $temp[5], 6;
		$orgdp = substr $temp[6], 6;
		if ($temp[7] eq '[UNREPLIED]') {
                    $offset = 1;
		    $marked = $temp[7];
		    $use = substr $temp[12], 4;
                } else {
		    if ((substr $temp[11], 0, 3) eq 'use' ) {
			$marked = '';
			$use = substr $temp[11], 4;
		    } else {
                	$marked = $temp[11];
			$use = substr $temp[12], 4;
		    }
		}
		$exsip = substr $temp[7 + $offset], 4;
		$exdip = substr $temp[8 + $offset], 4;
		$exsp = substr $temp[9 + $offset], 6;
		$exdp = substr $temp[10 + $offset], 6;
	}
	if ($temp[0] eq 'tcp') {
		my $offset = 0;
                $protocol = $temp[0] . " (" . $temp[1] . ")";
                $expires = $temp[2];
                $status = $temp[3];
                $orgsip = substr $temp[4], 4;
                $orgdip = substr $temp[5], 4;
                $orgsp = substr $temp[6], 6;
		$orgdp = substr $temp[7], 6;
		if ($temp[8] eq '[UNREPLIED]') {
                        $marked = $temp[8];
                        $offset = 1;
                } else {
                        $marked = $temp[12];
                }
		$exsip = substr $temp[8 + $offset], 4;
                $exdip = substr $temp[9 + $offset], 4;
                $exsp = substr $temp[10 + $offset], 6;
                $exdp = substr $temp[11 + $offset], 6;
		$use = substr $temp[13], 4;
        }
	if ($temp[0] eq 'unknown') {
                my $offset = 0;
                $protocol = "??? (" . $temp[1] . ")";
                $protocol = "esp (" . $temp[1] . ")" if ($temp[1] == 50);
                $protocol = "ah (" . $temp[1] . ")" if ($temp[1] == 51);
                $expires = $temp[2];
                $status = ' ';
                $orgsip = substr $temp[3], 4;
                $orgdip = substr $temp[4], 4;
                $orgsp = ' ';
                $orgdp = ' ';
                $exsip = substr $temp[5], 4;
                $exdip = substr $temp[6], 4;
                $exsp = ' ';
                $exdp = ' ';
                $marked = ' ';
                $use = ' ';
        }
	if ($temp[0] eq 'gre') {
                my $offset = 0;
		$protocol = $temp[0] . " (" . $temp[1] . ")";
                $expires = $temp[2];
                $orgsip = substr $temp[5], 4;
                $orgdip = substr $temp[6], 4;
                $orgsp = ' ';
		$orgdp = ' ';
		$exsip = substr $temp[11], 4;
                $exdip = substr $temp[12], 4;
                $exsp = ' ';
                $exdp = ' ';
		$marked = $temp[17];
		$use = $temp[18];
	}
	# Only from this point, lines have the same known format/field
	# The floating fields [UNREPLIED] [ASSURED] etc are ok.

	# Store the line in a hash array for sorting
	if ( $protocol ) { # line is decoded ?
		my @record = (  'index', $index++,
			    'protocol', $protocol,
			    'expires',  $expires,
			    'status',   $status,
			    'orgsip',   $orgsip,
			    'orgdip',   $orgdip,
			    'orgsp',    $orgsp,
			    'orgdp',    $orgdp,
			    'exsip',    $exsip,
			    'exdip', 	$exdip,
			    'exsp',	$exsp,
			    'exdp',	$exdp,
			    'marked',	$marked,
			    'use',	$use);
		my $record = {};                        	# create a reference to empty hash
		%{$record} = @record;                	# populate that hash with @record
		$entries{$record->{index}} = $record; 	# add this to a hash of hashes	    
	} else { # it was not a known line
		$unknownlines .= "<tr bgcolor='${Header::table1colour}'>";
		$unknownlines .= "<td colspan='9'> unknown:$line></td></tr>";
	}
}

# Build listbox objects
my $menu_proto = &make_select ('SEE_PROTO', $cgiparams{'SEE_PROTO'}, @list_proto);
my $menu_state = &make_select ('SEE_STATE', $cgiparams{'SEE_STATE'}, @list_state);
my $menu_src   = &make_select ('SEE_SRC',   $cgiparams{'SEE_SRC'},   &get_known_ips('orgsip'));
my $menu_dest  = &make_select ('SEE_DEST',  $cgiparams{'SEE_DEST'},  &get_known_ips('orgdip'));
my $menu_mark  = &make_select ('SEE_MARK',  $cgiparams{'SEE_MARK'},  @list_mark);
my $menu_sort  = &make_select ('SEE_SORT',  $cgiparams{'SEE_SORT'},  @list_sort);

&Header::showhttpheaders();
&Header::openpage($Lang::tr{'connections'}, 1, '');
&Header::openbigbox('100%', 'left');
&Header::openbox('100%', 'left', $Lang::tr{'connection tracking'});

print <<END
<table width='60%'>
<tr><td align='center'><b>$Lang::tr{'legend'} : </b></td>
    <td align='center' bgcolor='${Header::colourgreen}'><b><font color='#FFFFFF'>$Lang::tr{'lan'}</font></b></td>
    <td align='center' bgcolor='${Header::colourred}'><b><font color='#FFFFFF'>$Lang::tr{'internet'}</font></b></td>
    <td align='center' bgcolor='${Header::colourorange}'><b><font color='#FFFFFF'>$Lang::tr{'dmz'}</font></b></td>
    <td align='center' bgcolor='${Header::colourblue}'><b><font color='#FFFFFF'>$Lang::tr{'wireless'}</font></b></td>
    <td align='center' bgcolor='${Header::colourfw}'><b><font color='#FFFFFF'>IPCop</font></b></td>
    <td align='center' bgcolor='${Header::colourvpn}'><b><font color='#FFFFFF'>$Lang::tr{'vpn'}</font></b></td>
</tr>
</table>
<br />
<table cellpadding='2'>
<tr><td align='center'><b>$Lang::tr{'protocol'}</b></td>
    <td align='center'><b>$Lang::tr{'expires'}<br />($Lang::tr{'seconds'})</b></td>
    <td align='center'><b>$Lang::tr{'connection'}<br />$Lang::tr{'status'}</b></td>
    <td align='center'><b>$Lang::tr{'original'}<br />$Lang::tr{'source ip and port'}</b></td>
    <td align='center'><b>$Lang::tr{'original'}<br />$Lang::tr{'dest ip and port'}</b></td>
    <td align='center'><b>$Lang::tr{'expected'}<br />$Lang::tr{'source ip and port'}</b></td>
    <td align='center'><b>$Lang::tr{'expected'}<br />$Lang::tr{'dest ip and port'}</b></td>
    <td align='center'><b>$Lang::tr{'marked'}</b></td>
    <td align='center'><b>$Lang::tr{'use'}</b></td>
</tr>
<tr><form method='post' action='$ENV{'SCRIPT_NAME'}'>
    <td align='center'>$menu_proto</td>
    <td></td>
    <td align='center'>$menu_state</td>
    <td align='center'>$menu_src</td>
    <td align='center'>$menu_dest</td>
    <td align='center'colspan='2'>$Lang::tr{'sort ascending'}:$menu_sort </td>
    <td align='center'>$menu_mark</td>
    <td align='center'><input type='submit' value='!' /></td>
    </form>
</tr>
END
;

foreach my $entry (sort sort_entries keys %entries) {

	print "<tr bgcolor='${Header::table1colour}'>";
	my $orgsipcolour = &ipcolour( $entries{$entry}->{orgsip} );
	my $orgdipcolour = &ipcolour( $entries{$entry}->{orgdip} );
	my $exsipcolour  = &ipcolour( $entries{$entry}->{exsip} );
	my $exdipcolour  = &ipcolour( $entries{$entry}->{exdip} );
	print <<END
	<td align='center'>$entries{$entry}->{protocol}</td>
	<td align='center'>$entries{$entry}->{expires}</td>
	<td align='center'>$entries{$entry}->{status}</td>
	<td align='center' bgcolor='$orgsipcolour'>
	    <a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{orgsip}'>
	    <font color='#FFFFFF'>$entries{$entry}->{orgsip}</font>
	    </a><font color='#FFFFFF'>:$entries{$entry}->{orgsp}</font></td>
	<td align='center' bgcolor='$orgdipcolour'>
	    <a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{orgdip}'>
	    <font color='#FFFFFF'>$entries{$entry}->{orgdip}</font>
	    </a><font color='#FFFFFF'>:$entries{$entry}->{orgdp}</font></td>
	<td align='center' bgcolor='$exsipcolour'>
	    <a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{exsip}'>
	    <font color='#FFFFFF'>$entries{$entry}->{exsip}</font>
	    </a><font color='#FFFFFF'>:$entries{$entry}->{exsp}</font></td>
	<td align='center' bgcolor='$exdipcolour'>
	    <a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{exdip}'>
	    <font color='#FFFFFF'>$entries{$entry}->{exdip}</font>
	    </a><font color='#FFFFFF'>:$entries{$entry}->{exdp}</font></td>
	<td align='center'>$entries{$entry}->{marked}</td>
	<td align='center'>$entries{$entry}->{use}</td>
	</tr>
END
;
}

print "$unknownlines</table>";

&Header::closebox();
&Header::closebigbox();
&Header::closepage();

sub ipcolour($) {
	my $id = 0;
	my $line;
	my $colour = ${Header::colourred};
	my ($ip) = $_[0];
        my $found = 0;
        foreach $line (@network) {
    		if (!$found && ipv4_in_network( $network[$id] , $masklen[$id], $ip) ) {
			$found = 1;
			$colour = $colour[$id];
		}
		$id++;
	}
	return $colour
}

# Create a string containing a complete SELECT html object 
# param1: name
# param2: current value selected
# param3: field list
sub make_select ($,$,$) {
	my $select_name = shift;
	my $selected    = shift;
	my $select = "<select name='$select_name'>";

	foreach my $value (@_) {
    		my $check = $selected eq $value ? "selected='selected'" : '';
    		$select .= "<option $check value='$value'>$value";
	}
	$select .= "</select>";
	return $select;
}

# Build a list of IP obtained from the %entries hash
# param1: IP field name
sub get_known_ips ($) {
	my $field = shift;
	my $qs = $cgiparams{'SEE_SORT'};	# switch the sort order
	$cgiparams{'SEE_SORT'} = $field;

	my @liste=('*.*.*.*');
	foreach my $entry ( sort sort_entries keys %entries) {
    		push (@liste, $entries{$entry}->{$field}) if (! grep (/^$entries{$entry}->{$field}$/,@liste) );
	}

	$cgiparams{'SEE_SORT'} = $qs;	#restore sort order
        return @liste;
}

# Used to sort the table containing the lines displayed.
sub sort_entries { #Reverse is not implemented
        my $qs=$cgiparams{'SEE_SORT'};
        if ($qs =~ /orgsip|orgdip|exsip|exdip/) {
		my @a = split(/\./,$entries{$a}->{$qs});
		my @b = split(/\./,$entries{$b}->{$qs});
		($a[0]<=>$b[0]) ||
		($a[1]<=>$b[1]) ||
		($a[2]<=>$b[2]) ||
		($a[3]<=>$b[3]);
	} elsif ($qs =~ /expire|orgsp|orgdp|exsp|exdp/) {
    		$entries{$a}->{$qs} <=> $entries{$b}->{$qs};
	} else {
    		$entries{$a}->{$qs} cmp $entries{$b}->{$qs};
	}
}

1;
Commit	Line	Data
ac1cfefa MT	1	#!/usr/bin/perl
	2	#
	3	# (c) 2001 Jack Beglinger <jackb_guppy@yahoo.com>
	4	#
	5	# (c) 2003 Dave Roberts <countzerouk@hotmail.com> - colour coded netfilter/iptables rewrite for 1.3
	6	#
c2b15814 MT	7	# (c) 2006 Franck - add sorting+filtering capability
	8	#
	9	# $Id: connections.cgi,v 1.6.2.12 2006/02/27 19:48:46 franck78 Exp $
ac1cfefa MT	10	#
	11
	12	# Setup GREEN, ORANGE, IPCOP, VPN CIDR networks, masklengths and colours only once
	13
	14	my @network=();
	15	my @masklen=();
	16	my @colour=();
	17
	18	use Net::IPv4Addr qw( :all );
	19
	20	use strict;
	21
	22	# enable only the following on debugging purpose
	23	#use warnings;
	24	#use CGI::Carp 'fatalsToBrowser';
	25
	26	require 'CONFIG_ROOT/general-functions.pl';
	27	require "${General::swroot}/lang.pl";
	28	require "${General::swroot}/header.pl";
	29
	30	#workaround to suppress a warning when a variable is used only once
	31	my @dummy = ( ${Header::table1colour} );
	32	undef (@dummy);
	33
	34	# Read various files
	35
	36	my %netsettings=();
	37	&General::readhash("${General::swroot}/ethernet/settings", \%netsettings);
	38
	39	open (ACTIVE, "/proc/net/ip_conntrack") or die 'Unable to open ip_conntrack';
	40	my @active = <ACTIVE>;
	41	close (ACTIVE);
	42
	43	my @vpn = ('none');
c2b15814 MT	44	open (ACTIVE, "/proc/net/ipsec_eroute") and @vpn = <ACTIVE>;
c2b15814 MT	45	close (ACTIVE);
ac1cfefa MT	46
	47	my $aliasfile = "${General::swroot}/ethernet/aliases";
	48	open(ALIASES, $aliasfile) or die 'Unable to open aliases file.';
	49	my @aliases = <ALIASES>;
	50	close(ALIASES);
	51
	52	# Add Green Firewall Interface
	53	push(@network, $netsettings{'GREEN_ADDRESS'});
	54	push(@masklen, "255.255.255.255" );
	55	push(@colour, ${Header::colourfw} );
	56
	57	# Add Green Network to Array
	58	push(@network, $netsettings{'GREEN_NETADDRESS'});
	59	push(@masklen, $netsettings{'GREEN_NETMASK'} );
	60	push(@colour, ${Header::colourgreen} );
	61
	62	# Add Green Routes to Array
	63	my @routes = `/sbin/route -n \| /bin/grep $netsettings{'GREEN_DEV'}`;
	64	foreach my $route (@routes) {
	65	chomp($route);
	66	my @temp = split(/[\t ]+/, $route);
	67	push(@network, $temp[0]);
	68	push(@masklen, $temp[2]);
	69	push(@colour, ${Header::colourgreen} );
	70	}
	71
	72	# Add Firewall Localhost 127.0.0.1
	73	push(@network, '127.0.0.1');
	74	push(@masklen, '255.255.255.255' );
	75	push(@colour, ${Header::colourfw} );
	76
	77	# Add Orange Network
	78	if ($netsettings{'ORANGE_DEV'}) {
	79	push(@network, $netsettings{'ORANGE_NETADDRESS'});
	80	push(@masklen, $netsettings{'ORANGE_NETMASK'} );
	81	push(@colour, ${Header::colourorange} );
	82	# Add Orange Routes to Array
	83	@routes = `/sbin/route -n \| /bin/grep $netsettings{'ORANGE_DEV'}`;
	84	foreach my $route (@routes) {
	85	chomp($route);
	86	my @temp = split(/[\t ]+/, $route);
	87	push(@network, $temp[0]);
	88	push(@masklen, $temp[2]);
	89	push(@colour, ${Header::colourorange} );
	90	}
	91	}
	92
	93	# Add Blue Network
	94	if ($netsettings{'BLUE_DEV'}) {
	95	push(@network, $netsettings{'BLUE_NETADDRESS'});
	96	push(@masklen, $netsettings{'BLUE_NETMASK'} );
	97	push(@colour, ${Header::colourblue} );
	98	# Add Blue Routes to Array
	99	@routes = `/sbin/route -n \| /bin/grep $netsettings{'BLUE_DEV'}`;
	100	foreach my $route (@routes) {
	101	chomp($route);
	102	my @temp = split(/[\t ]+/, $route);
	103	push(@network, $temp[0]);
	104	push(@masklen, $temp[2]);
	105	push(@colour, ${Header::colourblue} );
	106	}
	107	}
	108
	109	# Add STATIC RED aliases
110	if ($netsettings{'RED_DEV'}) {
111	# We have a RED eth iface
112	if ($netsettings{'RED_TYPE'} eq 'STATIC') {
113	# We have a STATIC RED eth iface
114	foreach my $line (@aliases)
115	{
116	chomp($line);
117	my @temp = split(/\,/,$line);
118	if ( $temp[0] ) {
119	push(@network, $temp[0]);
120	push(@masklen, $netsettings{'RED_NETMASK'} );
121	push(@colour, ${Header::colourfw} );
122	}
123	}
124	}
125	}
126
127	# Add VPNs
128	if ( $vpn[0] ne 'none' ) {
129	foreach my $line (@vpn) {
130	my @temp = split(/[\t ]+/,$line);
131	my @temp1 = split(/[\/:]+/,$temp[3]);
132	push(@network, $temp1[0]);
133	push(@masklen, ipv4_cidr2msk($temp1[1]));
134	push(@colour, ${Header::colourvpn} );
135	}
136	}
137	if (open(IP, "${General::swroot}/red/local-ipaddress")) {
138	my $redip = <IP>;
139	close(IP);
140	chomp $redip;
141	push(@network, $redip);
142	push(@masklen, '255.255.255.255' );
143	push(@colour, ${Header::colourfw} );
144	}
145
ac1cfefa	146
c2b15814 MT	147	#Establish simple filtering&sorting boxes on top of table
	148
	149	our %cgiparams;
	150	&Header::getcgihash(\%cgiparams);
	151
	152	my @list_proto = ($Lang::tr{'all'}, 'icmp', 'udp', 'tcp');
	153	my @list_state = ($Lang::tr{'all'}, 'SYN_SENT', 'SYN_RECV', 'ESTABLISHED', 'FIN_WAIT',
	154	'CLOSE_WAIT', 'LAST_ACK', 'TIME_WAIT', 'CLOSE', 'LISTEN');
	155	my @list_mark = ($Lang::tr{'all'}, '[ASSURED]', '[UNREPLIED]');
	156	my @list_sort = ('orgsip','protocol', 'expires', 'status', 'orgdip', 'orgsp',
	157	'orgdp', 'exsip', 'exdip', 'exsp', 'exdp');
	158
	159	# init or silently correct unknown value...
	160	if ( ! grep ( /^$cgiparams{'SEE_PROTO'}$/ , @list_proto )) { $cgiparams{'SEE_PROTO'} = $list_proto[0] };
	161	if ( ! grep ( /^$cgiparams{'SEE_STATE'}$/ , @list_state )) { $cgiparams{'SEE_STATE'} = $list_state[0] };
	162	if ( ! grep ( /^$cgiparams{'SEE_MARK'}$/ , @list_mark )) { $cgiparams{'SEE_MARK'} = $list_mark[0] };
	163	if ( ! grep ( /^$cgiparams{'SEE_SORT'}$/ , @list_sort )) { $cgiparams{'SEE_SORT'} = $list_sort[0] };
	164	# ... or a valid IP
	165	if ( $cgiparams{'SEE_SRC'} !~ /^(\\.\\.\\.\\.\|\d+\.\d+\.\d+\.\d+)$/) { $cgiparams{'SEE_SRC'} = '...' };
	166	if ( $cgiparams{'SEE_DEST'} !~ /^(\\.\\.\\.\\.\|\d+\.\d+\.\d+\.\d+)$/) { $cgiparams{'SEE_DEST'} = '...' };
	167
	168
	169	our %entries = (); # will hold the lines analyzed correctly
	170	my $unknownlines = ''; # should be empty all the time...
	171	my $index = 0; # just a counter to make unique entryies in entries
ac1cfefa	172
c2b15814	173	foreach my $line (@active) {
ac1cfefa MT	174	my $protocol='';
ac1cfefa MT	175	my $expires='';
c2b15814	176	my $status='';
ac1cfefa MT	177	my $orgsip='';
	178	my $orgdip='';
	179	my $orgsp='';
	180	my $orgdp='';
	181	my $exsip='';
	182	my $exdip='';
	183	my $exsp='';
	184	my $exdp='';
	185	my $marked='';
	186	my $use='';
ac1cfefa MT	187
	188	chomp($line);
	189	my @temp = split(' ',$line);
c2b15814 MT	190
	191	if ($temp[0] eq 'icmp') {
	192	$protocol = $temp[0];
	193	$status = $Lang::tr{'all'};
	194	$orgsip = substr $temp[3], 4;
	195	$orgdip = substr $temp[4], 4;
	196	$marked = $temp[8] eq '[UNREPLIED]' ? '[UNREPLIED]' : ' ';
	197	}
	198	if ($temp[0] eq 'udp') {
	199	$protocol = $temp[0];
	200	$status = $Lang::tr{'all'};
	201	$orgsip = substr $temp[3], 4;
	202	$orgdip = substr $temp[4], 4;
	203	$marked = $temp[7] eq '[UNREPLIED]' ? '[UNREPLIED]' : defined ($temp[12]) ? $temp[11] : ' ';
	204	}
	205	if ($temp[0] eq 'tcp') {
	206	$protocol = $temp[0];
	207	$status = $temp[3];
	208	$orgsip = substr $temp[4], 4;
	209	$orgdip = substr $temp[5], 4;
	210	$marked = $temp[8] eq '[UNREPLIED]' ? '[UNREPLIED]' : defined ($temp[13]) ? $temp[12] : ' ';
	211	}
	212
	213	# filter the line if we found a known proto
	214	next if( !(
	215	(($cgiparams{'SEE_PROTO'} eq $Lang::tr{'all'}) \|\| ($protocol eq $cgiparams{'SEE_PROTO'} ))
	216	&& (($cgiparams{'SEE_STATE'} eq $Lang::tr{'all'}) \|\| ($status eq $cgiparams{'SEE_STATE'} ))
	217	&& (($cgiparams{'SEE_MARK'} eq $Lang::tr{'all'}) \|\| ($marked eq $cgiparams{'SEE_MARK'} ))
	218	&& (($cgiparams{'SEE_SRC'} eq "...") \|\| ($orgsip eq $cgiparams{'SEE_SRC'} ))
	219	&& (($cgiparams{'SEE_DEST'} eq "...") \|\| ($orgdip eq $cgiparams{'SEE_DEST'} ))
	220	));
	221
	222	if ($temp[0] eq 'icmp') {
	223	my $offset = 0;
	224	$protocol = $temp[0] . " (" . $temp[1] . ")";
	225	$expires = $temp[2];
	226	$status = ' ';
	227	if ($temp[8] eq '[UNREPLIED]' ) {
	228	$offset = +1;
	229	}
	230	$orgsip = substr $temp[3], 4;
	231	$orgdip = substr $temp[4], 4;
	232	$orgsp = &General::GetIcmpDescription(substr( $temp[5], 5)) . "/" . substr( $temp[6], 5);;
	233	$orgdp = 'id=' . substr( $temp[7], 3);
	234	$exsip = substr $temp[8 + $offset], 4;
	235	$exdip = substr $temp[9 + $offset], 4;
	236	$exsp = &General::GetIcmpDescription(substr( $temp[10 + $offset], 5)). "/" . substr( $temp[11 + $offset], 5);
	237	$exdp = 'id=' . substr( $temp[11 + $offset], 5);
	238	$marked = $temp[8] eq '[UNREPLIED]' ? '[UNREPLIED]' : ' ';
	239	$use = substr( $temp[13 + $offset], 4 );
	240	}
ac1cfefa MT	241	if ($temp[0] eq 'udp') {
	242	my $offset = 0;
	243	$marked = '';
	244	$protocol = $temp[0] . " (" . $temp[1] . ")";
	245	$expires = $temp[2];
c2b15814	246	$status = ' ';
ac1cfefa MT	247	$orgsip = substr $temp[3], 4;
	248	$orgdip = substr $temp[4], 4;
	249	$orgsp = substr $temp[5], 6;
	250	$orgdp = substr $temp[6], 6;
	251	if ($temp[7] eq '[UNREPLIED]') {
c2b15814 MT	252	$offset = 1;
	253	$marked = $temp[7];
	254	$use = substr $temp[12], 4;
	255	} else {
	256	if ((substr $temp[11], 0, 3) eq 'use' ) {
	257	$marked = '';
	258	$use = substr $temp[11], 4;
	259	} else {
	260	$marked = $temp[11];
	261	$use = substr $temp[12], 4;
	262	}
	263	}
ac1cfefa MT	264	$exsip = substr $temp[7 + $offset], 4;
	265	$exdip = substr $temp[8 + $offset], 4;
	266	$exsp = substr $temp[9 + $offset], 6;
	267	$exdp = substr $temp[10 + $offset], 6;
ac1cfefa MT	268	}
	269	if ($temp[0] eq 'tcp') {
	270	my $offset = 0;
	271	$protocol = $temp[0] . " (" . $temp[1] . ")";
	272	$expires = $temp[2];
c2b15814	273	$status = $temp[3];
ac1cfefa MT	274	$orgsip = substr $temp[4], 4;
	275	$orgdip = substr $temp[5], 4;
	276	$orgsp = substr $temp[6], 6;
	277	$orgdp = substr $temp[7], 6;
	278	if ($temp[8] eq '[UNREPLIED]') {
	279	$marked = $temp[8];
	280	$offset = 1;
c2b15814	281	} else {
ac1cfefa	282	$marked = $temp[12];
ac1cfefa	283	}
ac1cfefa MT	284	$exsip = substr $temp[8 + $offset], 4;
	285	$exdip = substr $temp[9 + $offset], 4;
	286	$exsp = substr $temp[10 + $offset], 6;
	287	$exdp = substr $temp[11 + $offset], 6;
c2b15814	288	$use = substr $temp[13], 4;
ac1cfefa MT	289	}
	290	if ($temp[0] eq 'unknown') {
	291	my $offset = 0;
	292	$protocol = "??? (" . $temp[1] . ")";
	293	$protocol = "esp (" . $temp[1] . ")" if ($temp[1] == 50);
c2b15814	294	$protocol = "ah (" . $temp[1] . ")" if ($temp[1] == 51);
ac1cfefa	295	$expires = $temp[2];
c2b15814	296	$status = ' ';
ac1cfefa MT	297	$orgsip = substr $temp[3], 4;
	298	$orgdip = substr $temp[4], 4;
	299	$orgsp = ' ';
	300	$orgdp = ' ';
	301	$exsip = substr $temp[5], 4;
	302	$exdip = substr $temp[6], 4;
	303	$exsp = ' ';
	304	$exdp = ' ';
	305	$marked = ' ';
	306	$use = ' ';
	307	}
	308	if ($temp[0] eq 'gre') {
	309	my $offset = 0;
	310	$protocol = $temp[0] . " (" . $temp[1] . ")";
	311	$expires = $temp[2];
	312	$orgsip = substr $temp[5], 4;
	313	$orgdip = substr $temp[6], 4;
	314	$orgsp = ' ';
	315	$orgdp = ' ';
	316	$exsip = substr $temp[11], 4;
	317	$exdip = substr $temp[12], 4;
	318	$exsp = ' ';
	319	$exdp = ' ';
	320	$marked = $temp[17];
	321	$use = $temp[18];
	322	}
c2b15814 MT	323	# Only from this point, lines have the same known format/field
	324	# The floating fields [UNREPLIED] [ASSURED] etc are ok.
	325
	326	# Store the line in a hash array for sorting
	327	if ( $protocol ) { # line is decoded ?
	328	my @record = ( 'index', $index++,
	329	'protocol', $protocol,
	330	'expires', $expires,
	331	'status', $status,
	332	'orgsip', $orgsip,
	333	'orgdip', $orgdip,
	334	'orgsp', $orgsp,
	335	'orgdp', $orgdp,
	336	'exsip', $exsip,
	337	'exdip', $exdip,
	338	'exsp', $exsp,
	339	'exdp', $exdp,
	340	'marked', $marked,
	341	'use', $use);
	342	my $record = {}; # create a reference to empty hash
	343	%{$record} = @record; # populate that hash with @record
	344	$entries{$record->{index}} = $record; # add this to a hash of hashes
	345	} else { # it was not a known line
	346	$unknownlines .= "<tr bgcolor='${Header::table1colour}'>";
	347	$unknownlines .= "<td colspan='9'> unknown:$line></td></tr>";
	348	}
	349	}
	350
	351	# Build listbox objects
	352	my $menu_proto = &make_select ('SEE_PROTO', $cgiparams{'SEE_PROTO'}, @list_proto);
	353	my $menu_state = &make_select ('SEE_STATE', $cgiparams{'SEE_STATE'}, @list_state);
	354	my $menu_src = &make_select ('SEE_SRC', $cgiparams{'SEE_SRC'}, &get_known_ips('orgsip'));
	355	my $menu_dest = &make_select ('SEE_DEST', $cgiparams{'SEE_DEST'}, &get_known_ips('orgdip'));
	356	my $menu_mark = &make_select ('SEE_MARK', $cgiparams{'SEE_MARK'}, @list_mark);
	357	my $menu_sort = &make_select ('SEE_SORT', $cgiparams{'SEE_SORT'}, @list_sort);
	358
	359	&Header::showhttpheaders();
	360	&Header::openpage($Lang::tr{'connections'}, 1, '');
	361	&Header::openbigbox('100%', 'left');
	362	&Header::openbox('100%', 'left', $Lang::tr{'connection tracking'});
	363
	364	print <<END
	365	<table width='60%'>
	366	<tr><td align='center'><b>$Lang::tr{'legend'} : </b></td>
	367	<td align='center' bgcolor='${Header::colourgreen}'><b><font color='#FFFFFF'>$Lang::tr{'lan'}</font></b></td>
	368	<td align='center' bgcolor='${Header::colourred}'><b><font color='#FFFFFF'>$Lang::tr{'internet'}</font></b></td>
	369	<td align='center' bgcolor='${Header::colourorange}'><b><font color='#FFFFFF'>$Lang::tr{'dmz'}</font></b></td>
	370	<td align='center' bgcolor='${Header::colourblue}'><b><font color='#FFFFFF'>$Lang::tr{'wireless'}</font></b></td>
	371	<td align='center' bgcolor='${Header::colourfw}'><b><font color='#FFFFFF'>IPCop</font></b></td>
	372	<td align='center' bgcolor='${Header::colourvpn}'><b><font color='#FFFFFF'>$Lang::tr{'vpn'}</font></b></td>
	373	</tr>
	374	</table>
	375	<br />
	376	<table cellpadding='2'>
	377	<tr><td align='center'><b>$Lang::tr{'protocol'}</b></td>
	378	<td align='center'><b>$Lang::tr{'expires'}<br />($Lang::tr{'seconds'})</b></td>
	379	<td align='center'><b>$Lang::tr{'connection'}<br />$Lang::tr{'status'}</b></td>
	380	<td align='center'><b>$Lang::tr{'original'}<br />$Lang::tr{'source ip and port'}</b></td>
	381	<td align='center'><b>$Lang::tr{'original'}<br />$Lang::tr{'dest ip and port'}</b></td>
	382	<td align='center'><b>$Lang::tr{'expected'}<br />$Lang::tr{'source ip and port'}</b></td>
	383	<td align='center'><b>$Lang::tr{'expected'}<br />$Lang::tr{'dest ip and port'}</b></td>
	384	<td align='center'><b>$Lang::tr{'marked'}</b></td>
	385	<td align='center'><b>$Lang::tr{'use'}</b></td>
	386	</tr>
387	<tr><form method='post' action='$ENV{'SCRIPT_NAME'}'>
388	<td align='center'>$menu_proto</td>
389	<td></td>
390	<td align='center'>$menu_state</td>
391	<td align='center'>$menu_src</td>
392	<td align='center'>$menu_dest</td>
393	<td align='center'colspan='2'>$Lang::tr{'sort ascending'}:$menu_sort </td>
394	<td align='center'>$menu_mark</td>
395	<td align='center'><input type='submit' value='!' /></td>
396	</form>
397	</tr>
398	END
399	;
400
401	foreach my $entry (sort sort_entries keys %entries) {
402
403	print "<tr bgcolor='${Header::table1colour}'>";
404	my $orgsipcolour = &ipcolour( $entries{$entry}->{orgsip} );
405	my $orgdipcolour = &ipcolour( $entries{$entry}->{orgdip} );
406	my $exsipcolour = &ipcolour( $entries{$entry}->{exsip} );
407	my $exdipcolour = &ipcolour( $entries{$entry}->{exdip} );
ac1cfefa	408	print <<END
c2b15814 MT	409	<td align='center'>$entries{$entry}->{protocol}</td>
	410	<td align='center'>$entries{$entry}->{expires}</td>
	411	<td align='center'>$entries{$entry}->{status}</td>
	412	<td align='center' bgcolor='$orgsipcolour'>
	413	<a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{orgsip}'>
	414	<font color='#FFFFFF'>$entries{$entry}->{orgsip}</font>
	415	</a><font color='#FFFFFF'>:$entries{$entry}->{orgsp}</font></td>
	416	<td align='center' bgcolor='$orgdipcolour'>
	417	<a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{orgdip}'>
	418	<font color='#FFFFFF'>$entries{$entry}->{orgdip}</font>
	419	</a><font color='#FFFFFF'>:$entries{$entry}->{orgdp}</font></td>
	420	<td align='center' bgcolor='$exsipcolour'>
	421	<a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{exsip}'>
	422	<font color='#FFFFFF'>$entries{$entry}->{exsip}</font>
	423	</a><font color='#FFFFFF'>:$entries{$entry}->{exsp}</font></td>
	424	<td align='center' bgcolor='$exdipcolour'>
	425	<a href='/cgi-bin/ipinfo.cgi?ip=$entries{$entry}->{exdip}'>
	426	<font color='#FFFFFF'>$entries{$entry}->{exdip}</font>
	427	</a><font color='#FFFFFF'>:$entries{$entry}->{exdp}</font></td>
	428	<td align='center'>$entries{$entry}->{marked}</td>
	429	<td align='center'>$entries{$entry}->{use}</td>
ac1cfefa MT	430	</tr>
ac1cfefa MT	431	END
c2b15814	432	;
ac1cfefa	433	}
c2b15814 MT	434
c2b15814 MT	435	print "$unknownlines</table>";
ac1cfefa MT	436
	437	&Header::closebox();
	438	&Header::closebigbox();
	439	&Header::closepage();
	440
	441	sub ipcolour($) {
	442	my $id = 0;
	443	my $line;
	444	my $colour = ${Header::colourred};
	445	my ($ip) = $_[0];
c2b15814 MT	446	my $found = 0;
	447	foreach $line (@network) {
	448	if (!$found && ipv4_in_network( $network[$id] , $masklen[$id], $ip) ) {
ac1cfefa MT	449	$found = 1;
	450	$colour = $colour[$id];
	451	}
	452	$id++;
	453	}
	454	return $colour
	455	}
c2b15814 MT	456
	457	# Create a string containing a complete SELECT html object
	458	# param1: name
	459	# param2: current value selected
	460	# param3: field list
	461	sub make_select ($,$,$) {
	462	my $select_name = shift;
	463	my $selected = shift;
	464	my $select = "<select name='$select_name'>";
	465
	466	foreach my $value (@_) {
	467	my $check = $selected eq $value ? "selected='selected'" : '';
	468	$select .= "<option $check value='$value'>$value";
	469	}
	470	$select .= "</select>";
	471	return $select;
	472	}
	473
	474	# Build a list of IP obtained from the %entries hash
	475	# param1: IP field name
	476	sub get_known_ips ($) {
	477	my $field = shift;
	478	my $qs = $cgiparams{'SEE_SORT'}; # switch the sort order
	479	$cgiparams{'SEE_SORT'} = $field;
	480
	481	my @liste=('...');
	482	foreach my $entry ( sort sort_entries keys %entries) {
	483	push (@liste, $entries{$entry}->{$field}) if (! grep (/^$entries{$entry}->{$field}$/,@liste) );
	484	}
	485
	486	$cgiparams{'SEE_SORT'} = $qs; #restore sort order
	487	return @liste;
	488	}
	489
	490	# Used to sort the table containing the lines displayed.
	491	sub sort_entries { #Reverse is not implemented
	492	my $qs=$cgiparams{'SEE_SORT'};
	493	if ($qs =~ /orgsip\|orgdip\|exsip\|exdip/) {
	494	my @a = split(/\./,$entries{$a}->{$qs});
	495	my @b = split(/\./,$entries{$b}->{$qs});
	496	($a[0]<=>$b[0]) \|\|
	497	($a[1]<=>$b[1]) \|\|
	498	($a[2]<=>$b[2]) \|\|
	499	($a[3]<=>$b[3]);
	500	} elsif ($qs =~ /expire\|orgsp\|orgdp\|exsp\|exdp/) {
	501	$entries{$a}->{$qs} <=> $entries{$b}->{$qs};
	502	} else {
	503	$entries{$a}->{$qs} cmp $entries{$b}->{$qs};
	504	}
	505	}
	506
	507	1;