html/cgi-bin/aliases.cgi

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