Gro├čes Update:
[ipfire-2.x.git] / html / cgi-bin / aliases.cgi
CommitLineData
ac1cfefa
MT
1#!/usr/bin/perl
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
15use warnings;
16use strict;
17#use Carp ();
18#local $SIG{__WARN__} = \&Carp::cluck;
19
78331e30 20require 'CONFIG_ROOT/general-functions.pl'; # replace CONFIG_ROOT with /var/ipfire in case of manual install
ac1cfefa
MT
21require "${General::swroot}/lang.pl";
22require "${General::swroot}/header.pl";
23
24#workaround to suppress a warning when a variable is used only once
25my @dummy = ( ${Header::colouryellow} );
26 @dummy = ( ${Header::table1colour} );
27 @dummy = ( ${Header::table2colour} );
28undef (@dummy);
29
30# Files used
31my $setting = "${General::swroot}/ethernet/settings";
32our $datafile = "${General::swroot}/ethernet/aliases";
33
34
35our %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'} = '';
43my @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
49my $sortstring='^IP|^NAME';
50my $errormessage = '';
51my $warnmessage = '';
52
53&Header::showhttpheaders();
54
55# Read needed Ipcop netsettings
56my %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
64our @current = ();
65if (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#
75if ($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
105if ($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
124if ($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
173if ($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
187if ($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.
202if ($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
220if ($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);
226my %checked =(); # Checkbox manipulations
227
228if ($errormessage) {
229 &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
230 print "<font class='base'>$errormessage&nbsp;</font>";
231 &Header::closebox();
232}
233unless (( $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>
242END
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
252my $buttontext = $Lang::tr{'add'};
253if ($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'
261print <<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'}:&nbsp;<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'}:&nbsp;</font></td>
269<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>
270<td class='base' align='right'>$Lang::tr{'enabled'}&nbsp;</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='*' />&nbsp;$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>
282END
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'});
292print <<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>
299END
300;
301
302#
303# Print each line of @current list
304#
305# each data line is splitted into @temp.
306#
307
308my $key = 0;
309foreach 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>
361END
362;
363 $key++;
364}
365print "</table>";
366
367# If table contains entries, print 'Key to action icons'
368if ($key) {
369print <<END
370<table>
371<tr>
372 <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</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>&nbsp;&nbsp;</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>&nbsp;&nbsp;</td>
379 <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>
380 <td class='base'>$Lang::tr{'edit'}</td>
381 <td>&nbsp;&nbsp;</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>
386END
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
399sub 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#
479sub BuildConfiguration {
480 # Restart service associated with this
481 system '/usr/local/bin/setaliases';
482}