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

#!/usr/bin/perl
#
# IPFire CGI's - aliases.cgi
#
# This code is distributed under the terms of the GPL
#
# (c) Steve Bootes 2002/04/13 - Manage IP Aliases
#
# $Id: aliases.cgi,v 1.5.2.14 2006/01/13 20:14:48 eoberlander Exp $


# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines
#use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work
# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help
use warnings;
use strict;
#use Carp ();
#local $SIG{__WARN__} = \&Carp::cluck;

require '/var/ipfire/general-functions.pl';	# replace /var/ipfire with /var/ipfire in case of manual install
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::colouryellow} );
   @dummy = ( ${Header::table1colour} );
   @dummy = ( ${Header::table2colour} );
undef (@dummy);

# Files used
my $setting = "${General::swroot}/ethernet/settings";
our $datafile = "${General::swroot}/ethernet/aliases";


our %settings=();
#Settings1

#Settings2 for editing the multi-line list
#Must not be saved !
$settings{'IP'} = '';
$settings{'ENABLED'} = 'off';		# Every check box must be set to off
$settings{'NAME'} = '';
my @nosaved=('IP','ENABLED','NAME');	# List here ALL setting2 fields. Mandatory
    
$settings{'ACTION'} = '';		# add/edit/remove
$settings{'KEY1'} = '';			# point record for ACTION

#Define each field that can be used to sort columns
my $sortstring='^IP|^NAME';
my $errormessage = '';
my $warnmessage = '';

&Header::showhttpheaders();

# Read needed Ipcop netsettings
my %netsettings=();
$netsettings{'SORT_ALIASES'} = 'NAME'; 	# default sort
&General::readhash($setting, \%netsettings);

#Get GUI values
&Header::getcgihash(\%settings);

# Load multiline data
our @current = ();
if (open(FILE, "$datafile")) {
    @current = <FILE>;
    close (FILE);
}

#
# Check Settings1 first because they are needed before working on @current
#
# Remove if no Setting1 needed
#
if ($settings{'ACTION'} eq $Lang::tr{'save'}) {
    
    #
    #Validate static Settings1 here
    #
    
    unless ($errormessage) {					# Everything is ok, save settings
	#map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved 
	#&General::writehash($setting, \%settings);		# Save good settings
	#$settings{'ACTION'} = $Lang::tr{'save'};		# Recreate  'ACTION'
	#map ($settings{$_}= '',(@nosaved,'KEY1'));		# and reinit var to empty
	
	# Rebuild configuration file if needed
	&BuildConfiguration;
    }

    ERROR:						# Leave the faulty field untouched
} else {
    #&General::readhash($setting, \%settings);  	# Get saved settings and reset to good if needed
}

## Now manipulate the multi-line list with Settings2
# Basic actions are:
#	toggle the check box
#	add/update a new line
#	begin editing a line
#	remove a line


# Toggle enable/disable field.  Field is in second position
if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {
    #move out new line
    chomp(@current[$settings{'KEY1'}]);
    my @temp = split(/\,/,@current[$settings{'KEY1'}]);
    $temp[1] = $temp[1] eq 'on' ? '' : 'on';		# Toggle the field
    @current[$settings{'KEY1'}] = join (',',@temp)."\n";
    $settings{'KEY1'} = ''; 				# End edit mode
    
    &General::log($Lang::tr{'ip alias changed'});
    
    #Save current
    open(FILE, ">$datafile") or die 'Unable to open aliases file.';
    print FILE @current;
    close(FILE);
	
    # Rebuild configuration file
    &BuildConfiguration;
}

if ($settings{'ACTION'} eq $Lang::tr{'add'}) {
    # Validate inputs
    if (! &General::validip($settings{'IP'})) {$errormessage = "invalid ip"};
    $settings{'NAME'} = &Header::cleanhtml($settings{'NAME'});

    # Make sure we haven't duplicated an alias or RED
    my $spacer='';
    if ($settings{'IP'} eq $netsettings{'RED_ADDRESS'}) {
	$errormessage = $Lang::tr{'duplicate ip'} . ' (RED)';
        $spacer=" & ";
    }
    my $idx=0;
    foreach my $line (@current) {
        chomp ($line);
        my @temp = split (/\,/, $line);
        if ( ($settings{'KEY1'} eq '')||(($settings{'KEY1'} ne '') && ($settings{'KEY1'} != $idx))) { # update
	    if ($temp[0] eq $settings{'IP'}) {
	        $errormessage .= $spacer.$Lang::tr{'duplicate ip'};
	        $spacer=" & ";
	    }
	    if ($temp[2] eq $settings{'NAME'} && $temp[2] ne '') {
		$errormessage .= $spacer.$Lang::tr{'duplicate name'};
		$spacer=" & ";
		}
	}
	$idx++;
    }
    unless ($errormessage) {
	if ($settings{'KEY1'} eq '') { #add or edit ?
	    unshift (@current, "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n");
	    &General::log($Lang::tr{'ip alias added'});
	} else {
	    @current[$settings{'KEY1'}] = "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n";
	    $settings{'KEY1'} = '';       # End edit mode
	    &General::log($Lang::tr{'ip alias changed'});
	}

	# Write changes to config file.
	&SortDataFile;				# sort newly added/modified entry

	&BuildConfiguration;			# then re-build conf which use new data
	
##
## if entering data line is repetitive, choose here to not erase fields between each addition
##
	map ($settings{$_}='' ,@nosaved);	# Clear fields
    }
}

if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {
    #move out new line
    my $line = @current[$settings{'KEY1'}];	# KEY1 is the index in current
    chomp($line);
    my @temp = split(/\,/, $line);

##
## move data fields to Setting2 for edition
##
    $settings{'IP'}=$temp[0];			# Prepare the screen for editing
    $settings{'ENABLED'}=$temp[1];
    $settings{'NAME'}=$temp[2];
}

if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {
    splice (@current,$settings{'KEY1'},1);		# Delete line 
    open(FILE, ">$datafile") or die 'Unable to open aliases file.';
    print FILE @current;
    close(FILE);
    $settings{'KEY1'} = '';				# End remove mode
    &General::log($Lang::tr{'ip alias removed'});

    &BuildConfiguration;				# then re-build conf which use new data
}


##  Check if sorting is asked
# If same column clicked, reverse the sort.
if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {
    my $newsort=$ENV{'QUERY_STRING'};
    my $actual=$netsettings{'SORT_ALIASES'};
    #Reverse actual sort ?
    if ($actual =~ $newsort) {
	my $Rev='';
	if ($actual !~ 'Rev') {
	    $Rev='Rev';
	}
	$newsort.=$Rev;
    }
    $netsettings{'SORT_ALIASES'}=$newsort;
    &General::writehash($setting, \%netsettings);
    &SortDataFile;
    $settings{'ACTION'} = 'SORT';			# Recreate  'ACTION'
}

# Default initial value
if ($settings{'ACTION'} eq '' ) { # First launch from GUI
    $settings{'ENABLED'} ='on';
}
    
&Header::openpage($Lang::tr{'external aliases configuration'}, 1, '');
&Header::openbigbox('100%', 'left', '', $errormessage);
my %checked =();     # Checkbox manipulations

if ($errormessage) {
    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
    print "<font class='base'>$errormessage&nbsp;</font>";
    &Header::closebox();
}
unless (( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ ) && ($netsettings{'RED_TYPE'} eq 'STATIC'))
{
    &Header::openbox('100%', 'left', $Lang::tr{'capswarning'});
    print <<END
    <table width='100%'>
    <tr>
    <td width='100%' class='boldbase' align='center'><font color='${Header::colourred}'><b>$Lang::tr{'aliases not active'}</b></font></td>
    </tr>
    </table>
END
;
    &Header::closebox();
}
									
#
# Second check box is for editing the list
#
$checked{'ENABLED'}{'on'} = ($settings{'ENABLED'} eq '') ? '' :  "checked='checked'";

my $buttontext = $Lang::tr{'add'};
if ($settings{'KEY1'} ne '') {
    $buttontext = $Lang::tr{'update'};
    &Header::openbox('100%', 'left', $Lang::tr{'edit an existing alias'});
} else {
    &Header::openbox('100%', 'left', $Lang::tr{'add new alias'});
}

#Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'
print <<END
<form method='post' action='$ENV{'SCRIPT_NAME'}'>
<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />
<table width='100%'>
<tr>
<td class='base'><font color='${Header::colourred}'>$Lang::tr{'name'}:&nbsp;<img src='/blob.gif' alt='*' /></font></td>
<td><input type='text' name='NAME' value='$settings{'NAME'}' size='32' /></td>
<td class='base' align='right'><font color='${Header::colourred}'>$Lang::tr{'alias ip'}:&nbsp;</font></td>
<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>
<td class='base' align='right'>$Lang::tr{'enabled'}&nbsp;</td>
<td><input type='checkbox' name='ENABLED' $checked{'ENABLED'}{'on'} /></td>
</tr>
</table>
<hr />
<table width='100%'>
<tr>
    <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>
    <td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>
</tr>
</table>
</form>
END
;
&Header::closebox();

#
# Third box shows the list, in columns
#
# Columns headers may content a link. In this case it must be named in $sortstring
#
&Header::openbox('100%', 'left', $Lang::tr{'current aliases'});
print <<END
<table width='100%'>
<tr>
    <td width='50%' align='center'><a href='$ENV{'SCRIPT_NAME'}?NAME'><b>$Lang::tr{'name'}</b></a></td>
    <td width='40%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a></td>
    <td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>
</tr>
END
;

#
# Print each line of @current list
#
# each data line is splitted into @temp.
#

my $key = 0;
foreach my $line (@current) {
    chomp($line);
    my @temp = split(/\,/,$line);

    #Choose icon for checkbox
    my $gif = '';
    my $gdesc = '';
    if ($temp[1] eq "on") {
	$gif = 'on.gif';
	$gdesc = $Lang::tr{'click to disable'};
    } else {
	$gif = 'off.gif';
	$gdesc = $Lang::tr{'click to enable'}; 
    }

    #Colorize each line
    if ($settings{'KEY1'} eq $key) {
	print "<tr bgcolor='${Header::colouryellow}'>";
    } elsif ($key % 2) {
	print "<tr bgcolor='${Header::table2colour}'>";
    } else {
	print "<tr bgcolor='${Header::table1colour}'>"; 
    }

    print <<END
<td align='center'>$temp[2]</td>
<td align='center'>$temp[0]</td>

<td align='center'>
<form method='post' action='$ENV{'SCRIPT_NAME'}'>
<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />
<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />
<input type='hidden' name='KEY1' value='$key' />
</form>
</td>

<td align='center'>
<form method='post' action='$ENV{'SCRIPT_NAME'}'>
<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />
<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />
<input type='hidden' name='KEY1' value='$key' />
</form>
</td>

<td align='center'>
<form method='post' action='$ENV{'SCRIPT_NAME'}'>
<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />
<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />
<input type='hidden' name='KEY1' value='$key' />
</form>
</td>
</tr>
END
;
    $key++;
}
print "</table>";

# If table contains entries, print 'Key to action icons'
if ($key) {
print <<END
<table>
<tr>
    <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>
    <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>
    <td class='base'>$Lang::tr{'click to disable'}</td>
    <td>&nbsp;&nbsp;</td>
    <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>
    <td class='base'>$Lang::tr{'click to enable'}</td>
    <td>&nbsp;&nbsp;</td>
    <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>
    <td class='base'>$Lang::tr{'edit'}</td>
    <td>&nbsp;&nbsp;</td>
    <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>
    <td class='base'>$Lang::tr{'remove'}</td>
</tr>
</table>
END
;
}

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

## Ouf it's the end !


# Sort the "current" array according to choices
sub SortDataFile
{
    our %entries = ();
    
    # Sort pair of record received in $a $b special vars.
    # When IP is specified use numeric sort else alpha.
    # If sortname ends with 'Rev', do reverse sort.
    #
    sub fixedleasesort {
	my $qs='';             # The sort field specified minus 'Rev'
	if (rindex ($netsettings{'SORT_ALIASES'},'Rev') != -1) {
	    $qs=substr ($netsettings{'SORT_ALIASES'},0,length($netsettings{'SORT_ALIASES'})-3);
	    if ($qs eq 'IP') {
		my @a = split(/\./,$entries{$a}->{$qs});
		my @b = split(/\./,$entries{$b}->{$qs});
		($b[0]<=>$a[0]) ||
		($b[1]<=>$a[1]) ||
		($b[2]<=>$a[2]) ||
		($b[3]<=>$a[3]);
	    } else {
		$entries{$b}->{$qs} cmp $entries{$a}->{$qs};
	    }
	} else { #not reverse
	    $qs=$netsettings{'SORT_ALIASES'};
	    if ($qs eq 'IP') {
		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]);
	    } else {
		$entries{$a}->{$qs} cmp $entries{$b}->{$qs};
	    }
	}
    }

    #Use an associative array (%entries)
    my $key = 0;
    foreach my $line (@current) {
	chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)
	my @temp = split (',',$line);
	
	# Build a pair 'Field Name',value for each of the data dataline.
	# Each SORTABLE field must have is pair.
	# Other data fields (non sortable) can be grouped in one
	
	# Exemple
	# F1,F2,F3,F4,F5       only F1 F2 for sorting
	# my @record = ('KEY',$key++,
	#		'F1',$temp[0],
	#		'F2',$temp[1],
	#		'DATA',join(',',@temp[2..4])	);  #group remainning values, with separator (,)
	
	# The KEY,key record permits doublons. If removed, then F1 becomes the key without doublon permitted.
	
	
	my @record = ('KEY',$key++,'IP',$temp[0],'ENABLED',$temp[1],'NAME',$temp[2]);
	my $record = {};                        	# create a reference to empty hash
	%{$record} = @record;                		# populate that hash with @record
	$entries{$record->{KEY}} = $record; 		# add this to a hash of hashes
    }
    
    open(FILE, ">$datafile") or die 'Unable to open aliases file.';

    # Each field value is printed , with the newline ! Don't forget separator and order of them.
    foreach my $entry (sort fixedleasesort keys %entries) {
	print FILE "$entries{$entry}->{IP},$entries{$entry}->{ENABLED},$entries{$entry}->{NAME}\n";
    }

    close(FILE);
    # Reload sorted  @current
    open (FILE, "$datafile");
    @current = <FILE>;
    close (FILE);
}

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