[people/teissler/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.18 2006/12/08 21:59:59 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 '/var/ipfire/general-functions.pl';	# replace /var/ipcop 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' ? 'off' : 'on';		# Toggle the field\r
    $temp[2] = '' if ( $temp[2] eq '' );\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'} =~ /^(1|2|3|4)$/ ) && ($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 'on') ? "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='55%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>\r
    <td width='40%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>\r
    <td width='5%' align='right'> \r
        <a href='${General::adminmanualurl}/section-dialup.html#services-extalias' target='_blank'><img src='/images/web-support.png' title='$Lang::tr{'online help en'}' /></a>\r
    </td>\r
</tr>\r
</table>\r
</form>\r
END\r
;\r
&Header::closebox();\r
\r
# Add visual indicators to column headings to show sort order - EO\r
my $sortarrow1 = '';\r
my $sortarrow2 = '';\r
\r
if ($netsettings{'SORT_ALIASES'} eq 'NAMERev') {\r
	$sortarrow1 = $Header::sortdn;\r
} elsif ($netsettings{'SORT_ALIASES'} eq 'NAME') {\r
	$sortarrow1 = $Header::sortup;\r
} elsif ($netsettings{'SORT_ALIASES'} eq 'IPRev') {\r
	$sortarrow2 = $Header::sortdn;\r
} else {\r
	$sortarrow2 = $Header::sortup;\r
}\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> $sortarrow1</td>\r
    <td width='45%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a> $sortarrow2</td>\r
    <td width='5%' 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
69fe68ee PP	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.18 2006/12/08 21:59:59 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 '/var/ipfire/general-functions.pl'; # replace /var/ipcop 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' ? 'off' : 'on'; # Toggle the field\r
110	$temp[2] = '' if ( $temp[2] eq '' );\r
111	@current[$settings{'KEY1'}] = join (',',@temp)."\n";\r
112	$settings{'KEY1'} = ''; # End edit mode\r
113	\r
114	&General::log($Lang::tr{'ip alias changed'});\r
115	\r
116	#Save current\r
117	open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
118	print FILE @current;\r
119	close(FILE);\r
120	\r
121	# Rebuild configuration file\r
122	&BuildConfiguration;\r
123	}\r
124	\r
125	if ($settings{'ACTION'} eq $Lang::tr{'add'}) {\r
126	# Validate inputs\r
127	if (! &General::validip($settings{'IP'})) {$errormessage = "invalid ip"};\r
128	$settings{'NAME'} = &Header::cleanhtml($settings{'NAME'});\r
129	\r
130	# Make sure we haven't duplicated an alias or RED\r
131	my $spacer='';\r
132	if ($settings{'IP'} eq $netsettings{'RED_ADDRESS'}) {\r
133	$errormessage = $Lang::tr{'duplicate ip'} . ' (RED)';\r
134	$spacer=" & ";\r
135	}\r
136	my $idx=0;\r
137	foreach my $line (@current) {\r
138	chomp ($line);\r
139	my @temp = split (/\,/, $line);\r
140	if ( ($settings{'KEY1'} eq '')\|\|(($settings{'KEY1'} ne '') && ($settings{'KEY1'} != $idx))) { # update\r
141	if ($temp[0] eq $settings{'IP'}) {\r
142	$errormessage .= $spacer.$Lang::tr{'duplicate ip'};\r
143	$spacer=" & ";\r
144	}\r
145	if ($temp[2] eq $settings{'NAME'} && $temp[2] ne '') {\r
146	$errormessage .= $spacer.$Lang::tr{'duplicate name'};\r
147	$spacer=" & ";\r
148	}\r
149	}\r
150	$idx++;\r
151	}\r
152	unless ($errormessage) {\r
153	if ($settings{'KEY1'} eq '') { #add or edit ?\r
154	unshift (@current, "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n");\r
155	&General::log($Lang::tr{'ip alias added'});\r
156	} else {\r
157	@current[$settings{'KEY1'}] = "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n";\r
158	$settings{'KEY1'} = ''; # End edit mode\r
159	&General::log($Lang::tr{'ip alias changed'});\r
160	}\r
161	\r
162	# Write changes to config file.\r
163	&SortDataFile; # sort newly added/modified entry\r
164	\r
165	&BuildConfiguration; # then re-build conf which use new data\r
166	\r
167	##\r
168	## if entering data line is repetitive, choose here to not erase fields between each addition\r
169	##\r
170	map ($settings{$_}='' ,@nosaved); # Clear fields\r
171	}\r
172	}\r
173	\r
174	if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {\r
175	#move out new line\r
176	my $line = @current[$settings{'KEY1'}]; # KEY1 is the index in current\r
177	chomp($line);\r
178	my @temp = split(/\,/, $line);\r
179	\r
180	##\r
181	## move data fields to Setting2 for edition\r
182	##\r
183	$settings{'IP'}=$temp[0]; # Prepare the screen for editing\r
184	$settings{'ENABLED'}=$temp[1];\r
185	$settings{'NAME'}=$temp[2];\r
186	}\r
187	\r
188	if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {\r
189	splice (@current,$settings{'KEY1'},1); # Delete line \r
190	open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
191	print FILE @current;\r
192	close(FILE);\r
193	$settings{'KEY1'} = ''; # End remove mode\r
194	&General::log($Lang::tr{'ip alias removed'});\r
195	\r
196	&BuildConfiguration; # then re-build conf which use new data\r
197	}\r
198	\r
199	\r
200	\r
201	## Check if sorting is asked\r
202	# If same column clicked, reverse the sort.\r
203	if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {\r
204	my $newsort=$ENV{'QUERY_STRING'};\r
205	my $actual=$netsettings{'SORT_ALIASES'};\r
206	#Reverse actual sort ?\r
207	if ($actual =~ $newsort) {\r
208	my $Rev='';\r
209	if ($actual !~ 'Rev') {\r
210	$Rev='Rev';\r
211	}\r
212	$newsort.=$Rev;\r
213	}\r
214	$netsettings{'SORT_ALIASES'}=$newsort;\r
215	&General::writehash($setting, \%netsettings);\r
216	&SortDataFile;\r
217	$settings{'ACTION'} = 'SORT'; # Recreate 'ACTION'\r
218	}\r
219	\r
220	# Default initial value\r
221	if ($settings{'ACTION'} eq '' ) { # First launch from GUI\r
222	$settings{'ENABLED'} ='on';\r
223	}\r
224	\r
225	&Header::openpage($Lang::tr{'external aliases configuration'}, 1, '');\r
226	&Header::openbigbox('100%', 'left', '', $errormessage);\r
227	my %checked =(); # Checkbox manipulations\r
228	\r
229	if ($errormessage) {\r
230	&Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
231	print "<font class='base'>$errormessage </font>";\r
232	&Header::closebox();\r
233	}\r
234	unless (( $netsettings{'CONFIG_TYPE'} =~ /^(1\|2\|3\|4)$/ ) && ($netsettings{'RED_TYPE'} eq 'STATIC'))\r
235	{\r
236	&Header::openbox('100%', 'left', $Lang::tr{'capswarning'});\r
237	print <<END\r
238	<table width='100%'>\r
239	<tr>\r
240	<td width='100%' class='boldbase' align='center'><font color='${Header::colourred}'><b>$Lang::tr{'aliases not active'}</b></font></td>\r
241	</tr>\r
242	</table>\r
243	END\r
244	;\r
245	&Header::closebox();\r
246	}\r
247	\r
248	#\r
249	# Second check box is for editing the list\r
250	#\r
251	$checked{'ENABLED'}{'on'} = ($settings{'ENABLED'} eq 'on') ? "checked='checked'" : '' ;\r
252	\r
253	my $buttontext = $Lang::tr{'add'};\r
254	if ($settings{'KEY1'} ne '') {\r
255	$buttontext = $Lang::tr{'update'};\r
256	&Header::openbox('100%', 'left', $Lang::tr{'edit an existing alias'});\r
257	} else {\r
258	&Header::openbox('100%', 'left', $Lang::tr{'add new alias'});\r
259	}\r
260	\r
261	#Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'\r
262	print <<END\r
263	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
264	<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />\r
265	<table width='100%'>\r
266	<tr>\r
267	<td class='base'><font color='${Header::colourred}'>$Lang::tr{'name'}: <img src='/blob.gif' alt='*' /></font></td>\r
268	<td><input type='text' name='NAME' value='$settings{'NAME'}' size='32' /></td>\r
269	<td class='base' align='right'><font color='${Header::colourred}'>$Lang::tr{'alias ip'}: </font></td>\r
270	<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>\r
271	<td class='base' align='right'>$Lang::tr{'enabled'} </td>\r
272	<td><input type='checkbox' name='ENABLED' $checked{'ENABLED'}{'on'} /></td>\r
273	</tr>\r
274	</table>\r
275	<hr />\r
276	<table width='100%'>\r
277	<tr>\r
278	<td class='base' width='55%'><img src='/blob.gif' align='top' alt='*' /> $Lang::tr{'this field may be blank'}</td>\r
279	<td width='40%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>\r
280	<td width='5%' align='right'> \r
281	<a href='${General::adminmanualurl}/section-dialup.html#services-extalias' target='_blank'><img src='/images/web-support.png' title='$Lang::tr{'online help en'}' /></a>\r
282	</td>\r
283	</tr>\r
284	</table>\r
285	</form>\r
286	END\r
287	;\r
288	&Header::closebox();\r
289	\r
290	# Add visual indicators to column headings to show sort order - EO\r
291	my $sortarrow1 = '';\r
292	my $sortarrow2 = '';\r
293	\r
294	if ($netsettings{'SORT_ALIASES'} eq 'NAMERev') {\r
295	$sortarrow1 = $Header::sortdn;\r
296	} elsif ($netsettings{'SORT_ALIASES'} eq 'NAME') {\r
297	$sortarrow1 = $Header::sortup;\r
298	} elsif ($netsettings{'SORT_ALIASES'} eq 'IPRev') {\r
299	$sortarrow2 = $Header::sortdn;\r
300	} else {\r
301	$sortarrow2 = $Header::sortup;\r
302	}\r
303	\r
304	#\r
305	# Third box shows the list, in columns\r
306	#\r
307	# Columns headers may content a link. In this case it must be named in $sortstring\r
308	#\r
309	&Header::openbox('100%', 'left', $Lang::tr{'current aliases'});\r
310	print <<END\r
311	<table width='100%'>\r
312	<tr>\r
313	<td width='50%' align='center'><a href='$ENV{'SCRIPT_NAME'}?NAME'><b>$Lang::tr{'name'}</b></a> $sortarrow1</td>\r
314	<td width='45%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a> $sortarrow2</td>\r
315	<td width='5%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>\r
316	</tr>\r
317	END\r
318	;\r
319	\r
320	#\r
321	# Print each line of @current list\r
322	#\r
323	# each data line is splitted into @temp.\r
324	#\r
325	\r
326	my $key = 0;\r
327	foreach my $line (@current) {\r
328	chomp($line);\r
329	my @temp = split(/\,/,$line);\r
330	\r
331	#Choose icon for checkbox\r
332	my $gif = '';\r
333	my $gdesc = '';\r
334	if ($temp[1] eq "on") {\r
335	$gif = 'on.gif';\r
336	$gdesc = $Lang::tr{'click to disable'};\r
337	} else {\r
338	$gif = 'off.gif';\r
339	$gdesc = $Lang::tr{'click to enable'}; \r
340	}\r
341	\r
342	#Colorize each line\r
343	if ($settings{'KEY1'} eq $key) {\r
344	print "<tr bgcolor='${Header::colouryellow}'>";\r
345	} elsif ($key % 2) {\r
346	print "<tr bgcolor='${Header::table2colour}'>";\r
347	} else {\r
348	print "<tr bgcolor='${Header::table1colour}'>"; \r
349	}\r
350	\r
351	print <<END\r
352	<td align='center'>$temp[2]</td>\r
353	<td align='center'>$temp[0]</td>\r
354	\r
355	<td align='center'>\r
356	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
357	<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />\r
358	<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />\r
359	<input type='hidden' name='KEY1' value='$key' />\r
360	</form>\r
361	</td>\r
362	\r
363	<td align='center'>\r
364	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
365	<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />\r
366	<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />\r
367	<input type='hidden' name='KEY1' value='$key' />\r
368	</form>\r
369	</td>\r
370	\r
371	<td align='center'>\r
372	<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
373	<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />\r
374	<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />\r
375	<input type='hidden' name='KEY1' value='$key' />\r
376	</form>\r
377	</td>\r
378	</tr>\r
379	END\r
380	;\r
381	$key++;\r
382	}\r
383	print "</table>";\r
384	\r
385	# If table contains entries, print 'Key to action icons'\r
386	if ($key) {\r
387	print <<END\r
388	<table>\r
389	<tr>\r
390	<td class='boldbase'> <b>$Lang::tr{'legend'}: </b></td>\r
391	<td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>\r
392	<td class='base'>$Lang::tr{'click to disable'}</td>\r
393	<td>  </td>\r
394	<td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>\r
395	<td class='base'>$Lang::tr{'click to enable'}</td>\r
396	<td>  </td>\r
397	<td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>\r
398	<td class='base'>$Lang::tr{'edit'}</td>\r
399	<td>  </td>\r
400	<td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>\r
401	<td class='base'>$Lang::tr{'remove'}</td>\r
402	</tr>\r
403	</table>\r
404	END\r
405	;\r
406	}\r
407	\r
408	&Header::closebox();\r
409	&Header::closebigbox();\r
410	&Header::closepage();\r
411	\r
412	## Ouf it's the end !\r
413	\r
414	\r
415	\r
416	# Sort the "current" array according to choices\r
417	sub SortDataFile\r
418	{\r
419	our %entries = ();\r
420	\r
421	# Sort pair of record received in $a $b special vars.\r
422	# When IP is specified use numeric sort else alpha.\r
423	# If sortname ends with 'Rev', do reverse sort.\r
424	#\r
425	sub fixedleasesort {\r
426	my $qs=''; # The sort field specified minus 'Rev'\r
427	if (rindex ($netsettings{'SORT_ALIASES'},'Rev') != -1) {\r
428	$qs=substr ($netsettings{'SORT_ALIASES'},0,length($netsettings{'SORT_ALIASES'})-3);\r
429	if ($qs eq 'IP') {\r
430	my @a = split(/\./,$entries{$a}->{$qs});\r
431	my @b = split(/\./,$entries{$b}->{$qs});\r
432	($b[0]<=>$a[0]) \|\|\r
433	($b[1]<=>$a[1]) \|\|\r
434	($b[2]<=>$a[2]) \|\|\r
435	($b[3]<=>$a[3]);\r
436	} else {\r
437	$entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r
438	}\r
439	} else { #not reverse\r
440	$qs=$netsettings{'SORT_ALIASES'};\r
441	if ($qs eq 'IP') {\r
442	my @a = split(/\./,$entries{$a}->{$qs});\r
443	my @b = split(/\./,$entries{$b}->{$qs});\r
444	($a[0]<=>$b[0]) \|\|\r
445	($a[1]<=>$b[1]) \|\|\r
446	($a[2]<=>$b[2]) \|\|\r
447	($a[3]<=>$b[3]);\r
448	} else {\r
449	$entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r
450	}\r
451	}\r
452	}\r
453	\r
454	#Use an associative array (%entries)\r
455	my $key = 0;\r
456	foreach my $line (@current) {\r
457	chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)\r
458	my @temp = split (',',$line);\r
459	\r
460	# Build a pair 'Field Name',value for each of the data dataline.\r
461	# Each SORTABLE field must have is pair.\r
462	# Other data fields (non sortable) can be grouped in one\r
463	\r
464	# Exemple\r
465	# F1,F2,F3,F4,F5 only F1 F2 for sorting\r
466	# my @record = ('KEY',$key++,\r
467	# 'F1',$temp[0],\r
468	# 'F2',$temp[1],\r
469	# 'DATA',join(',',@temp[2..4]) ); #group remainning values, with separator (,)\r
470	\r
471	# The KEY,key record permits doublons. If removed, then F1 becomes the key without doublon permitted.\r
472	\r
473	\r
474	my @record = ('KEY',$key++,'IP',$temp[0],'ENABLED',$temp[1],'NAME',$temp[2]);\r
475	my $record = {}; # create a reference to empty hash\r
476	%{$record} = @record; # populate that hash with @record\r
477	$entries{$record->{KEY}} = $record; # add this to a hash of hashes\r
478	}\r
479	\r
480	open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
481	\r
482	# Each field value is printed , with the newline ! Don't forget separator and order of them.\r
483	foreach my $entry (sort fixedleasesort keys %entries) {\r
484	print FILE "$entries{$entry}->{IP},$entries{$entry}->{ENABLED},$entries{$entry}->{NAME}\n";\r
485	}\r
486	\r
487	close(FILE);\r
488	# Reload sorted @current\r
489	open (FILE, "$datafile");\r
490	@current = <FILE>;\r
491	close (FILE);\r
492	}\r
493	\r
494	# \r
495	# Build the configuration file for application aliases\r
496	#\r
497	sub BuildConfiguration {\r
498	# Restart service associated with this\r
499	system '/usr/local/bin/setaliases';\r
500	}\r