html/cgi-bin/aliases.cgi

   1 #!/usr/bin/perl
   2 #
   3 # IPFire CGI's - aliases.cgi
   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
  20 require 'CONFIG_ROOT/general-functions.pl';     # replace CONFIG_ROOT with /var/ipfire in case of manual install
  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&nbsp;</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'}:&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>
 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'>&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>
 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 }