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

#!/usr/bin/perl\r
#\r
# IPCop CGI's - aliases.cgi\r
#\r
# This code is distributed under the terms of the GPL\r
#\r
# (c) Steve Bootes 2002/04/13 - Manage IP Aliases\r
#\r
# $Id: aliases.cgi,v 1.5.2.14 2006/01/13 20:14:48 eoberlander Exp $\r
\r
\r
# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines\r
#use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work\r
# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help\r
use warnings;\r
use strict;\r
#use Carp ();\r
#local $SIG{__WARN__} = \&Carp::cluck;\r
\r
require 'CONFIG_ROOT/general-functions.pl';	# replace CONFIG_ROOT with /var/ipcop in case of manual install\r
require "${General::swroot}/lang.pl";\r
require "${General::swroot}/header.pl";\r
\r
#workaround to suppress a warning when a variable is used only once\r
my @dummy = ( ${Header::colouryellow} );\r
   @dummy = ( ${Header::table1colour} );\r
   @dummy = ( ${Header::table2colour} );\r
undef (@dummy);\r
\r
# Files used\r
my $setting = "${General::swroot}/ethernet/settings";\r
our $datafile = "${General::swroot}/ethernet/aliases";\r
\r
\r
our %settings=();\r
#Settings1\r
\r
#Settings2 for editing the multi-line list\r
#Must not be saved !\r
$settings{'IP'} = '';\r
$settings{'ENABLED'} = 'off';		# Every check box must be set to off\r
$settings{'NAME'} = '';\r
my @nosaved=('IP','ENABLED','NAME');	# List here ALL setting2 fields. Mandatory\r
    \r
$settings{'ACTION'} = '';		# add/edit/remove\r
$settings{'KEY1'} = '';			# point record for ACTION\r
\r
#Define each field that can be used to sort columns\r
my $sortstring='^IP|^NAME';\r
my $errormessage = '';\r
my $warnmessage = '';\r
\r
&Header::showhttpheaders();\r
\r
# Read needed Ipcop netsettings\r
my %netsettings=();\r
$netsettings{'SORT_ALIASES'} = 'NAME'; 	# default sort\r
&General::readhash($setting, \%netsettings);\r
\r
#Get GUI values\r
&Header::getcgihash(\%settings);\r
\r
# Load multiline data\r
our @current = ();\r
if (open(FILE, "$datafile")) {\r
    @current = <FILE>;\r
    close (FILE);\r
}\r
\r
#\r
# Check Settings1 first because they are needed before working on @current\r
#\r
# Remove if no Setting1 needed\r
#\r
if ($settings{'ACTION'} eq $Lang::tr{'save'}) {\r
    \r
    #\r
    #Validate static Settings1 here\r
    #\r
    \r
    unless ($errormessage) {					# Everything is ok, save settings\r
	#map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved \r
	#&General::writehash($setting, \%settings);		# Save good settings\r
	#$settings{'ACTION'} = $Lang::tr{'save'};		# Recreate  'ACTION'\r
	#map ($settings{$_}= '',(@nosaved,'KEY1'));		# and reinit var to empty\r
	\r
	# Rebuild configuration file if needed\r
	&BuildConfiguration;\r
    }\r
\r
    ERROR:						# Leave the faulty field untouched\r
} else {\r
    #&General::readhash($setting, \%settings);  	# Get saved settings and reset to good if needed\r
}\r
\r
## Now manipulate the multi-line list with Settings2\r
# Basic actions are:\r
#	toggle the check box\r
#	add/update a new line\r
#	begin editing a line\r
#	remove a line\r
\r
\r
# Toggle enable/disable field.  Field is in second position\r
if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {\r
    #move out new line\r
    chomp(@current[$settings{'KEY1'}]);\r
    my @temp = split(/\,/,@current[$settings{'KEY1'}]);\r
    $temp[1] = $temp[1] eq 'on' ? '' : 'on';		# Toggle the field\r
    @current[$settings{'KEY1'}] = join (',',@temp)."\n";\r
    $settings{'KEY1'} = ''; 				# End edit mode\r
    \r
    &General::log($Lang::tr{'ip alias changed'});\r
    \r
    #Save current\r
    open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
    print FILE @current;\r
    close(FILE);\r
	\r
    # Rebuild configuration file\r
    &BuildConfiguration;\r
}\r
\r
if ($settings{'ACTION'} eq $Lang::tr{'add'}) {\r
    # Validate inputs\r
    if (! &General::validip($settings{'IP'})) {$errormessage = "invalid ip"};\r
    $settings{'NAME'} = &Header::cleanhtml($settings{'NAME'});\r
\r
    # Make sure we haven't duplicated an alias or RED\r
    my $spacer='';\r
    if ($settings{'IP'} eq $netsettings{'RED_ADDRESS'}) {\r
	$errormessage = $Lang::tr{'duplicate ip'} . ' (RED)';\r
        $spacer=" & ";\r
    }\r
    my $idx=0;\r
    foreach my $line (@current) {\r
        chomp ($line);\r
        my @temp = split (/\,/, $line);\r
        if ( ($settings{'KEY1'} eq '')||(($settings{'KEY1'} ne '') && ($settings{'KEY1'} != $idx))) { # update\r
	    if ($temp[0] eq $settings{'IP'}) {\r
	        $errormessage .= $spacer.$Lang::tr{'duplicate ip'};\r
	        $spacer=" & ";\r
	    }\r
	    if ($temp[2] eq $settings{'NAME'} && $temp[2] ne '') {\r
		$errormessage .= $spacer.$Lang::tr{'duplicate name'};\r
		$spacer=" & ";\r
		}\r
	}\r
	$idx++;\r
    }\r
    unless ($errormessage) {\r
	if ($settings{'KEY1'} eq '') { #add or edit ?\r
	    unshift (@current, "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n");\r
	    &General::log($Lang::tr{'ip alias added'});\r
	} else {\r
	    @current[$settings{'KEY1'}] = "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n";\r
	    $settings{'KEY1'} = '';       # End edit mode\r
	    &General::log($Lang::tr{'ip alias changed'});\r
	}\r
\r
	# Write changes to config file.\r
	&SortDataFile;				# sort newly added/modified entry\r
\r
	&BuildConfiguration;			# then re-build conf which use new data\r
	\r
##\r
## if entering data line is repetitive, choose here to not erase fields between each addition\r
##\r
	map ($settings{$_}='' ,@nosaved);	# Clear fields\r
    }\r
}\r
\r
if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {\r
    #move out new line\r
    my $line = @current[$settings{'KEY1'}];	# KEY1 is the index in current\r
    chomp($line);\r
    my @temp = split(/\,/, $line);\r
\r
##\r
## move data fields to Setting2 for edition\r
##\r
    $settings{'IP'}=$temp[0];			# Prepare the screen for editing\r
    $settings{'ENABLED'}=$temp[1];\r
    $settings{'NAME'}=$temp[2];\r
}\r
\r
if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {\r
    splice (@current,$settings{'KEY1'},1);		# Delete line \r
    open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
    print FILE @current;\r
    close(FILE);\r
    $settings{'KEY1'} = '';				# End remove mode\r
    &General::log($Lang::tr{'ip alias removed'});\r
\r
    &BuildConfiguration;				# then re-build conf which use new data\r
}\r
\r
\r
\r
##  Check if sorting is asked\r
# If same column clicked, reverse the sort.\r
if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {\r
    my $newsort=$ENV{'QUERY_STRING'};\r
    my $actual=$netsettings{'SORT_ALIASES'};\r
    #Reverse actual sort ?\r
    if ($actual =~ $newsort) {\r
	my $Rev='';\r
	if ($actual !~ 'Rev') {\r
	    $Rev='Rev';\r
	}\r
	$newsort.=$Rev;\r
    }\r
    $netsettings{'SORT_ALIASES'}=$newsort;\r
    &General::writehash($setting, \%netsettings);\r
    &SortDataFile;\r
    $settings{'ACTION'} = 'SORT';			# Recreate  'ACTION'\r
}\r
\r
# Default initial value\r
if ($settings{'ACTION'} eq '' ) { # First launch from GUI\r
    $settings{'ENABLED'} ='on';\r
}\r
    \r
&Header::openpage($Lang::tr{'external aliases configuration'}, 1, '');\r
&Header::openbigbox('100%', 'left', '', $errormessage);\r
my %checked =();     # Checkbox manipulations\r
\r
if ($errormessage) {\r
    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
    print "<font class='base'>$errormessage&nbsp;</font>";\r
    &Header::closebox();\r
}\r
unless (( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ ) && ($netsettings{'RED_TYPE'} eq 'STATIC'))\r
{\r
    &Header::openbox('100%', 'left', $Lang::tr{'capswarning'});\r
    print <<END\r
    <table width='100%'>\r
    <tr>\r
    <td width='100%' class='boldbase' align='center'><font color='${Header::colourred}'><b>$Lang::tr{'aliases not active'}</b></font></td>\r
    </tr>\r
    </table>\r
END\r
;\r
    &Header::closebox();\r
}\r
									\r
#\r
# Second check box is for editing the list\r
#\r
$checked{'ENABLED'}{'on'} = ($settings{'ENABLED'} eq '') ? '' :  "checked='checked'";\r
\r
my $buttontext = $Lang::tr{'add'};\r
if ($settings{'KEY1'} ne '') {\r
    $buttontext = $Lang::tr{'update'};\r
    &Header::openbox('100%', 'left', $Lang::tr{'edit an existing alias'});\r
} else {\r
    &Header::openbox('100%', 'left', $Lang::tr{'add new alias'});\r
}\r
\r
#Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'\r
print <<END\r
<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />\r
<table width='100%'>\r
<tr>\r
<td class='base'><font color='${Header::colourred}'>$Lang::tr{'name'}:&nbsp;<img src='/blob.gif' alt='*' /></font></td>\r
<td><input type='text' name='NAME' value='$settings{'NAME'}' size='32' /></td>\r
<td class='base' align='right'><font color='${Header::colourred}'>$Lang::tr{'alias ip'}:&nbsp;</font></td>\r
<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>\r
<td class='base' align='right'>$Lang::tr{'enabled'}&nbsp;</td>\r
<td><input type='checkbox' name='ENABLED' $checked{'ENABLED'}{'on'} /></td>\r
</tr>\r
</table>\r
<hr />\r
<table width='100%'>\r
<tr>\r
    <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>\r
    <td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>\r
</tr>\r
</table>\r
</form>\r
END\r
;\r
&Header::closebox();\r
\r
#\r
# Third box shows the list, in columns\r
#\r
# Columns headers may content a link. In this case it must be named in $sortstring\r
#\r
&Header::openbox('100%', 'left', $Lang::tr{'current aliases'});\r
print <<END\r
<table width='100%'>\r
<tr>\r
    <td width='50%' align='center'><a href='$ENV{'SCRIPT_NAME'}?NAME'><b>$Lang::tr{'name'}</b></a></td>\r
    <td width='40%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a></td>\r
    <td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>\r
</tr>\r
END\r
;\r
\r
#\r
# Print each line of @current list\r
#\r
# each data line is splitted into @temp.\r
#\r
\r
my $key = 0;\r
foreach my $line (@current) {\r
    chomp($line);\r
    my @temp = split(/\,/,$line);\r
\r
    #Choose icon for checkbox\r
    my $gif = '';\r
    my $gdesc = '';\r
    if ($temp[1] eq "on") {\r
	$gif = 'on.gif';\r
	$gdesc = $Lang::tr{'click to disable'};\r
    } else {\r
	$gif = 'off.gif';\r
	$gdesc = $Lang::tr{'click to enable'}; \r
    }\r
\r
    #Colorize each line\r
    if ($settings{'KEY1'} eq $key) {\r
	print "<tr bgcolor='${Header::colouryellow}'>";\r
    } elsif ($key % 2) {\r
	print "<tr bgcolor='${Header::table2colour}'>";\r
    } else {\r
	print "<tr bgcolor='${Header::table1colour}'>"; \r
    }\r
\r
    print <<END\r
<td align='center'>$temp[2]</td>\r
<td align='center'>$temp[0]</td>\r
\r
<td align='center'>\r
<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />\r
<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />\r
<input type='hidden' name='KEY1' value='$key' />\r
</form>\r
</td>\r
\r
<td align='center'>\r
<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />\r
<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />\r
<input type='hidden' name='KEY1' value='$key' />\r
</form>\r
</td>\r
\r
<td align='center'>\r
<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />\r
<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />\r
<input type='hidden' name='KEY1' value='$key' />\r
</form>\r
</td>\r
</tr>\r
END\r
;\r
    $key++;\r
}\r
print "</table>";\r
\r
# If table contains entries, print 'Key to action icons'\r
if ($key) {\r
print <<END\r
<table>\r
<tr>\r
    <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>\r
    <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>\r
    <td class='base'>$Lang::tr{'click to disable'}</td>\r
    <td>&nbsp;&nbsp;</td>\r
    <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>\r
    <td class='base'>$Lang::tr{'click to enable'}</td>\r
    <td>&nbsp;&nbsp;</td>\r
    <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>\r
    <td class='base'>$Lang::tr{'edit'}</td>\r
    <td>&nbsp;&nbsp;</td>\r
    <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>\r
    <td class='base'>$Lang::tr{'remove'}</td>\r
</tr>\r
</table>\r
END\r
;\r
}\r
\r
&Header::closebox();\r
&Header::closebigbox();\r
&Header::closepage();\r
\r
## Ouf it's the end !\r
\r
\r
\r
# Sort the "current" array according to choices\r
sub SortDataFile\r
{\r
    our %entries = ();\r
    \r
    # Sort pair of record received in $a $b special vars.\r
    # When IP is specified use numeric sort else alpha.\r
    # If sortname ends with 'Rev', do reverse sort.\r
    #\r
    sub fixedleasesort {\r
	my $qs='';             # The sort field specified minus 'Rev'\r
	if (rindex ($netsettings{'SORT_ALIASES'},'Rev') != -1) {\r
	    $qs=substr ($netsettings{'SORT_ALIASES'},0,length($netsettings{'SORT_ALIASES'})-3);\r
	    if ($qs eq 'IP') {\r
		my @a = split(/\./,$entries{$a}->{$qs});\r
		my @b = split(/\./,$entries{$b}->{$qs});\r
		($b[0]<=>$a[0]) ||\r
		($b[1]<=>$a[1]) ||\r
		($b[2]<=>$a[2]) ||\r
		($b[3]<=>$a[3]);\r
	    } else {\r
		$entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r
	    }\r
	} else { #not reverse\r
	    $qs=$netsettings{'SORT_ALIASES'};\r
	    if ($qs eq 'IP') {\r
		my @a = split(/\./,$entries{$a}->{$qs});\r
		my @b = split(/\./,$entries{$b}->{$qs});\r
		($a[0]<=>$b[0]) ||\r
		($a[1]<=>$b[1]) ||\r
		($a[2]<=>$b[2]) ||\r
		($a[3]<=>$b[3]);\r
	    } else {\r
		$entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r
	    }\r
	}\r
    }\r
\r
    #Use an associative array (%entries)\r
    my $key = 0;\r
    foreach my $line (@current) {\r
	chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)\r
	my @temp = split (',',$line);\r
	\r
	# Build a pair 'Field Name',value for each of the data dataline.\r
	# Each SORTABLE field must have is pair.\r
	# Other data fields (non sortable) can be grouped in one\r
	\r
	# Exemple\r
	# F1,F2,F3,F4,F5       only F1 F2 for sorting\r
	# my @record = ('KEY',$key++,\r
	#		'F1',$temp[0],\r
	#		'F2',$temp[1],\r
	#		'DATA',join(',',@temp[2..4])	);  #group remainning values, with separator (,)\r
	\r
	# The KEY,key record permits doublons. If removed, then F1 becomes the key without doublon permitted.\r
	\r
	\r
	my @record = ('KEY',$key++,'IP',$temp[0],'ENABLED',$temp[1],'NAME',$temp[2]);\r
	my $record = {};                        	# create a reference to empty hash\r
	%{$record} = @record;                		# populate that hash with @record\r
	$entries{$record->{KEY}} = $record; 		# add this to a hash of hashes\r
    }\r
    \r
    open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
\r
    # Each field value is printed , with the newline ! Don't forget separator and order of them.\r
    foreach my $entry (sort fixedleasesort keys %entries) {\r
	print FILE "$entries{$entry}->{IP},$entries{$entry}->{ENABLED},$entries{$entry}->{NAME}\n";\r
    }\r
\r
    close(FILE);\r
    # Reload sorted  @current\r
    open (FILE, "$datafile");\r
    @current = <FILE>;\r
    close (FILE);\r
}\r
\r
#						    \r
# Build the configuration file for application aliases\r
#\r
sub BuildConfiguration {\r
    # Restart service associated with this\r
    system '/usr/local/bin/setaliases';\r
}\r
Commit	Line	Data
cd1a2927 MT	1	#!/usr/bin/perl\r
	2	#\r
	3	# IPCop CGI's - aliases.cgi\r
	4	#\r
	5	# This code is distributed under the terms of the GPL\r
	6	#\r
	7	# (c) Steve Bootes 2002/04/13 - Manage IP Aliases\r
	8	#\r
	9	# $Id: aliases.cgi,v 1.5.2.14 2006/01/13 20:14:48 eoberlander Exp $\r
	10	\r
	11	\r
	12	# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines\r
	13	#use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work\r
	14	# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help\r
	15	use warnings;\r
	16	use strict;\r
	17	#use Carp ();\r
	18	#local $SIG{__WARN__} = \&Carp::cluck;\r
	19	\r
	20	require 'CONFIG_ROOT/general-functions.pl'; # replace CONFIG_ROOT with /var/ipcop in case of manual install\r
	21	require "${General::swroot}/lang.pl";\r
	22	require "${General::swroot}/header.pl";\r
	23	\r
	24	#workaround to suppress a warning when a variable is used only once\r
	25	my @dummy = ( ${Header::colouryellow} );\r
	26	@dummy = ( ${Header::table1colour} );\r
	27	@dummy = ( ${Header::table2colour} );\r
	28	undef (@dummy);\r
	29	\r
	30	# Files used\r
	31	my $setting = "${General::swroot}/ethernet/settings";\r
	32	our $datafile = "${General::swroot}/ethernet/aliases";\r
	33	\r
	34	\r
	35	our %settings=();\r
	36	#Settings1\r
	37	\r
	38	#Settings2 for editing the multi-line list\r
	39	#Must not be saved !\r
	40	$settings{'IP'} = '';\r
	41	$settings{'ENABLED'} = 'off'; # Every check box must be set to off\r
	42	$settings{'NAME'} = '';\r
	43	my @nosaved=('IP','ENABLED','NAME'); # List here ALL setting2 fields. Mandatory\r
	44	\r
	45	$settings{'ACTION'} = ''; # add/edit/remove\r
	46	$settings{'KEY1'} = ''; # point record for ACTION\r
	47	\r
	48	#Define each field that can be used to sort columns\r
	49	my $sortstring='^IP\|^NAME';\r
	50	my $errormessage = '';\r
	51	my $warnmessage = '';\r
	52	\r
	53	&Header::showhttpheaders();\r
	54	\r
	55	# Read needed Ipcop netsettings\r
	56	my %netsettings=();\r
	57	$netsettings{'SORT_ALIASES'} = 'NAME'; # default sort\r
	58	&General::readhash($setting, \%netsettings);\r
	59	\r
	60	#Get GUI values\r
	61	&Header::getcgihash(\%settings);\r
	62	\r
	63	# Load multiline data\r
	64	our @current = ();\r
65	if (open(FILE, "$datafile")) {\r
66	@current = <FILE>;\r
67	close (FILE);\r
68	}\r
69	\r
70	#\r
71	# Check Settings1 first because they are needed before working on @current\r
72	#\r
73	# Remove if no Setting1 needed\r
74	#\r
75	if ($settings{'ACTION'} eq $Lang::tr{'save'}) {\r
76	\r
77	#\r
78	#Validate static Settings1 here\r
79	#\r
80	\r
81	unless ($errormessage) { # Everything is ok, save settings\r
82	#map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved \r
83	#&General::writehash($setting, \%settings); # Save good settings\r
84	#$settings{'ACTION'} = $Lang::tr{'save'}; # Recreate 'ACTION'\r
85	#map ($settings{$_}= '',(@nosaved,'KEY1')); # and reinit var to empty\r
86	\r
87	# Rebuild configuration file if needed\r
88	&BuildConfiguration;\r
89	}\r
90	\r
91	ERROR: # Leave the faulty field untouched\r
92	} else {\r
93	#&General::readhash($setting, \%settings); # Get saved settings and reset to good if needed\r
94	}\r
95	\r
96	## Now manipulate the multi-line list with Settings2\r
97	# Basic actions are:\r
98	# toggle the check box\r
99	# add/update a new line\r
100	# begin editing a line\r
101	# remove a line\r
102	\r
103	\r
104	# Toggle enable/disable field. Field is in second position\r
105	if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {\r
106	#move out new line\r
107	chomp(@current[$settings{'KEY1'}]);\r
108	my @temp = split(/\,/,@current[$settings{'KEY1'}]);\r
109	$temp[1] = $temp[1] eq 'on' ? '' : 'on'; # Toggle the field\r
110	@current[$settings{'KEY1'}] = join (',',@temp)."\n";\r
111	$settings{'KEY1'} = ''; # End edit mode\r
112	\r
113	&General::log($Lang::tr{'ip alias changed'});\r
114	\r
115	#Save current\r
116	open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
117	print FILE @current;\r
118	close(FILE);\r
119	\r
120	# Rebuild configuration file\r
121	&BuildConfiguration;\r
122	}\r
123	\r
124	if ($settings{'ACTION'} eq $Lang::tr{'add'}) {\r
125	# Validate inputs\r
126	if (! &General::validip($settings{'IP'})) {$errormessage = "invalid ip"};\r
127	$settings{'NAME'} = &Header::cleanhtml($settings{'NAME'});\r
128	\r
129	# Make sure we haven't duplicated an alias or RED\r
130	my $spacer='';\r
131	if ($settings{'IP'} eq $netsettings{'RED_ADDRESS'}) {\r
132	$errormessage = $Lang::tr{'duplicate ip'} . ' (RED)';\r
133	$spacer=" & ";\r
134	}\r
135	my $idx=0;\r
136	foreach my $line (@current) {\r
137	chomp ($line);\r
138	my @temp = split (/\,/, $line);\r
139	if ( ($settings{'KEY1'} eq '')\|\|(($settings{'KEY1'} ne '') && ($settings{'KEY1'} != $idx))) { # update\r
140	if ($temp[0] eq $settings{'IP'}) {\r
141	$errormessage .= $spacer.$Lang::tr{'duplicate ip'};\r
142	$spacer=" & ";\r
143	}\r
144	if ($temp[2] eq $settings{'NAME'} && $temp[2] ne '') {\r
145	$errormessage .= $spacer.$Lang::tr{'duplicate name'};\r
146	$spacer=" & ";\r
147	}\r
148	}\r
149	$idx++;\r
150	}\r
151	unless ($errormessage) {\r
152	if ($settings{'KEY1'} eq '') { #add or edit ?\r
153	unshift (@current, "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n");\r
154	&General::log($Lang::tr{'ip alias added'});\r
155	} else {\r
156	@current[$settings{'KEY1'}] = "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n";\r
157	$settings{'KEY1'} = ''; # End edit mode\r
158	&General::log($Lang::tr{'ip alias changed'});\r
159	}\r
160	\r
161	# Write changes to config file.\r
162	&SortDataFile; # sort newly added/modified entry\r
163	\r
164	&BuildConfiguration; # then re-build conf which use new data\r
165	\r
166	##\r
167	## if entering data line is repetitive, choose here to not erase fields between each addition\r
168	##\r
169	map ($settings{$_}='' ,@nosaved); # Clear fields\r
170	}\r
171	}\r
172	\r
173	if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {\r
174	#move out new line\r
175	my $line = @current[$settings{'KEY1'}]; # KEY1 is the index in current\r
176	chomp($line);\r
177	my @temp = split(/\,/, $line);\r
178	\r
179	##\r
180	## move data fields to Setting2 for edition\r
181	##\r
182	$settings{'IP'}=$temp[0]; # Prepare the screen for editing\r
183	$settings{'ENABLED'}=$temp[1];\r
184	$settings{'NAME'}=$temp[2];\r
185	}\r
186	\r
187	if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {\r
188	splice (@current,$settings{'KEY1'},1); # Delete line \r
189	open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
190	print FILE @current;\r
191	close(FILE);\r
192	$settings{'KEY1'} = ''; # End remove mode\r
193	&General::log($Lang::tr{'ip alias removed'});\r
194	\r
195	&BuildConfiguration; # then re-build conf which use new data\r
196	}\r
197	\r
198	\r
199	\r
200	## Check if sorting is asked\r
201	# If same column clicked, reverse the sort.\r
202	if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {\r
203	my $newsort=$ENV{'QUERY_STRING'};\r
204	my $actual=$netsettings{'SORT_ALIASES'};\r
205	#Reverse actual sort ?\r
206	if ($actual =~ $newsort) {\r
207	my $Rev='';\r
208	if ($actual !~ 'Rev') {\r
209	$Rev='Rev';\r
210	}\r
211	$newsort.=$Rev;\r
212	}\r
213	$netsettings{'SORT_ALIASES'}=$newsort;\r
214	&General::writehash($setting, \%netsettings);\r
215	&SortDataFile;\r
216	$settings{'ACTION'} = 'SORT'; # Recreate 'ACTION'\r
217	}\r
218	\r
219	# Default initial value\r
220	if ($settings{'ACTION'} eq '' ) { # First launch from GUI\r
221	$settings{'ENABLED'} ='on';\r
222	}\r
223	\r
224	&Header::openpage($Lang::tr{'external aliases configuration'}, 1, '');\r
225	&Header::openbigbox('100%', 'left', '', $errormessage);\r
226	my %checked =(); # Checkbox manipulations\r
227	\r
228	if ($errormessage) {\r
229	&Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
230	print "<font class='base'>$errormessage </font>";\r
231	&Header::closebox();\r
232	}\r
233	unless (( $netsettings{'CONFIG_TYPE'} =~ /^(2\|3\|6\|7)$/ ) && ($netsettings{'RED_TYPE'} eq 'STATIC'))\r
234	{\r
235	&Header::openbox('100%', 'left', $Lang::tr{'capswarning'});\r
236	print <<END\r
237	<table width='100%'>\r
238	<tr>\r
239	<td width='100%' class='boldbase' align='center'><font color='${Header::colourred}'><b>$Lang::tr{'aliases not active'}</b></font></td>\r
240	</tr>\r
241	</table>\r
242	END\r
243	;\r
244	&Header::closebox();\r
245	}\r
246	\r
247	#\r
248	# Second check box is for editing the list\r
249	#\r
250	$checked{'ENABLED'}{'on'} = ($settings{'ENABLED'} eq '') ? '' : "checked='checked'";\r
251	\r
252	my $buttontext = $Lang::tr{'add'};\r
253	if ($settings{'KEY1'} ne '') {\r
254	$buttontext = $Lang::tr{'update'};\r
255	&Header::openbox('100%', 'left', $Lang::tr{'edit an existing alias'});\r
256	} else {\r
257	&Header::openbox('100%', 'left', $Lang::tr{'add new alias'});\r
258	}\r
259	\r
260	#Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'\r
261	print <<END\r
262	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
263	<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />\r
264	<table width='100%'>\r
265	<tr>\r
266	<td class='base'><font color='${Header::colourred}'>$Lang::tr{'name'}: <img src='/blob.gif' alt='*' /></font></td>\r
267	<td><input type='text' name='NAME' value='$settings{'NAME'}' size='32' /></td>\r
268	<td class='base' align='right'><font color='${Header::colourred}'>$Lang::tr{'alias ip'}: </font></td>\r
269	<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>\r
270	<td class='base' align='right'>$Lang::tr{'enabled'} </td>\r
271	<td><input type='checkbox' name='ENABLED' $checked{'ENABLED'}{'on'} /></td>\r
272	</tr>\r
273	</table>\r
274	<hr />\r
275	<table width='100%'>\r
276	<tr>\r
277	<td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' /> $Lang::tr{'this field may be blank'}</td>\r
278	<td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>\r
279	</tr>\r
280	</table>\r
281	</form>\r
282	END\r
283	;\r
284	&Header::closebox();\r
285	\r
286	#\r
287	# Third box shows the list, in columns\r
288	#\r
289	# Columns headers may content a link. In this case it must be named in $sortstring\r
290	#\r
291	&Header::openbox('100%', 'left', $Lang::tr{'current aliases'});\r
292	print <<END\r
293	<table width='100%'>\r
294	<tr>\r
295	<td width='50%' align='center'><a href='$ENV{'SCRIPT_NAME'}?NAME'><b>$Lang::tr{'name'}</b></a></td>\r
296	<td width='40%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a></td>\r
297	<td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>\r
298	</tr>\r
299	END\r
300	;\r
301	\r
302	#\r
303	# Print each line of @current list\r
304	#\r
305	# each data line is splitted into @temp.\r
306	#\r
307	\r
308	my $key = 0;\r
309	foreach my $line (@current) {\r
310	chomp($line);\r
311	my @temp = split(/\,/,$line);\r
312	\r
313	#Choose icon for checkbox\r
314	my $gif = '';\r
315	my $gdesc = '';\r
316	if ($temp[1] eq "on") {\r
317	$gif = 'on.gif';\r
318	$gdesc = $Lang::tr{'click to disable'};\r
319	} else {\r
320	$gif = 'off.gif';\r
321	$gdesc = $Lang::tr{'click to enable'}; \r
322	}\r
323	\r
324	#Colorize each line\r
325	if ($settings{'KEY1'} eq $key) {\r
326	print "<tr bgcolor='${Header::colouryellow}'>";\r
327	} elsif ($key % 2) {\r
328	print "<tr bgcolor='${Header::table2colour}'>";\r
329	} else {\r
330	print "<tr bgcolor='${Header::table1colour}'>"; \r
331	}\r
332	\r
333	print <<END\r
334	<td align='center'>$temp[2]</td>\r
335	<td align='center'>$temp[0]</td>\r
336	\r
337	<td align='center'>\r
338	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
339	<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />\r
340	<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />\r
341	<input type='hidden' name='KEY1' value='$key' />\r
342	</form>\r
343	</td>\r
344	\r
345	<td align='center'>\r
346	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
347	<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />\r
348	<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />\r
349	<input type='hidden' name='KEY1' value='$key' />\r
350	</form>\r
351	</td>\r
352	\r
353	<td align='center'>\r
354	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
355	<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />\r
356	<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />\r
357	<input type='hidden' name='KEY1' value='$key' />\r
358	</form>\r
359	</td>\r
360	</tr>\r
361	END\r
362	;\r
363	$key++;\r
364	}\r
365	print "</table>";\r
366	\r
367	# If table contains entries, print 'Key to action icons'\r
368	if ($key) {\r
369	print <<END\r
370	<table>\r
371	<tr>\r
372	<td class='boldbase'> <b>$Lang::tr{'legend'}: </b></td>\r
373	<td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>\r
374	<td class='base'>$Lang::tr{'click to disable'}</td>\r
375	<td>  </td>\r
376	<td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>\r
377	<td class='base'>$Lang::tr{'click to enable'}</td>\r
378	<td>  </td>\r
379	<td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>\r
380	<td class='base'>$Lang::tr{'edit'}</td>\r
381	<td>  </td>\r
382	<td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>\r
383	<td class='base'>$Lang::tr{'remove'}</td>\r
384	</tr>\r
385	</table>\r
386	END\r
387	;\r
388	}\r
389	\r
390	&Header::closebox();\r
391	&Header::closebigbox();\r
392	&Header::closepage();\r
393	\r
394	## Ouf it's the end !\r
395	\r
396	\r
397	\r
398	# Sort the "current" array according to choices\r
399	sub SortDataFile\r
400	{\r
401	our %entries = ();\r
402	\r
403	# Sort pair of record received in $a $b special vars.\r
404	# When IP is specified use numeric sort else alpha.\r
405	# If sortname ends with 'Rev', do reverse sort.\r
406	#\r
407	sub fixedleasesort {\r
408	my $qs=''; # The sort field specified minus 'Rev'\r
409	if (rindex ($netsettings{'SORT_ALIASES'},'Rev') != -1) {\r
410	$qs=substr ($netsettings{'SORT_ALIASES'},0,length($netsettings{'SORT_ALIASES'})-3);\r
411	if ($qs eq 'IP') {\r
412	my @a = split(/\./,$entries{$a}->{$qs});\r
413	my @b = split(/\./,$entries{$b}->{$qs});\r
414	($b[0]<=>$a[0]) \|\|\r
415	($b[1]<=>$a[1]) \|\|\r
416	($b[2]<=>$a[2]) \|\|\r
417	($b[3]<=>$a[3]);\r
418	} else {\r
419	$entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r
420	}\r
421	} else { #not reverse\r
422	$qs=$netsettings{'SORT_ALIASES'};\r
423	if ($qs eq 'IP') {\r
424	my @a = split(/\./,$entries{$a}->{$qs});\r
425	my @b = split(/\./,$entries{$b}->{$qs});\r
426	($a[0]<=>$b[0]) \|\|\r
427	($a[1]<=>$b[1]) \|\|\r
428	($a[2]<=>$b[2]) \|\|\r
429	($a[3]<=>$b[3]);\r
430	} else {\r
431	$entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r
432	}\r
433	}\r
434	}\r
435	\r
436	#Use an associative array (%entries)\r
437	my $key = 0;\r
438	foreach my $line (@current) {\r
439	chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)\r
440	my @temp = split (',',$line);\r
441	\r
442	# Build a pair 'Field Name',value for each of the data dataline.\r
443	# Each SORTABLE field must have is pair.\r
444	# Other data fields (non sortable) can be grouped in one\r
445	\r
446	# Exemple\r
447	# F1,F2,F3,F4,F5 only F1 F2 for sorting\r
448	# my @record = ('KEY',$key++,\r
449	# 'F1',$temp[0],\r
450	# 'F2',$temp[1],\r
451	# 'DATA',join(',',@temp[2..4]) ); #group remainning values, with separator (,)\r
452	\r
453	# The KEY,key record permits doublons. If removed, then F1 becomes the key without doublon permitted.\r
454	\r
455	\r
456	my @record = ('KEY',$key++,'IP',$temp[0],'ENABLED',$temp[1],'NAME',$temp[2]);\r
457	my $record = {}; # create a reference to empty hash\r
458	%{$record} = @record; # populate that hash with @record\r
459	$entries{$record->{KEY}} = $record; # add this to a hash of hashes\r
460	}\r
461	\r
462	open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
463	\r
464	# Each field value is printed , with the newline ! Don't forget separator and order of them.\r
465	foreach my $entry (sort fixedleasesort keys %entries) {\r
466	print FILE "$entries{$entry}->{IP},$entries{$entry}->{ENABLED},$entries{$entry}->{NAME}\n";\r
467	}\r
468	\r
469	close(FILE);\r
470	# Reload sorted @current\r
471	open (FILE, "$datafile");\r
472	@current = <FILE>;\r
473	close (FILE);\r
474	}\r
475	\r
476	# \r
477	# Build the configuration file for application aliases\r
478	#\r
479	sub BuildConfiguration {\r
480	# Restart service associated with this\r
481	system '/usr/local/bin/setaliases';\r
482	}\r