html/cgi-bin/dhcp.cgi

   1 #!/usr/bin/perl
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2007  Michael Tremer & Christian Schmidt                      #
   6 #                                                                             #
   7 # This program is free software: you can redistribute it and/or modify        #
   8 # it under the terms of the GNU General Public License as published by        #
   9 # the Free Software Foundation, either version 3 of the License, or           #
  10 # (at your option) any later version.                                         #
  11 #                                                                             #
  12 # This program is distributed in the hope that it will be useful,             #
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of              #
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
  15 # GNU General Public License for more details.                                #
  16 #                                                                             #
  17 # You should have received a copy of the GNU General Public License           #
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
  19 #                                                                             #
  20 ###############################################################################
  21
  22 use strict;
  23
  24 # enable only the following on debugging purpose
  25 #use warnings;
  26 #use CGI::Carp 'fatalsToBrowser';
  27
  28 require '/var/ipfire/general-functions.pl';
  29 require "${General::swroot}/lang.pl";
  30 require "${General::swroot}/header.pl";
  31 #workaround to suppress a warning when a variable is used only once
  32 my @dummy = ( ${Header::colouryellow} );
  33 undef (@dummy);
  34
  35 our %dhcpsettings=();
  36 our %netsettings=();
  37 my %mainsettings=();
  38 my %timesettings=();
  39 my $setting = "${General::swroot}/dhcp/settings";
  40 our $filename1 = "${General::swroot}/dhcp/advoptions";  # Field separator is TAB in this file (comma is standart)
  41                                                                         # because we need commas in the some data
  42 our $filename2 = "${General::swroot}/dhcp/fixleases";
  43 our $filename3 = "${General::swroot}/dhcp/advoptions-list";     # Describe the allowed syntax for dhcp options
  44 my $errormessage = '';
  45 my $warnNTPmessage = '';
  46 my @nosaved=();
  47 my %color = ();
  48
  49 #Basic syntax allowed for new Option definition. Not implemented: RECORDS & array of RECORDS
  50 our $OptionTypes = 'boolean|((un)?signed )?integer (8|16|32)|ip-address|text|string|encapsulate \w+|array of ip-address';
  51
  52 &Header::showhttpheaders();
  53 our @ITFs=('GREEN');
  54 if (&Header::blue_used()){push(@ITFs,'BLUE');}
  55
  56 #Settings1 for the first screen box
  57 foreach my $itf (@ITFs) {
  58     $dhcpsettings{"ENABLE_${itf}"} = 'off';
  59     $dhcpsettings{"ENABLEBOOTP_${itf}"} = 'off';
  60     $dhcpsettings{"START_ADDR_${itf}"} = '';
  61     $dhcpsettings{"END_ADDR_${itf}"} = '';
  62     $dhcpsettings{"DOMAIN_NAME_${itf}"} = '';
  63     $dhcpsettings{"DEFAULT_LEASE_TIME_${itf}"} = '';
  64     $dhcpsettings{"MAX_LEASE_TIME_${itf}"} = '';
  65     $dhcpsettings{"WINS1_${itf}"} = '';
  66     $dhcpsettings{"WINS2_${itf}"} = '';
  67     $dhcpsettings{"DNS1_${itf}"} = '';
  68     $dhcpsettings{"DNS2_${itf}"} = '';
  69     $dhcpsettings{"NTP1_${itf}"} = '';
  70     $dhcpsettings{"NTP2_${itf}"} = '';
  71     $dhcpsettings{"NEXT_${itf}"} = '';
  72     $dhcpsettings{"FILE_${itf}"} = '';
  73     $dhcpsettings{"DNS_UPDATE_KEY_NAME_${itf}"} = '';
  74     $dhcpsettings{"DNS_UPDATE_KEY_SECRET_${itf}"} = '';
  75     $dhcpsettings{"DNS_UPDATE_KEY_ALGO_${itf}"} = '';
  76 }
  77
  78 $dhcpsettings{'SORT_FLEASELIST'} = 'FIPADDR';
  79 $dhcpsettings{'SORT_LEASELIST'} = 'IPADDR';
  80
  81 # DNS Update settings
  82 $dhcpsettings{'DNS_UPDATE_ENABLED'} = 'off';
  83
  84 #Settings2 for editing the multi-line list
  85 #Must not be saved with writehash !
  86 $dhcpsettings{'FIX_MAC'} = '';
  87 $dhcpsettings{'FIX_ADDR'} = '';
  88 $dhcpsettings{'FIX_ENABLED'} = 'off';
  89 $dhcpsettings{'FIX_NEXTADDR'} = '';
  90 $dhcpsettings{'FIX_FILENAME'} = '';
  91 $dhcpsettings{'FIX_ROOTPATH'} = '';
  92 $dhcpsettings{'FIX_REMARK'} = '';
  93 $dhcpsettings{'ACTION'} = '';
  94 $dhcpsettings{'KEY1'} = '';
  95 $dhcpsettings{'KEY2'} = '';
  96 @nosaved=('FIX_MAC','FIX_ADDR','FIX_ENABLED','FIX_NEXTADDR',
  97             'FIX_FILENAME','FIX_ROOTPATH','FIX_REMARK');
  98
  99 $dhcpsettings{'ADVOPT_ENABLED'} = '';
 100 $dhcpsettings{'ADVOPT_NAME'} = '';
 101 $dhcpsettings{'ADVOPT_DATA'} = '';
 102 unshift (@nosaved,'ADVOPT_ENABLED','ADVOPT_NAME','ADVOPT_DATA');
 103 foreach my $itf (@ITFs) {
 104     $dhcpsettings{"ADVOPT_SCOPE_${itf}"} = 'off';
 105     unshift (@nosaved, "ADVOPT_SCOPE_${itf}");
 106 }
 107
 108 # Read Ipcop settings
 109 &General::readhash("${General::swroot}/ethernet/settings", \%netsettings);
 110 &General::readhash("${General::swroot}/main/settings", \%mainsettings);
 111 &General::readhash("${General::swroot}/time/settings", \%timesettings);
 112 &General::readhash("/srv/web/ipfire/html/themes/".$mainsettings{'THEME'}."/include/colors.txt", \%color);
 113
 114 #Get GUI values
 115 &Header::getcgihash(\%dhcpsettings);
 116
 117 open(FILE, "$filename1") or die 'Unable to open dhcp advanced options file.';
 118 our @current1 = <FILE>;
 119 close(FILE);
 120 # Extract OptionDefinition
 121 foreach my $line (@current1) {
 122     #chomp($line);   # remove newline        #don't know why, but this remove newline in @current1 .... !
 123     my @temp = split(/\t/,$line);
 124     AddNewOptionDefinition ($temp[1] . ' ' . $temp[2]);
 125 }
 126
 127 open(FILE, "$filename2") or die 'Unable to open fixed leases file.';
 128 our @current2 = <FILE>;
 129 close(FILE);
 130
 131 # Check Settings1 first because they are needed by &buildconf
 132 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'save'}) {
 133     foreach my $itf (@ITFs) {
 134         if ($dhcpsettings{"ENABLE_${itf}"} eq 'on' ) {
 135             # "Start" is defined, need "End" and vice versa
 136             if ($dhcpsettings{"START_ADDR_${itf}"}) {
 137                 if (!(&General::validip($dhcpsettings{"START_ADDR_${itf}"}))) {
 138                     $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid start address'};
 139                     goto ERROR;
 140                 }
 141                 if (!$dhcpsettings{"END_ADDR_${itf}"}) {
 142                     $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid end address'};
 143                     goto ERROR;
 144                 }
 145                 if (! &General::IpInSubnet ( $dhcpsettings{"START_ADDR_${itf}"},
 146                                     $netsettings{"${itf}_NETADDRESS"},
 147                                     $netsettings{"${itf}_NETMASK"})) {
 148                     $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid start address'};
 149                     goto ERROR;
 150                 }
 151             }
 152
 153             if ($dhcpsettings{"END_ADDR_${itf}"}) {
 154                 if (!(&General::validip($dhcpsettings{"END_ADDR_${itf}"}))) {
 155                     $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid end address'};
 156                     goto ERROR;
 157                 }
 158                 if (!$dhcpsettings{"START_ADDR_${itf}"}) {
 159                     $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid start address'};
 160                     goto ERROR;
 161                 }
 162                 if (! &General::IpInSubnet ( $dhcpsettings{"END_ADDR_${itf}"},
 163                                     $netsettings{"${itf}_NETADDRESS"},
 164                                     $netsettings{"${itf}_NETMASK"})) {
 165                     $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid end address'};
 166                     goto ERROR;
 167                 }
 168                 #swap if necessary! (support 255.255.0.0 range, I doubt we need more) GE
 169                 my @startoct = split (/\./, $dhcpsettings{"START_ADDR_${itf}"});
 170                 my @endoct   = split (/\./, $dhcpsettings{"END_ADDR_${itf}"});
 171                 if ( $endoct[2]*256+$endoct[3] < $startoct[2]*256+$startoct[3] ) {
 172                     ($dhcpsettings{"START_ADDR_${itf}"},$dhcpsettings{"END_ADDR_${itf}"}) =
 173                         ($dhcpsettings{"END_ADDR_${itf}"},$dhcpsettings{"START_ADDR_${itf}"});
 174                 }
 175             }
 176
 177             if (!($dhcpsettings{"DEFAULT_LEASE_TIME_${itf}"} =~ /^\d+$/)) {
 178                 $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid default lease time'} . $dhcpsettings{'DEFAULT_LEASE_TIME_${itf}'};
 179                 goto ERROR;
 180             }
 181
 182             if (!($dhcpsettings{"MAX_LEASE_TIME_${itf}"} =~ /^\d+$/)) {
 183                 $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid max lease time'} . $dhcpsettings{'MAX_LEASE_TIME_${itf}'};
 184                 goto ERROR;
 185             }
 186
 187             if ($dhcpsettings{"DNS1_${itf}"}) {
 188                 if (!(&General::validip($dhcpsettings{"DNS1_${itf}"}))) {
 189                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid primary dns'};
 190                         goto ERROR;
 191                 }
 192             }
 193             if ($dhcpsettings{"DNS2_${itf}"}) {
 194                 if (!(&General::validip($dhcpsettings{"DNS2_${itf}"}))) {
 195                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid secondary dns'};
 196                         goto ERROR;
 197                 }
 198                 if (! $dhcpsettings{"DNS1_${itf}"}) {
 199                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'cannot specify secondary dns without specifying primary'};
 200                         goto ERROR;
 201                 }
 202             }
 203
 204             if ($dhcpsettings{"WINS1_${itf}"}) {
 205                 if (!(&General::validip($dhcpsettings{"WINS1_${itf}"}))) {
 206                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid wins address'};
 207                         goto ERROR;
 208                 }
 209             }
 210             if ($dhcpsettings{"WINS2_${itf}"}) {
 211                 if (!(&General::validip($dhcpsettings{"WINS2_${itf}"})))        {
 212                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid wins address'};
 213                         goto ERROR;
 214                 }
 215                 if (! $dhcpsettings{"WINS1_${itf}"} ) {
 216                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'cannot specify secondary wins without specifying primary'};
 217                         goto ERROR;
 218                 }
 219             }
 220             if ($dhcpsettings{"NEXT_${itf}"}) {
 221                 if (!(&General::validip($dhcpsettings{"NEXT_${itf}"}))) {
 222                         $errormessage = "next-server on ${itf}: " . $Lang::tr{'invalid ip'};
 223                         goto ERROR;
 224                 }
 225             }
 226             if ($dhcpsettings{"NTP1_${itf}"}) {
 227                 if (!(&General::validip($dhcpsettings{"NTP1_${itf}"}))) {
 228                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid primary ntp'};
 229                         goto ERROR;
 230                 }
 231                 if ($dhcpsettings{"NTP1_${itf}"} eq $netsettings{"${itf}_ADDRESS"} && ($timesettings{'ENABLECLNTP'} ne 'on')) {
 232                         $warnNTPmessage = "DHCP on ${itf}: " . $Lang::tr{'local ntp server specified but not enabled'};
 233                         #goto ERROR;
 234                 }
 235             }
 236             if ($dhcpsettings{"NTP2_${itf}"}) {
 237                 if (!(&General::validip($dhcpsettings{"NTP2_${itf}"}))) {
 238                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'invalid secondary ntp'};
 239                         goto ERROR;
 240                 }
 241                 if ($dhcpsettings{"NTP2_${itf}"} eq $netsettings{"${itf}_ADDRESS"} && ($timesettings{'ENABLECLNTP'} ne 'on')) {
 242                         $warnNTPmessage = "DHCP on ${itf}: " . $Lang::tr{'local ntp server specified but not enabled'};
 243                         #goto ERROR;
 244                 }
 245                 if (! $dhcpsettings{"NTP1_${itf}"}) {
 246                         $errormessage = "DHCP on ${itf}: " . $Lang::tr{'cannot specify secondary ntp without specifying primary'};
 247                         goto ERROR;
 248                 }
 249             }
 250         } # enabled
 251     }#loop interface verify
 252
 253     map (delete ($dhcpsettings{$_}) ,@nosaved,'ACTION','KEY1','KEY2','q');      # Must not be saved
 254     &General::writehash($setting, \%dhcpsettings);              # Save good settings
 255     $dhcpsettings{'ACTION'} = $Lang::tr{'save'};                # create an 'ACTION'
 256     map ($dhcpsettings{$_} = '',@nosaved,'KEY1','KEY2');        # and reinit vars to empty
 257     &buildconf;
 258     ERROR:                                                      # Leave the faulty field untouched
 259 } else {
 260     &General::readhash($setting, \%dhcpsettings);               # Get saved settings and reset to good if needed
 261 }
 262
 263 ## Sorting of fixed leases
 264 if ($ENV{'QUERY_STRING'} =~ /^FETHER|^FIPADDR/ ) {
 265     my $newsort=$ENV{'QUERY_STRING'};
 266     my $act=$dhcpsettings{'SORT_FLEASELIST'};
 267     #Reverse actual sort ?
 268     if ($act =~ $newsort) {
 269         my $Rev='';
 270         if ($act !~ 'Rev') {
 271             $Rev='Rev';
 272         }
 273         $newsort.=$Rev;
 274     }
 275     $dhcpsettings{'SORT_FLEASELIST'}=$newsort;
 276     map (delete ($dhcpsettings{$_}) ,@nosaved,'ACTION','KEY1','KEY2', 'q');     # Must never be saved
 277     &General::writehash($setting, \%dhcpsettings);
 278     &sortcurrent2;
 279     $dhcpsettings{'ACTION'} = 'SORT';                   # create an 'ACTION'
 280     map ($dhcpsettings{$_} = '',@nosaved,'KEY1','KEY2');# and reinit vars to empty
 281 }
 282
 283 #Sorting of allocated leases
 284 &Header::CheckSortOrder;
 285
 286
 287 ## Now manipulate the two multi-line list with Settings2.
 288 #  '1' suffix is for ADVANCED OPTIONS
 289 #  '2' suffix is for FIXED LEASES
 290
 291 # Toggle enable/disable field on specified options.
 292
 293 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'toggle enable disable'}.'1') {
 294     #move out new line
 295     chomp(@current1[$dhcpsettings{'KEY1'}]);
 296     my @temp = split(/\t/,@current1[$dhcpsettings{'KEY1'}]);            #use TAB separator !
 297     $temp[0] = $temp[0] eq 'on' ? '' : 'on';    # Toggle the field
 298     @current1[$dhcpsettings{'KEY1'}] = join ("\t",@temp)."\n";
 299     $dhcpsettings{'KEY1'} = ''; # End edit mode
 300     &General::log($Lang::tr{'dhcp advopt modified'});
 301     open(FILE, ">$filename1") or die 'Unable to open dhcp advanced options file.';
 302     print FILE @current1;
 303     close(FILE);
 304
 305     #Write changes to dhcpd.conf.
 306     &buildconf;
 307 }
 308
 309
 310
 311 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'add'}.'1' &&
 312         $dhcpsettings{'SUBMIT'} ne $Lang::tr{'dhcp advopt help'}) {
 313     $dhcpsettings{'ADVOPT_NAME'} =~ s/[^ \w-]//g;       # prevent execution of code by removing everything except letters/space
 314     $dhcpsettings{'ADVOPT_DATA'} =~ s/`//g;             # back tik ` ? not allowed !
 315
 316     if ($dhcpsettings{'ADVOPT_DATA'} eq '') {
 317         $errormessage=$Lang::tr{'dhcp advopt blank value'};
 318     }
 319
 320     # Test for a new option definition string (join field name & data)
 321     if (ExistNewOptionDefinition ($dhcpsettings{'ADVOPT_NAME'} . ' ' . $dhcpsettings{'ADVOPT_DATA'})) {
 322         #only edit permitted if option definition exists
 323         $errormessage = $Lang::tr{'dhcp advopt definition exists'} if ($dhcpsettings{'KEY1'} eq '');
 324         $dhcpsettings{'ADVOPT_ENABLED'} = 'on';                 # force active
 325         map ($dhcpsettings{"ADVOPT_SCOPE_$_"} = 'off', @ITFs);  # force global
 326     } elsif (AddNewOptionDefinition ($dhcpsettings{'ADVOPT_NAME'} . ' ' . $dhcpsettings{'ADVOPT_DATA'})) {
 327         #was a new option definition
 328         $dhcpsettings{'ADVOPT_ENABLED'} = 'on';                 # force active
 329         map ($dhcpsettings{"ADVOPT_SCOPE_$_"} = 'off', @ITFs);  # force global
 330     } elsif (ValidNewOption ($dhcpsettings{'ADVOPT_NAME'} . ' ' . $dhcpsettings{'ADVOPT_DATA'})) {
 331         #was a new option
 332     } elsif (! `grep "\$option $dhcpsettings{'ADVOPT_NAME'} " $filename3`) {
 333         $errormessage=$Lang::tr{'dhcp advopt unknown'}.': '.$dhcpsettings{'ADVOPT_NAME'};
 334     }
 335
 336     unless ($errormessage) {
 337
 338         my $scope = '';
 339         foreach my $itf (@ITFs) {  # buils "RED,GREEN,ORANGE,... based on selection
 340             $scope .= $dhcpsettings{"ADVOPT_SCOPE_${itf}"} eq 'on' ? "\t$itf" : "\toff" ;
 341         }
 342         if ($dhcpsettings{'KEY1'} eq '') { #add or edit ?  TAB separator !
 343             unshift (@current1, "$dhcpsettings{'ADVOPT_ENABLED'}\t$dhcpsettings{'ADVOPT_NAME'}\t$dhcpsettings{'ADVOPT_DATA'}$scope\n");
 344             &General::log($Lang::tr{'dhcp advopt added'});
 345         } else {
 346             @current1[$dhcpsettings{'KEY1'}] = "$dhcpsettings{'ADVOPT_ENABLED'}\t$dhcpsettings{'ADVOPT_NAME'}\t$dhcpsettings{'ADVOPT_DATA'}$scope\n";
 347             $dhcpsettings{'KEY1'} = '';       # End edit mode
 348             &General::log($Lang::tr{'dhcp advopt modified'});
 349         }
 350
 351         #Write changes to dhcpd.conf.
 352         &sortcurrent1;    # sort newly added/modified entry
 353         &buildconf;       # before calling buildconf which use fixed lease file !
 354     }
 355 }
 356
 357 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'edit'}.'1') {
 358     #move out new line
 359     my $line = @current1[$dhcpsettings{'KEY1'}];
 360     chomp($line);
 361     my @temp = split(/\t/, $line);
 362     $dhcpsettings{'ADVOPT_ENABLED'}=$temp[0];
 363     $dhcpsettings{'ADVOPT_NAME'}=$temp[1];
 364     $dhcpsettings{'ADVOPT_DATA'}=$temp[2];
 365
 366     # read next fields which are the name (color) of an interface if this interface is scoped
 367     for (my $key=0; $key<@ITFs; $key++) {
 368         my $itf = $temp[3+$key];
 369         if ($itf ne 'off') # Only is an interface name is read
 370         {
 371             $dhcpsettings{"ADVOPT_SCOPE_${itf}"} = 'on';
 372         }
 373     }
 374 }
 375
 376 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'remove'}.'1') {
 377     splice (@current1,$dhcpsettings{'KEY1'},1);
 378     open(FILE, ">$filename1") or die 'Unable to open dhcp advanced options file.';
 379     print FILE @current1;
 380     close(FILE);
 381     $dhcpsettings{'KEY1'} = '';                         # End remove mode
 382     &General::log($Lang::tr{'dhcp advopt removed'});
 383     #Write changes to dhcpd.conf.
 384     &buildconf;
 385 }
 386 #end KEY1
 387
 388
 389 # Toggle enable/disable field on specified lease.
 390 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'toggle enable disable'}.'2') {
 391     #move out new line
 392     chomp(@current2[$dhcpsettings{'KEY2'}]);
 393     my @temp = split(/\,/,@current2[$dhcpsettings{'KEY2'}]);
 394     $temp[2] = $temp[2] eq 'on' ? '' : 'on';    # Toggle the field
 395     @current2[$dhcpsettings{'KEY2'}] = join (',',@temp)."\n";
 396     $dhcpsettings{'KEY2'} = ''; # End edit mode
 397     &General::log($Lang::tr{'fixed ip lease modified'});
 398     open(FILE, ">$filename2") or die 'Unable to open fixed leases file.';
 399     print FILE @current2;
 400     close(FILE);
 401
 402     #Write changes to dhcpd.conf.
 403     &buildconf;
 404 }
 405
 406 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'add'}.'2') {
 407     $dhcpsettings{'FIX_MAC'} =~ tr/-/:/;
 408     unless(&General::validip($dhcpsettings{'FIX_ADDR'})) { $errormessage = $Lang::tr{'invalid fixed ip address'}; }
 409     unless(&General::validmac($dhcpsettings{'FIX_MAC'})) { $errormessage = $Lang::tr{'invalid fixed mac address'}; }
 410     if ($dhcpsettings{'FIX_NEXTADDR'}) {
 411         unless(&General::validip($dhcpsettings{'FIX_NEXTADDR'})) { $errormessage = $Lang::tr{'invalid fixed ip address'}; }
 412     }
 413
 414     my $key = 0;
 415     CHECK:foreach my $line (@current2) {
 416         my @temp = split(/\,/,$line);
 417         if($dhcpsettings{'KEY2'} ne $key) {
 418             # same MAC is OK on different subnets. This test is not complete because
 419             # if ip are not inside a known subnet, I don't warn.
 420             # Also it may be needed to put duplicate fixed lease in their right subnet definition..
 421             foreach my $itf (@ITFs) {
 422                 my $scoped = &General::IpInSubnet($dhcpsettings{'FIX_ADDR'},
 423                                                   $netsettings{"${itf}_NETADDRESS"},
 424                                                   $netsettings{"${itf}_NETMASK"}) &&
 425                                                   $dhcpsettings{"ENABLE_${itf}"} eq 'on';
 426                 if ( $scoped &&
 427                     (lc($dhcpsettings{'FIX_MAC'}) eq lc($temp[0])) &&
 428                     &General::IpInSubnet($temp[1],
 429                                          $netsettings{"${itf}_NETADDRESS"},
 430                                          $netsettings{"${itf}_NETMASK"})) {
 431                     $errormessage = "$Lang::tr{'mac address in use'} $dhcpsettings{'FIX_MAC'}";
 432                     last CHECK;
 433                 }
 434             }
 435         }
 436         $key++;
 437     }
 438
 439     unless ($errormessage) {
 440         $dhcpsettings{'FIX_REMARK'} = &Header::cleanhtml($dhcpsettings{'FIX_REMARK'});
 441         $dhcpsettings{'FIX_NEXTADDR'} = &Header::cleanhtml($dhcpsettings{'FIX_NEXTADDR'});
 442         $dhcpsettings{'FIX_FILENAME'} = &Header::cleanhtml($dhcpsettings{'FIX_FILENAME'});
 443         $dhcpsettings{'FIX_ROOTPATH'} = &Header::cleanhtml($dhcpsettings{'FIX_ROOTPATH'});
 444         if ($dhcpsettings{'KEY2'} eq '') { #add or edit ?
 445             unshift (@current2, "$dhcpsettings{'FIX_MAC'},$dhcpsettings{'FIX_ADDR'},$dhcpsettings{'FIX_ENABLED'},$dhcpsettings{'FIX_NEXTADDR'},$dhcpsettings{'FIX_FILENAME'},$dhcpsettings{'FIX_ROOTPATH'},$dhcpsettings{'FIX_REMARK'}\n");
 446             &General::log($Lang::tr{'fixed ip lease added'});
 447
 448             # Enter edit mode
 449             $dhcpsettings{'KEY2'} = 0;
 450         } else {
 451             @current2[$dhcpsettings{'KEY2'}] = "$dhcpsettings{'FIX_MAC'},$dhcpsettings{'FIX_ADDR'},$dhcpsettings{'FIX_ENABLED'},$dhcpsettings{'FIX_NEXTADDR'},$dhcpsettings{'FIX_FILENAME'},$dhcpsettings{'FIX_ROOTPATH'},$dhcpsettings{'FIX_REMARK'}\n";
 452             $dhcpsettings{'KEY2'} = '';       # End edit mode
 453             &General::log($Lang::tr{'fixed ip lease modified'});
 454
 455             # sort newly added/modified entry
 456             &sortcurrent2;
 457         }
 458
 459         #Write changes to dhcpd.conf.
 460         &buildconf;       # before calling buildconf which use fixed lease file !
 461     }
 462 }
 463
 464 if ($dhcpsettings{'ACTION_ALL'} eq '+') {
 465     my $news = 0;
 466     foreach (keys %dhcpsettings) {
 467         if (/^(\d+\.\d+\.\d+\.\d+)-([0-9a-fA-F:]+)$/) {     # checked names are index of the line
 468             my $ip=$1;
 469             my $mac=$2;
 470             if (!grep (/$2/,@current2)) {
 471                 unshift (@current2, "$mac,$ip,on,,,,imported\n");
 472                 $news++;
 473             }
 474         }
 475     }
 476     if ($news) {
 477         #Write changes to dhcpd.conf.
 478         $warnNTPmessage = $Lang::tr{'fixed ip lease added'}."($news)";
 479         &General::log($warnNTPmessage);
 480         &sortcurrent2;    # sort newly added/modified entry
 481         &buildconf;       # before calling buildconf which use fixed lease file !
 482     }
 483 }
 484
 485 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'edit'}.'2') {
 486     #move out new line
 487     my $line = @current2[$dhcpsettings{'KEY2'}];
 488     chomp($line);
 489     my @temp = split(/\,/, $line);
 490     $dhcpsettings{'FIX_MAC'}=$temp[0];
 491     $dhcpsettings{'FIX_ADDR'}=$temp[1];
 492     $dhcpsettings{'FIX_ENABLED'}=$temp[2];
 493     $dhcpsettings{'FIX_NEXTADDR'}=$temp[3];
 494     $dhcpsettings{'FIX_FILENAME'}=$temp[4];
 495     $dhcpsettings{'FIX_ROOTPATH'}=$temp[5];
 496     $dhcpsettings{'FIX_REMARK'}=$temp[6];
 497 }
 498
 499 if ($dhcpsettings{'ACTION'} eq $Lang::tr{'remove'}.'2') {
 500     splice (@current2,$dhcpsettings{'KEY2'},1);
 501     open(FILE, ">$filename2") or die 'Unable to open fixed lease file.';
 502     print FILE @current2;
 503     close(FILE);
 504     $dhcpsettings{'KEY2'} = '';                         # End remove mode
 505     &General::log($Lang::tr{'fixed ip lease removed'});
 506     #Write changes to dhcpd.conf.
 507     &buildconf;
 508 }
 509 #end KEY2 defined
 510
 511
 512
 513
 514 if ($dhcpsettings{'ACTION'} eq '' ) { # First launch from GUI
 515
 516     # Set default DHCP values only if blank and disabled
 517     foreach my $itf (@ITFs) {
 518         if ($dhcpsettings{"ENABLE_${itf}"} ne 'on' ) {
 519             $dhcpsettings{"DNS1_${itf}"} = $netsettings{"${itf}_ADDRESS"};
 520             $dhcpsettings{"DEFAULT_LEASE_TIME_${itf}"} = '60';
 521             $dhcpsettings{"MAX_LEASE_TIME_${itf}"} = '120';
 522             $dhcpsettings{"DOMAIN_NAME_${itf}"} = $mainsettings{'DOMAINNAME'};
 523         }
 524     }
 525     $dhcpsettings{'FIX_ENABLED'} = 'on';
 526 }
 527
 528 &Header::openpage($Lang::tr{'dhcp configuration'}, 1, '');
 529 &Header::openbigbox('100%', 'left', '', $errormessage);
 530
 531 if ($errormessage) {
 532     &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
 533     print "<font class='base'>$errormessage&nbsp;</font>\n";
 534     &Header::closebox();
 535 }
 536 if ($warnNTPmessage) {
 537     $warnNTPmessage = "<font color=${Header::colourred}><b>$Lang::tr{'capswarning'}</b></font>: $warnNTPmessage";
 538 }
 539
 540 &Header::openbox('100%', 'left', 'DHCP');
 541 print "<form method='post' action='$ENV{'SCRIPT_NAME'}'>";
 542
 543 foreach my $itf (@ITFs) {
 544     my %checked=();
 545     $checked{'ENABLE'}{'on'} = ( $dhcpsettings{"ENABLE_${itf}"} ne 'on') ? '' : "checked='checked'";
 546     $checked{'ENABLEBOOTP'}{'on'} = ( $dhcpsettings{"ENABLEBOOTP_${itf}"} ne 'on') ? '' : "checked='checked'";
 547
 548     if ($netsettings{"${itf}_DEV"} ne '' ) { # Show only defined interface
 549         my $lc_itf=lc($itf);
 550 print <<END
 551 <table width='100%'>
 552 <tr>
 553     <td width='25%' class='boldbase'><b><font color='${lc_itf}'>$Lang::tr{"$lc_itf interface"}</font></b></td>
 554     <td class='base'>$Lang::tr{'enabled'}
 555     <input type='checkbox' name='ENABLE_${itf}' $checked{'ENABLE'}{'on'} /></td>
 556     <td width='25%' class='base'>$Lang::tr{'ip address'}<br />$Lang::tr{'netmask'}:</td><td><b>$netsettings{"${itf}_ADDRESS"}<br />$netsettings{"${itf}_NETMASK"}</b></td>
 557 </tr><tr>
 558     <td width='25%' class='base'>$Lang::tr{'start address'}&nbsp;<img src='/blob.gif' alt='*' /></td>
 559     <td width='25%'><input type='text' name='START_ADDR_${itf}' value='$dhcpsettings{"START_ADDR_${itf}"}' /></td>
 560     <td width='25%' class='base'>$Lang::tr{'end address'}&nbsp;<img src='/blob.gif' alt='*' /></td>
 561     <td width='25%'><input type='text' name='END_ADDR_${itf}' value='$dhcpsettings{"END_ADDR_${itf}"}' /></td>
 562 </tr><tr>
 563     <td class='base'>$Lang::tr{'default lease time'}&nbsp;<img src='/blob.gif' alt='*' /></td>
 564     <td><input type='text' name='DEFAULT_LEASE_TIME_${itf}' value='$dhcpsettings{"DEFAULT_LEASE_TIME_${itf}"}' /></td>
 565     <td class='base'>$Lang::tr{'max lease time'}&nbsp;<img src='/blob.gif' alt='*' /></td>
 566     <td><input type='text' name='MAX_LEASE_TIME_${itf}' value='$dhcpsettings{"MAX_LEASE_TIME_${itf}"}' /></td>
 567 </tr><tr>
 568     <td class='base'>$Lang::tr{'domain name suffix'}</td>
 569     <td><input type='text' name='DOMAIN_NAME_${itf}' value='$dhcpsettings{"DOMAIN_NAME_${itf}"}' /></td>
 570     <td>$Lang::tr{'dhcp allow bootp'}:</td>
 571     <td><input type='checkbox' name='ENABLEBOOTP_${itf}' $checked{'ENABLEBOOTP'}{'on'} /></td>
 572 </tr><tr>
 573     <td class='base'>$Lang::tr{'primary dns'}&nbsp;<img src='/blob.gif' alt='*' /></td>
 574     <td><input type='text' name='DNS1_${itf}' value='$dhcpsettings{"DNS1_${itf}"}' /></td>
 575     <td class='base'>$Lang::tr{'secondary dns'}</td>
 576     <td><input type='text' name='DNS2_${itf}' value='$dhcpsettings{"DNS2_${itf}"}' /></td>
 577 </tr><tr>
 578     <td class='base'>$Lang::tr{'primary ntp server'}:</td>
 579     <td><input type='text' name='NTP1_${itf}' value='$dhcpsettings{"NTP1_${itf}"}' /></td>
 580     <td class='base'>$Lang::tr{'secondary ntp server'}:</td>
 581     <td><input type='text' name='NTP2_${itf}' value='$dhcpsettings{"NTP2_${itf}"}' /></td>
 582 </tr><tr>
 583     <td class='base'>$Lang::tr{'primary wins server address'}:</td>
 584     <td><input type='text' name='WINS1_${itf}' value='$dhcpsettings{"WINS1_${itf}"}' /></td>
 585     <td class='base'>$Lang::tr{'secondary wins server address'}:</td>
 586     <td><input type='text' name='WINS2_${itf}' value='$dhcpsettings{"WINS2_${itf}"}' /></td>
 587 </tr><tr>
 588     <td class='base'>next-server:</td>
 589     <td><input type='text' name='NEXT_${itf}' value='$dhcpsettings{"NEXT_${itf}"}' /></td>
 590     <td class='base'>filename:</td>
 591     <td><input type='text' name='FILE_${itf}' value='$dhcpsettings{"FILE_${itf}"}' /></td>
 592 </tr>
 593 </table>
 594 <hr />
 595 END
 596 ;
 597     }# Show only defined interface
 598 }#foreach itf
 599 print <<END
 600 <table width='100%'>
 601 <tr>
 602     <td class='base' width='25%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'required field'}</td>
 603     <td class='base' width='30%'>$warnNTPmessage</td>
 604     <td width='40%' align='right'><input type='submit' name='ACTION' value='$Lang::tr{'save'}' /></td>
 605 </tr>
 606 </table>
 607 END
 608 ;
 609 &Header::closebox();
 610
 611 # DHCP DNS update support (RFC2136)
 612 &Header::openbox('100%', 'left', $Lang::tr{'dhcp dns update'});
 613
 614 my %checked = ();
 615 $checked{'DNS_UPDATE_ENABLED'}{'on'} = ( $dhcpsettings{'DNS_UPDATE_ENABLED'} ne 'on') ? '' : "checked='checked'";
 616
 617 print <<END
 618 <table  width='100%'>
 619         <tr>
 620                 <td width='25%' class='boldbase'>$Lang::tr{'dhcp dns enable update'}</td>
 621                 <td class='base'><input type='checkbox' name='DNS_UPDATE_ENABLED' $checked{'DNS_UPDATE_ENABLED'}{'on'}>
 622                 </td>
 623         <tr>
 624 </table>
 625
 626 <table width='100%'>
 627 END
 628 ;
 629         my @domains = ();
 630
 631         # Print options for each interface.
 632         foreach my $itf (@ITFs) {
 633                 # Check if DHCP for this interface is enabled.
 634                 if ($dhcpsettings{"ENABLE_${itf}"} eq 'on') {
 635                         # Check for same domain name.
 636                         next if ($dhcpsettings{"DOMAIN_NAME_${itf}"} ~~ @domains);
 637                         my $lc_itf = lc($itf);
 638
 639                         # Select previously configured update algorithm.
 640                         my %selected = ();
 641                         $selected{'DNS_UPDATE_ALGO_${inf}'}{$dhcpsettings{'DNS_UPDATE_ALGO_${inf}'}} = 'selected';
 642
 643 print <<END
 644         <tr>
 645                 <td colspan='6'>&nbsp;</td>
 646         </tr>
 647         <tr>
 648                 <td colspan='6' class='boldbase'><b>$dhcpsettings{"DOMAIN_NAME_${itf}"}</b></td>
 649         </tr>
 650         <tr>
 651                 <td width='10%' class='boldbase'>$Lang::tr{'dhcp dns key name'}:</td>
 652                 <td width='20%'><input type='text' name='DNS_UPDATE_KEY_NAME_${itf}' value='$dhcpsettings{"DNS_UPDATE_KEY_NAME_${itf}"}'></td>
 653                 <td width='10%' class='boldbase' align='right'>$Lang::tr{'dhcp dns update secret'}:&nbsp;&nbsp;</td>
 654                 <td width='20%'><input type='password' name='DNS_UPDATE_KEY_SECRET_${itf}' value='$dhcpsettings{"DNS_UPDATE_KEY_SECRET_${itf}"}'></td>
 655                 <td width='10%' class='boldbase' align='right'>$Lang::tr{'dhcp dns update algo'}:&nbsp;&nbsp;</td>
 656                 <td width='20%'>
 657                         <select name='DNS_UPDATE_KEY_ALGO_${itf}'>
 658                                 <!-- <option value='hmac-sha1' $selected{'DNS_UPDATE_KEY_ALGO_${itf}'}{'hmac-sha1'}>HMAC-SHA1</option> -->
 659                                 <option value='hmac-md5' $selected{'DNS_UPDATE_KEY_ALGO_${itf}'}{'hmac-md5'}>HMAC-MD5</option>
 660                         </select>
 661                 </td>
 662         </tr>
 663 END
 664 ;
 665         }
 666
 667         # Store configured domain based on the interface
 668         # in the temporary variable.
 669         push(@domains, $dhcpsettings{"DOMAIN_NAME_${itf}"});
 670 }
 671 print <<END
 672 </table>
 673 <hr>
 674 <table width='100%'>
 675         <tr>
 676                 <td align='right'><input type='submit' name='ACTION' value='$Lang::tr{'save'}' /></td>
 677         </tr>
 678 </table>
 679 </form>
 680 END
 681 ;
 682
 683 &Header::closebox();
 684
 685 &Header::openbox('100%', 'left', $Lang::tr{'dhcp advopt list'});
 686 # DHCP Advanced options settings
 687 my %checked=();
 688 $checked{'ADVOPT_ENABLED'}{'on'} = ($dhcpsettings{'ADVOPT_ENABLED'} ne 'on') ? '' : "checked='checked'";
 689
 690 print "<form method='post' action='$ENV{'SCRIPT_NAME'}'><table width='100%'>";
 691 my $buttontext = $Lang::tr{'add'};
 692 if ($dhcpsettings{'KEY1'} ne '') {
 693     $buttontext = $Lang::tr{'update'};
 694     print "<tr><td class='boldbase'><b>$Lang::tr{'dhcp advopt edit'}</b></td></tr>";
 695 } else {
 696     print "<tr><td class='boldbase'><b>$Lang::tr{'dhcp advopt add'}</b></td></tr>"
 697 }
 698
 699 #search if the 'option' is in the list and print the syntax model
 700 my $opt = `grep "\$option $dhcpsettings{'ADVOPT_NAME'} " $filename3`;
 701 if ($opt ne '') {
 702    $opt =~ s/option $dhcpsettings{'ADVOPT_NAME'}/Syntax:/;  # "option xyz abc" => "syntax: abc"
 703    $opt =~ s/;//;
 704    $opt = "<tr><td></td><td></td><td colspan='2'>$opt</td></tr>";
 705 }
 706 print <<END
 707 <tr>
 708     <td class='base'>$Lang::tr{'dhcp advopt name'}:&nbsp;<img src='/blob.gif' alt='*' /></td>
 709     <td><input type='text' name='ADVOPT_NAME' value='$dhcpsettings{'ADVOPT_NAME'}' size='18' /></td>
 710     <td class='base'>$Lang::tr{'dhcp advopt value'}:&nbsp;<img src='/blob.gif' alt='*' /></td>
 711     <td><input type='text' name='ADVOPT_DATA' value='$dhcpsettings{'ADVOPT_DATA'}' size='40' /></td>
 712 </tr>$opt<tr>
 713     <td class='base'>$Lang::tr{'enabled'}</td><td><input type='checkbox' name='ADVOPT_ENABLED' $checked{'ADVOPT_ENABLED'}{'on'} /></td>
 714     <td class='base'>$Lang::tr{'dhcp advopt scope'}:</td>
 715     <td>
 716 END
 717 ;
 718
 719 # Put a checkbox for each interface. Checkbox visible disabled if interface is disabled
 720 foreach my $itf (@ITFs) {
 721     my $lc_itf=lc($itf);
 722     $checked{'ADVOPT_SCOPE_${itf}'}{'on'} = $dhcpsettings{"ADVOPT_SCOPE_${itf}"} ne 'on' ? '' : "checked='checked'";
 723     print "$Lang::tr{\"${lc_itf}\"} <input type='checkbox' name='ADVOPT_SCOPE_${itf}' $checked{'ADVOPT_SCOPE_${itf}'}{'on'} ";
 724     print $dhcpsettings{"ENABLE_${itf}"} eq 'on' ? "/>" : "disabled='disabled' />";
 725     print "&nbsp; &nbsp;";
 726 }
 727
 728 print <<END
 729     </td>
 730 </tr>
 731 </table>
 732 <hr />
 733 <table width='100%'>
 734 <tr>
 735     <td class='base' width='50%'>$Lang::tr{'dhcp advopt scope help'}</td>
 736     <td width='50%' align='right'>
 737     <input type='hidden' name='ACTION' value='$Lang::tr{'add'}1' />
 738     <input type='submit' name='SUBMIT' value='$buttontext' />
 739     <input type='submit' name='SUBMIT' value='$Lang::tr{'dhcp advopt help'}' />
 740     <input type='hidden' name='KEY1' value='$dhcpsettings{'KEY1'}' />
 741     </td>
 742 </tr>
 743 </table>
 744 </form>
 745 END
 746 ;
 747 #Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'
 748
 749 # print help taken from the file describing options
 750 if ($dhcpsettings{'SUBMIT'} eq $Lang::tr{'dhcp advopt help'}) {
 751     print "<hr />";
 752     print "<table width='100%'>";
 753     print "<tr><td width='30%'><b>$Lang::tr{'dhcp advopt name'}</b></td><td width='70%'><b>$Lang::tr{'dhcp advopt value'}</b></td>";
 754     open(FILE, "$filename3");
 755     my @current3 = <FILE>;
 756     close(FILE);
 757     foreach my $line (@current3) {
 758         $line =~ /option ([a-z0-9-]+) (.*);/;
 759         print "<tr><td>$1</td><td>$2</td></tr>\n";
 760     }
 761     print "<tr><td colspan='2'><hr /></td></tr>\n";
 762     print '<tr><td>string type</td><td>"quoted string" or 00:01:FF...</td></tr>';
 763     print '<tr><td>ip-address type </td><td>10.0.0.1 | www.dot.com</td></tr>';
 764     print '<tr><td>int,uint types</td><td>numbers</td></tr>';
 765     print '<tr><td>flag type</td><td>on | off</td></tr>';
 766     print '</table>';
 767     print "<hr />";
 768     print "<table width='100%'>";
 769     print "<tr><td width='30%'><b>$Lang::tr{'dhcp advopt custom definition'}</b></td><td width='70%'><b>$Lang::tr{'dhcp advopt value'}</b></td>";
 770     print "<tr><td>any-name </td><td> code NNN=$OptionTypes</td></tr>";
 771     print '<tr><td>a-string</td><td>code 100=string</td></tr>';
 772     print '<tr><td>a-number</td><td>code 101=signed integer 8</td></tr>';
 773     print '<tr><td>wpad</td><td>code 252=text</td></tr>';
 774     print '<tr><td>wpad</td><td>"http://www.server.fr/path-to/proxy.pac"</td></tr>';
 775     print '</table>';
 776
 777 }
 778
 779 print <<END
 780 <hr />
 781 <table width='100%'>
 782 <tr>
 783     <td width='30%' class='boldbase' align='center'><b>$Lang::tr{'dhcp advopt name'}</b></td>
 784     <td width='50%' class='boldbase' align='center'><b>$Lang::tr{'dhcp advopt value'}</b></td>
 785     <td width='20%' class='boldbase' align='center'><b>$Lang::tr{'dhcp advopt scope'}</b></td>
 786     <td colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>
 787 </tr>
 788 END
 789 ;
 790 my $key = 0;
 791 foreach my $line (@current1) {
 792     my $gif = '';
 793     my $gdesc = '';
 794     chomp($line);   # remove newline
 795     my @temp = split(/\t/,$line);
 796
 797     if ($temp[0] eq "on") {
 798         $gif = 'on.gif';
 799         $gdesc = $Lang::tr{'click to disable'};
 800     } else {
 801         $gif = 'off.gif';
 802         $gdesc = $Lang::tr{'click to enable'};
 803     }
 804
 805     if ($dhcpsettings{'KEY1'} eq $key) {
 806         print "<tr bgcolor='${Header::colouryellow}'>";
 807     } elsif ($key % 2) {
 808         print "<tr bgcolor='$color{'color22'}'>";
 809     } else {
 810         print "<tr bgcolor='$color{'color20'}'>";
 811     }
 812
 813     print <<END
 814 <td align='center'>$temp[1]</td>
 815 <td align='center'>$temp[2]</td>
 816 <td align='center'>
 817 END
 818 ;
 819     # Prepare a global flag to make easy reading
 820     my $global = '';
 821     my $disabledTogle = '';
 822     my $disabledEditRemove = '';
 823     if ( ExistNewOptionDefinition ($temp[1] . ' ' . $temp[2]) ) {
 824         $global = $Lang::tr{'dhcp advopt definition'};
 825         $disabledTogle = "disabled='disabled'";
 826         # Search if it is a used NewOptionDefinition to also disable edit & delete
 827         $disabledEditRemove = "disabled='disabled'" if (IsUsedNewOptionDefinition ($temp[1], $temp[2]));
 828     } else {
 829         $global = $Lang::tr{'dhcp advopt scope global'};
 830     }
 831
 832
 833     # Print each checked interface
 834     for (my $key=0; $key<@ITFs; $key++) {
 835         my $itf = $temp[3+$key];
 836         if ($itf ne 'off') {    # Only if an interface name is read
 837             print "$itf";
 838             $global='';         # fall to local scope !
 839         }
 840     }
 841     print <<END
 842 $global</td>
 843 <td align='center'>
 844 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
 845 <input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}1' />
 846 <input $disabledTogle type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />
 847 <input type='hidden' name='KEY1' value='$key' />
 848 </form>
 849 </td>
 850
 851 <td align='center'>
 852 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
 853 <input type='hidden' name='ACTION' value='$Lang::tr{'edit'}1' />
 854 <input $disabledEditRemove type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />
 855 <input type='hidden' name='KEY1' value='$key' />
 856 </form>
 857 </td>
 858
 859 <td align='center'>
 860 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
 861 <input type='hidden' name='ACTION' value='$Lang::tr{'remove'}1' />
 862 <input $disabledEditRemove type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />
 863 <input type='hidden' name='KEY1' value='$key' />
 864 </form>
 865 </td>
 866 </tr>
 867 END
 868 ;
 869     $key++;
 870 }
 871
 872 print "</table>";
 873
 874 # If there are dhcp options, print Key to action icons
 875 if ($key) {
 876 print <<END
 877 <table>
 878 <tr>
 879         <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>
 880         <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>
 881         <td class='base'>$Lang::tr{'click to disable'}</td>
 882         <td>&nbsp;&nbsp;</td>
 883         <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>
 884         <td class='base'>$Lang::tr{'click to enable'}</td>
 885         <td>&nbsp;&nbsp;</td>
 886         <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>
 887         <td class='base'>$Lang::tr{'edit'}</td>
 888         <td>&nbsp;&nbsp;</td>
 889         <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>
 890         <td class='base'>$Lang::tr{'remove'}</td>
 891 </tr>
 892 </table>
 893 END
 894 ;
 895 }
 896 &Header::closebox();
 897
 898 &Header::openbox('100%', 'left', $Lang::tr{'current fixed leases'});
 899 # Fixed leases screens
 900 $checked{'FIX_ENABLED'}{'on'} = ($dhcpsettings{'FIX_ENABLED'} ne 'on') ? '' : "checked='checked'";
 901
 902 $buttontext = $Lang::tr{'add'};
 903 print "<form method='post' action='$ENV{'SCRIPT_NAME'}'><table width='100%'>";
 904
 905 if ($dhcpsettings{'KEY2'} ne '') {
 906     $buttontext = $Lang::tr{'update'};
 907     print "<tr><td class='boldbase' colspan='3'><b>$Lang::tr{'edit an existing lease'}</b></td></tr>";
 908 } else {
 909     print "<tr><td class='boldbase' colspan='3'><b>$Lang::tr{'add new lease'}</b></td></tr>"
 910 }
 911 print <<END
 912 <tr>
 913     <td class='base'>$Lang::tr{'mac address'}:&nbsp;<img src='/blob.gif' alt='*' /></td>
 914     <td><input type='text' name='FIX_MAC' value='$dhcpsettings{'FIX_MAC'}' size='18' /></td>
 915     <td class='base'>$Lang::tr{'ip address'}:&nbsp;<img src='/blob.gif' alt='*' /></td>
 916     <td><input type='text' name='FIX_ADDR' value='$dhcpsettings{'FIX_ADDR'}' size='18' /></td>
 917     <td class='base'>$Lang::tr{'remark'}:</td>
 918     <td><input type='text' name='FIX_REMARK' value='$dhcpsettings{'FIX_REMARK'}' size='18' /></td>
 919 </tr><tr>
 920     <td class='base'>$Lang::tr{'enabled'}</td><td><input type='checkbox' name='FIX_ENABLED' $checked{'FIX_ENABLED'}{'on'} /></td>
 921 </tr><tr>
 922     <td colspan = '3'><b>$Lang::tr{'dhcp bootp pxe data'}</b></td>
 923 </tr><tr>
 924     <td class='base'>next-server:</td>
 925     <td><input type='text' name='FIX_NEXTADDR' value='$dhcpsettings{'FIX_NEXTADDR'}' size='18' /></td>
 926     <td class='base'>filename:</td>
 927     <td><input type='text' name='FIX_FILENAME' value='$dhcpsettings{'FIX_FILENAME'}' size='18' /></td>
 928     <td class='base'>root path:</td>
 929     <td><input type='text' name='FIX_ROOTPATH' value='$dhcpsettings{'FIX_ROOTPATH'}' size='18' /></td>
 930 </tr>
 931 </table>
 932 <hr />
 933 <table width='100%'>
 934 <tr>
 935     <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'required field'}</td>
 936     <td width='50%' align='right'>
 937         <input type='hidden' name='ACTION' value='$Lang::tr{'add'}2' />
 938         <input type='submit' name='SUBMIT' value='$buttontext' />
 939         <input type='hidden' name='KEY2' value='$dhcpsettings{'KEY2'}' /></td>
 940 </tr>
 941 </table>
 942 </form>
 943 END
 944 ;
 945 #Edited line number (KEY2) passed until cleared by 'save' or 'remove' or 'new sort order'
 946
 947 # Search for static leases
 948 my $search_query = $dhcpsettings{'q'};
 949
 950 if (scalar @current2 >= 10) {
 951         print <<END;
 952                 <form method="POST" action="#search">
 953                         <a name="search"></a>
 954                         <table width='100%'>
 955                                 <tr>
 956                                         <td>
 957                                                 <input type="text" name="q" value="$search_query">
 958                                                 <input type="submit" value="$Lang::tr{'search'}">
 959                                         </td>
 960                                 </tr>
 961                         </table>
 962                 </form>
 963 END
 964 }
 965
 966 print <<END
 967 <table width='100%' class='tbl'>
 968 <tr>
 969     <th width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?FETHER'><b>$Lang::tr{'mac address'}</b></a></th>
 970     <th width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?FIPADDR'><b>$Lang::tr{'ip address'}</b></a></th>
 971     <th width='15%' align='center'><b>$Lang::tr{'remark'}</b></th>
 972     <th width='15%' class='boldbase' align='center'><b>next-server</b></th>
 973     <th width='15%' class='boldbase' align='center'><b>filename</b></th>
 974     <th width='15%' class='boldbase' align='center'><b>root path</b></th>
 975     <th colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></th>
 976 </tr>
 977 END
 978 ;
 979 my $ipdup = 0;
 980 my %ipinuse = ();
 981 my %macdupl = (); # Duplicate MACs have to be on different subnets
 982 my %ipoutside = ();
 983
 984 # mark duplicate ip or duplicate MAC
 985 foreach my $line (@current2) {
 986     my @temp = split(/\,/,$line);
 987     $macdupl{$temp[0]} += 1;
 988     if ($macdupl{$temp[0]} > 1) {
 989         $ipdup = 1;     # Flag up duplicates for use later
 990     }
 991     $ipinuse{$temp[1]} += 1;
 992     if ($ipinuse{$temp[1]} > 1) {
 993         $ipdup = 1;     # Flag up duplicates for use later
 994     }
 995     # Mark IP addresses outwith known subnets
 996     $ipoutside{$temp[1]} = 1;
 997     foreach my $itf (@ITFs) {
 998         if ( &General::IpInSubnet($temp[1],
 999                 $netsettings{"${itf}_NETADDRESS"},
1000                 $netsettings{"${itf}_NETMASK"})) {
1001             $ipoutside{$temp[1]} = 0;
1002         }
1003     }
1004 }
1005
1006 $key = 0;
1007 my $col="";
1008 foreach my $line (@current2) {
1009     my $gif = '';
1010     my $gdesc = '';
1011     chomp($line);   # remove newline
1012     my @temp = split(/\,/,$line);
1013
1014     if ($temp[2] eq "on") {
1015         $gif = 'on.gif';
1016         $gdesc = $Lang::tr{'click to disable'};
1017     } else {
1018         $gif = 'off.gif';
1019         $gdesc = $Lang::tr{'click to enable'};
1020     }
1021
1022     # Skip all entries that do not match the search query
1023     if ($search_query ne "") {
1024         if (!grep(/$search_query/, @temp)) {
1025                 $key++;
1026                 next;
1027         }
1028     }
1029
1030     if ($dhcpsettings{'KEY2'} eq $key) {
1031         print "<tr>";
1032         $col="bgcolor='${Header::colouryellow}'";
1033     } elsif ($key % 2) {
1034         print "<tr>";
1035         $col="bgcolor='$color{'color20'}'";
1036     } else {
1037         print "<tr>";
1038         $col="bgcolor='$color{'color22'}'";
1039     }
1040     my $TAG0 = '';
1041     my $TAG1 = '';
1042     my $TAG2 = '';
1043     my $TAG3 = '';
1044     my $TAG4 = '';
1045     if ($ipinuse{$temp[1]} > 1) {
1046         $TAG0 = '<b>';
1047         $TAG1 = '</b>';
1048     }
1049     if ($macdupl{$temp[0]} > 1) {
1050         $TAG2 = '<b>';
1051         $TAG3 = '</b>';
1052     }
1053     if ($ipoutside{$temp[1]} > 0) {
1054         $TAG4 = "bgcolor='orange'" if ($dhcpsettings{'KEY2'} ne $key);
1055     }
1056
1057     print <<END
1058 <td align='center' $col>$TAG2$temp[0]$TAG3</td>
1059 <td align='center' $col $TAG4>$TAG0$temp[1]$TAG1</td>
1060 <td align='center' $col>$temp[6]&nbsp;</td>
1061 <td align='center' $col>$temp[3]&nbsp;</td>
1062 <td align='center' $col>$temp[4]&nbsp;</td>
1063 <td align='center' $col>$temp[5]&nbsp;</td>
1064
1065 <td align='center' $col>
1066 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
1067 <input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}2' />
1068 <input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />
1069 <input type='hidden' name='KEY2' value='$key' />
1070 </form>
1071 </td>
1072
1073 <td align='center' $col>
1074 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
1075 <input type='hidden' name='ACTION' value='$Lang::tr{'edit'}2' />
1076 <input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />
1077 <input type='hidden' name='KEY2' value='$key' />
1078 </form>
1079 </td>
1080
1081 <td align='center' $col>
1082 <form method='post' action='$ENV{'SCRIPT_NAME'}'>
1083 <input type='hidden' name='ACTION' value='$Lang::tr{'remove'}2' />
1084 <input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />
1085 <input type='hidden' name='KEY2' value='$key' />
1086 </form>
1087 </td>
1088 </tr>
1089 END
1090 ;
1091     $key++;
1092 }
1093 print "</table>";
1094
1095 # If the fixed lease file contains entries, print Key to action icons
1096 if ($key) {
1097 my $dup = $ipdup ? "<td class='base'>$Lang::tr{'duplicate ip bold'}</td>" :'';
1098 print <<END
1099 <table>
1100 <tr>
1101         <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>
1102         <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>
1103         <td class='base'>$Lang::tr{'click to disable'}</td>
1104         <td>&nbsp;&nbsp;</td>
1105         <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>
1106         <td class='base'>$Lang::tr{'click to enable'}</td>
1107         <td>&nbsp;&nbsp;</td>
1108         <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>
1109         <td class='base'>$Lang::tr{'edit'}</td>
1110         <td>&nbsp;&nbsp;</td>
1111         <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>
1112         <td class='base'>$Lang::tr{'remove'}</td>
1113 </tr>
1114 <tr>
1115         <td>&nbsp;</td>
1116         <td bgcolor='orange'>&nbsp;</td>
1117         <td class='base'>$Lang::tr{'ip address outside subnets'}</td>
1118         <td>&nbsp;</td>
1119         <td>&nbsp;</td>
1120         $dup
1121 </tr>
1122 </table>
1123 END
1124 ;
1125 }
1126
1127 &Header::closebox();
1128
1129 foreach my $itf (@ITFs) {
1130     if ($dhcpsettings{"ENABLE_${itf}"} eq 'on') {
1131         # display leases with a list of actions to do with the global select checkbox.
1132         &Header::PrintActualLeases("+");        # "+" => create fixed leases from nodeaddress
1133         last;                   #Print one time only for all interfaces
1134     };
1135 }
1136
1137 &Header::closebigbox();
1138 &Header::closepage();
1139
1140 ## Ouf it's the end !
1141
1142 sub sortcurrent1  # by now, do not sort, just write
1143 {
1144     open(FILE, ">$filename1") or die 'Unable to open dhcp advanced options file.';
1145     print FILE @current1;
1146     close(FILE);
1147 }
1148
1149
1150 # Sort the "current2" array according to choices
1151 sub sortcurrent2
1152 {
1153     our %entries = ();
1154
1155     sub fixedleasesort {
1156         my $qs='';
1157         if (rindex ($dhcpsettings{'SORT_FLEASELIST'},'Rev') != -1) {
1158             $qs=substr ($dhcpsettings{'SORT_FLEASELIST'},0,length($dhcpsettings{'SORT_FLEASELIST'})-3);
1159             if ($qs eq 'FIPADDR') {
1160                 my @a = split(/\./,$entries{$a}->{$qs});
1161                 my @b = split(/\./,$entries{$b}->{$qs});
1162                 ($b[0]<=>$a[0]) ||
1163                 ($b[1]<=>$a[1]) ||
1164                 ($b[2]<=>$a[2]) ||
1165                 ($b[3]<=>$a[3]);
1166             } else {
1167                 $entries{$b}->{$qs} cmp $entries{$a}->{$qs};
1168             }
1169         } else { #not reverse
1170             $qs=$dhcpsettings{'SORT_FLEASELIST'};
1171             if ($qs eq 'FIPADDR') {
1172                 my @a = split(/\./,$entries{$a}->{$qs});
1173                 my @b = split(/\./,$entries{$b}->{$qs});
1174                 ($a[0]<=>$b[0]) ||
1175                 ($a[1]<=>$b[1]) ||
1176                 ($a[2]<=>$b[2]) ||
1177                 ($a[3]<=>$b[3]);
1178             } else {
1179                 $entries{$a}->{$qs} cmp $entries{$b}->{$qs};
1180             }
1181         }
1182     }
1183
1184     #Use an associative array (%entries)
1185     foreach my $line (@current2) {
1186         chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)
1187         my @temp = split (',',$line);
1188         my @record = ('FETHER',$temp[0],'FIPADDR',$temp[1],'DATA',join(',',@temp[2..6]));
1189         my $record = {};                        # create a reference to empty hash
1190         %{$record} = @record;                   # populate that hash with @record
1191         # use combination of ether & IP as key to allow duplicates in either but not both
1192         $entries{$record->{FETHER} . $record->{FIPADDR}} = $record; # add this to a hash of hashes
1193     }
1194
1195     open(FILE, ">$filename2") or die 'Unable to open fixed lease file.';
1196     foreach my $entry ( sort fixedleasesort keys %entries) {
1197         print FILE "$entries{$entry}->{FETHER},$entries{$entry}->{FIPADDR},$entries{$entry}->{DATA}\n";
1198     }
1199     close(FILE);
1200
1201     # Reload sorted  @current2
1202     open (FILE, "$filename2");
1203     @current2 = <FILE>;
1204     close (FILE);
1205     undef (%entries);  #This array is reused latter. Clear it.
1206 }
1207
1208 # Build the configuration file mixing  settings, fixed leases and advanced options
1209 sub buildconf {
1210     open(FILE, ">/${General::swroot}/dhcp/dhcpd.conf") or die "Unable to write dhcpd.conf file";
1211     flock(FILE, 2);
1212
1213     # Global settings
1214     print FILE "deny bootp;     #default\n";
1215     print FILE "authoritative;\n";
1216
1217     # DNS Update settings
1218     if ($dhcpsettings{'DNS_UPDATE_ENABLED'} eq 'on') {
1219         print FILE "ddns-updates           on;\n";
1220         print FILE "ddns-update-style      interim;\n";
1221         print FILE "ddns-ttl               60; # 1 min\n";
1222         print FILE "ignore                 client-updates;\n";
1223         print FILE "update-static-leases   on;\n";
1224     } else {
1225         print FILE "ddns-update-style none;\n";
1226     }
1227
1228     # Write first new option definition
1229     foreach my $line (@current1) {
1230         chomp($line);   # remove newline
1231         my @temp = split(/\t/,$line);
1232         if (ExistNewOptionDefinition ($temp[1] . ' ' . $temp[2])) {
1233                 print FILE "option $temp[1] $temp[2];\n";
1234         }
1235     }
1236     # Write other global options
1237     foreach my $line (@current1) {
1238         chomp($line);   # remove newline
1239         my @temp = split(/\t/,$line);
1240
1241         if ($temp[0] eq 'on' && !ExistNewOptionDefinition ($temp[1] . ' ' . $temp[2])){ # active & !definition
1242             my $global=1;
1243             for (my $key=0; $key<@ITFs; $key++) {
1244                 my $itf = $temp[3+$key];
1245                 if ($itf ne 'off') # Only if an interface name is read
1246                 {
1247                     $global=0;
1248                 }
1249             }
1250             if ($global) {
1251                 print FILE "option $temp[1] $temp[2];\n";
1252             }
1253         }# on
1254     }# foreach line
1255     print FILE "\n";
1256
1257     #Subnet range definition
1258     foreach my $itf (@ITFs) {
1259         my $lc_itf=lc($itf);
1260         if ($dhcpsettings{"ENABLE_${itf}"} eq 'on' ){
1261             print FILE "subnet " . $netsettings{"${itf}_NETADDRESS"} . " netmask ". $netsettings{"${itf}_NETMASK"} . " #$itf\n";
1262             print FILE "{\n";
1263             print FILE "\trange " . $dhcpsettings{"START_ADDR_${itf}"} . ' ' . $dhcpsettings{"END_ADDR_${itf}"}.";\n" if ($dhcpsettings{"START_ADDR_${itf}"});
1264             print FILE "\toption subnet-mask "   . $netsettings{"${itf}_NETMASK"} . ";\n";
1265             print FILE "\toption domain-name \"" . $dhcpsettings{"DOMAIN_NAME_${itf}"} . "\";\n";
1266             print FILE "\toption routers " . $netsettings{"${itf}_ADDRESS"} . ";\n";
1267             print FILE "\toption domain-name-servers " . $dhcpsettings{"DNS1_${itf}"}  if ($dhcpsettings{"DNS1_${itf}"});
1268             print FILE ", " . $dhcpsettings{"DNS2_${itf}"}                             if ($dhcpsettings{"DNS2_${itf}"});
1269             print FILE ";\n"                                                           if ($dhcpsettings{"DNS1_${itf}"});
1270             print FILE "\toption ntp-servers " . $dhcpsettings{"NTP1_${itf}"}          if ($dhcpsettings{"NTP1_${itf}"});
1271             print FILE ", " . $dhcpsettings{"NTP2_${itf}"}                             if ($dhcpsettings{"NTP2_${itf}"});
1272             print FILE ";\n"                                                           if ($dhcpsettings{"NTP1_${itf}"});
1273             print FILE "\toption netbios-name-servers " . $dhcpsettings{"WINS1_${itf}"}     if ($dhcpsettings{"WINS1_${itf}"});
1274             print FILE ", " . $dhcpsettings{"WINS2_${itf}"}                            if ($dhcpsettings{"WINS2_${itf}"});
1275             print FILE ";\n"                                                           if ($dhcpsettings{"WINS1_${itf}"});
1276             print FILE "\tnext-server " . $dhcpsettings{"NEXT_${itf}"} . ";\n" if ($dhcpsettings{"NEXT_${itf}"});
1277             print FILE "\tfilename \"" . &EscapeFilename($dhcpsettings{"FILE_${itf}"}) . "\";\n" if ($dhcpsettings{"FILE_${itf}"});
1278             print FILE "\tdefault-lease-time " . ($dhcpsettings{"DEFAULT_LEASE_TIME_${itf}"} * 60). ";\n";
1279             print FILE "\tmax-lease-time "     . ($dhcpsettings{"MAX_LEASE_TIME_${itf}"} * 60)    . ";\n";
1280             print FILE "\tallow bootp;\n" if ($dhcpsettings{"ENABLEBOOTP_${itf}"} eq 'on');
1281
1282
1283
1284             # Write scoped options
1285             foreach my $line (@current1) {
1286                 chomp($line);   # remove newline
1287                 my @temp = split(/\t/,$line);           # Use TAB separator !
1288
1289                 if ($temp[0] eq 'on'){
1290                     for (my $key=0; $key<@ITFs; $key++) {
1291                         if ($itf eq $temp[3+$key]) # Only is an interface name is read
1292                         {
1293                             print FILE "\toption $temp[1] $temp[2];\n";
1294                         }
1295                     }
1296                 }# on
1297             }# foreach line
1298             print FILE "} #$itf\n\n";
1299
1300             if (($dhcpsettings{"DNS_UPDATE_ENABLED"} eq "on") && ($dhcpsettings{"DNS_UPDATE_KEY_NAME_${itf}"} ne "")) {
1301                 print FILE "key " . $dhcpsettings{"DNS_UPDATE_KEY_NAME_${itf}"} . " {\n";
1302                 print FILE "\talgorithm " . $dhcpsettings{"DNS_UPDATE_KEY_ALGO_${itf}"} . ";\n";
1303                 print FILE "\tsecret \"" . $dhcpsettings{"DNS_UPDATE_KEY_SECRET_${itf}"} . "\";\n";
1304                 print FILE "};\n\n";
1305
1306                 print FILE "zone " . $dhcpsettings{"DOMAIN_NAME_${itf}"} . ". {\n";
1307                 print FILE "\tkey " . $dhcpsettings{"DNS_UPDATE_KEY_NAME_${itf}"} . ";\n";
1308                 print FILE "}\n\n";
1309             }
1310
1311             system ('/usr/bin/touch', "${General::swroot}/dhcp/enable_${lc_itf}");
1312             &General::log("DHCP on ${itf}: " . $Lang::tr{'dhcp server enabled'})
1313         } else {
1314             unlink "${General::swroot}/dhcp/enable_${lc_itf}";
1315             &General::log("DHCP on ${itf}: " . $Lang::tr{'dhcp server disabled'})
1316         }
1317     }
1318
1319     #write fixed leases if any. Does not handle duplicates to write them elsewhere than the global scope.
1320     my $key = 0;
1321     foreach my $line (@current2) {
1322         chomp($line);
1323         my @temp = split(/\,/,$line);
1324         if ($temp[2] eq "on") {
1325             print FILE "\nhost fix$key # $temp[6]\n";
1326             print FILE "{\n";
1327             print FILE "\thardware ethernet $temp[0];\n";
1328             print FILE "\tfixed-address $temp[1];\n";
1329             print FILE "\tnext-server $temp[3];\n"          if ($temp[3]);
1330             print FILE "\tfilename \"" . &EscapeFilename($temp[4]) . "\";\n" if ($temp[4]);
1331             print FILE "\toption root-path \"$temp[5]\";\n" if ($temp[5]);
1332             print FILE "}\n";
1333             $key++;
1334         }
1335     }
1336     print FILE "include \"${General::swroot}/dhcp/dhcpd.conf.local\";\n";
1337     close FILE;
1338     if ( $dhcpsettings{"ENABLE_GREEN"} eq 'on' || $dhcpsettings{"ENABLE_BLUE"} eq 'on' ) {system '/usr/local/bin/dhcpctrl enable >/dev/null 2>&1';}
1339     else {system '/usr/local/bin/dhcpctrl disable >/dev/null 2>&1';}
1340     system '/usr/local/bin/dhcpctrl restart >/dev/null 2>&1 &';
1341 }
1342
1343 #
1344 # Receive a string and if it match model for a new option,
1345 # add it to the list %newOptions
1346 #
1347 my %NewOptions = ();
1348
1349 sub AddNewOptionDefinition {
1350     my ($line) = @_;
1351     if ( $line =~ /^([-\w]+)( code \d+=($OptionTypes))/ ) {
1352         $NewOptions{$1} = $2;
1353         #&General::log ("new:<$1><$2>");
1354         return 1;
1355     }
1356     return 0;
1357 }
1358
1359 #
1360 # Check existence of definition for a new option
1361 #
1362 sub ExistNewOptionDefinition {
1363     my ($line) = @_;
1364
1365     if ( $line =~ /^([-\w]+)( code \d+=($OptionTypes))/ ) {
1366         return defined $NewOptions{$1};
1367     }
1368     return 0;
1369 }
1370
1371 #
1372 # Check if it is a new option (definition must exist)
1373 # "code=" test eliminate a false response when definition exists
1374 # but this string is a definition with bad $OptionTypes.
1375 sub ValidNewOption {
1376     my ($line) = @_;
1377     if ($line =~ /^([-\w]+) (.*)/ ) {
1378         return defined ( $NewOptions{$1} ) && $2 !~ /code=/;
1379     }
1380     return 0;
1381 }
1382
1383 #
1384 # Check if the new option $opt is used, except the definition of itself!
1385 #
1386 sub IsUsedNewOptionDefinition {
1387     my ($opt,$val) = @_;
1388
1389     foreach my $line (@current1) {
1390         #chomp($line);   # remove newline        #don't know why, but this remove newline in @current1 .... !
1391         my @temp = split(/\t/,$line);
1392         # if we find something "opt value" & value != "code nnn=" it's ok.
1393         return 1 if ( ($opt eq $temp[1]) && ($temp[2] !~ /code \d+=/) );
1394     }
1395     return 0;
1396 }
1397
1398 sub EscapeFilename($) {
1399         my $filename = shift;
1400
1401         # Replace all single / by \/
1402         $filename =~ s/\//\\\//g;
1403
1404         return $filename;
1405 }