SMP-Config angepasst.. CGIs usw. wurden im Windoof-Format gespeichert... muss noch...
authorms <ms@ea5c0bd1-69bd-2848-81d8-4f18e57aeed8>
Tue, 21 Feb 2006 20:38:06 +0000 (20:38 +0000)
committerms <ms@ea5c0bd1-69bd-2848-81d8-4f18e57aeed8>
Tue, 21 Feb 2006 20:38:06 +0000 (20:38 +0000)
git-svn-id: http://svn.ipfire.org/svn/ipfire/trunk@67 ea5c0bd1-69bd-2848-81d8-4f18e57aeed8

49 files changed:
config/cfgroot/countries.pl
config/cfgroot/general-functions.pl
config/cfgroot/header-menu.pl
config/cfgroot/header.pl
config/cfgroot/lang.pl
config/cfgroot/protocols.pl
config/kernel/kernel.config.i386.installer
doc/packages-list.txt
html/cgi-bin/aliases.cgi
html/cgi-bin/backup.cgi
html/cgi-bin/base.cgi
html/cgi-bin/changepw.cgi
html/cgi-bin/connections.cgi
html/cgi-bin/credits.cgi
html/cgi-bin/ddns.cgi
html/cgi-bin/dhcp.cgi
html/cgi-bin/dial.cgi
html/cgi-bin/dmzholes.cgi
html/cgi-bin/graphs.cgi
html/cgi-bin/gui.cgi
html/cgi-bin/hosts.cgi
html/cgi-bin/ids.cgi
html/cgi-bin/index.cgi
html/cgi-bin/ipinfo.cgi
html/cgi-bin/modem.cgi
html/cgi-bin/netstatus.cgi
html/cgi-bin/networks.cgi
html/cgi-bin/optionsfw.cgi
html/cgi-bin/portfw.cgi
html/cgi-bin/pppsetup.cgi
html/cgi-bin/proxy.cgi
html/cgi-bin/proxygraphs.cgi
html/cgi-bin/remote.cgi
html/cgi-bin/services.cgi
html/cgi-bin/shaping.cgi
html/cgi-bin/shutdown.cgi
html/cgi-bin/status.cgi
html/cgi-bin/time.cgi
html/cgi-bin/updates.cgi
html/cgi-bin/upload.cgi
html/cgi-bin/vpnmain.cgi
html/cgi-bin/wireless.cgi
html/cgi-bin/xtaccess.cgi
html/html/include/ipcop.css
html/html/index.cgi
lfs/linux
lfs/openssh
src/ROOTFILES.i386
src/rc.d/helper/writeipac.pl

index 6e364b4..8e32316 100644 (file)
-package Countries;\r
-\r
-%countries = (\r
-'Afghanistan' => 'AF',\r
-'Albania' => 'AL',\r
-'Algeria' => 'DZ',\r
-'American Samoa' => 'AS',\r
-'Andorra' => 'AD',\r
-'Angola' => 'AO',\r
-'Anguilla' => 'AI',\r
-'Antarctica' => 'AQ',\r
-'Antigua and Barbuda' => 'AG',\r
-'Argentina' => 'AR',\r
-'Armenia' => 'AM',\r
-'Aruba' => 'AW',\r
-'Australia' => 'AU',\r
-'Austria' => 'AT',\r
-'Azerbaijan' => 'AZ',\r
-'Bahamas' => 'BS',\r
-'Bahrain' => 'BH',\r
-'Bangladesh' => 'BD',\r
-'Barbados' => 'BB',\r
-'Belarus' => 'BY',\r
-'Belgium' => 'BE',\r
-'Belize' => 'BZ',\r
-'Benin' => 'BJ',\r
-'Bermuda' => 'BM',\r
-'Bhutan' => 'BT',\r
-'Bolivia' => 'BO',\r
-'Bosnia and Herzegovina' => 'BA',\r
-'Botswana' => 'BW',\r
-'Bouvet Island' => 'BV',\r
-'Brazil' => 'BR',\r
-'British Indian Ocean Territory' => 'IO',\r
-'Brunei Darussalam' => 'BN',\r
-'Bulgaria' => 'BG',\r
-'Burkina Faso' => 'BF',\r
-'Burundi' => 'BI',\r
-'Cambodia' => 'KH',\r
-'Cameroon' => 'CM',\r
-'Canada' => 'CA',\r
-'Cape Verde' => 'CV',\r
-'Cayman Islands' => 'KY',\r
-'Central African Republic' => 'CF',\r
-'Chad' => 'TD',\r
-'Chile' => 'CL',\r
-'China' => 'CN',\r
-'Christmas Island' => 'CX',\r
-'Cocos (Keeling) Islands' => 'CC',\r
-'Colombia' => 'CO',\r
-'Comoros' => 'KM',\r
-'Congo' => 'CG',\r
-'Cook Islands' => 'CK',\r
-'Costa Rica' => 'CR',\r
-'Cote D\'Ivoire (Ivory Coast)' => 'CI',\r
-'Croatia (Hrvatska)' => 'HR',\r
-'Cuba' => 'CU',\r
-'Cyprus' => 'CY',\r
-'Czech Republic' => 'CZ',\r
-'Czechoslovakia (former)' => 'CS',\r
-'Denmark' => 'DK',\r
-'Djibouti' => 'DJ',\r
-'Dominica' => 'DM',\r
-'Dominican Republic' => 'DO',\r
-'East Timor' => 'TP',\r
-'Ecuador' => 'EC',\r
-'Egypt' => 'EG',\r
-'El Salvador' => 'SV',\r
-'Equatorial Guinea' => 'GQ',\r
-'Eritrea' => 'ER',\r
-'Estonia' => 'EE',\r
-'Ethiopia' => 'ET',\r
-'Falkland Islands (Malvinas)' => 'FK',\r
-'Faroe Islands' => 'FO',\r
-'Fiji' => 'FJ',\r
-'Finland' => 'FI',\r
-'France' => 'FR',\r
-'France, Metropolitan' => 'FX',\r
-'French Guiana' => 'GF',\r
-'French Polynesia' => 'PF',\r
-'French Southern Territories' => 'TF',\r
-'Gabon' => 'GA',\r
-'Gambia' => 'GM',\r
-'Georgia' => 'GE',\r
-'Germany' => 'DE',\r
-'Ghana' => 'GH',\r
-'Gibraltar' => 'GI',\r
-'Great Britain (UK)' => 'GB',\r
-'Greece' => 'GR',\r
-'Greenland' => 'GL',\r
-'Grenada' => 'GD',\r
-'Guadeloupe' => 'GP',\r
-'Guam' => 'GU',\r
-'Guatemala' => 'GT',\r
-'Guinea' => 'GN',\r
-'Guinea-Bissau' => 'GW',\r
-'Guyana' => 'GY',\r
-'Haiti' => 'HT',\r
-'Heard and McDonald Islands' => 'HM',\r
-'Honduras' => 'HN',\r
-'Hong Kong' => 'HK',\r
-'Hungary' => 'HU',\r
-'Iceland' => 'IS',\r
-'India' => 'IN',\r
-'Indonesia' => 'ID',\r
-'Iran' => 'IR',\r
-'Iraq' => 'IQ',\r
-'Ireland' => 'IE',\r
-'Israel' => 'IL',\r
-'Italy' => 'IT',\r
-'Jamaica' => 'JM',\r
-'Japan' => 'JP',\r
-'Jordan' => 'JO',\r
-'Kazakhstan' => 'KZ',\r
-'Kenya' => 'KE',\r
-'Kiribati' => 'KI',\r
-'Korea (North)' => 'KP',\r
-'Korea (South)' => 'KR',\r
-'Kuwait' => 'KW',\r
-'Kyrgyzstan' => 'KG',\r
-'Laos' => 'LA',\r
-'Latvia' => 'LV',\r
-'Lebanon' => 'LB',\r
-'Lesotho' => 'LS',\r
-'Liberia' => 'LR',\r
-'Libya' => 'LY',\r
-'Liechtenstein' => 'LI',\r
-'Lithuania' => 'LT',\r
-'Luxembourg' => 'LU',\r
-'Macau' => 'MO',\r
-'Macedonia' => 'MK',\r
-'Madagascar' => 'MG',\r
-'Malawi' => 'MW',\r
-'Malaysia' => 'MY',\r
-'Maldives' => 'MV',\r
-'Mali' => 'ML',\r
-'Malta' => 'MT',\r
-'Marshall Islands' => 'MH',\r
-'Martinique' => 'MQ',\r
-'Mauritania' => 'MR',\r
-'Mauritius' => 'MU',\r
-'Mayotte' => 'YT',\r
-'Mexico' => 'MX',\r
-'Micronesia' => 'FM',\r
-'Moldova' => 'MD',\r
-'Monaco' => 'MC',\r
-'Mongolia' => 'MN',\r
-'Montserrat' => 'MS',\r
-'Morocco' => 'MA',\r
-'Mozambique' => 'MZ',\r
-'Myanmar' => 'MM',\r
-'Namibia' => 'NA',\r
-'Nauru' => 'NR',\r
-'Nepal' => 'NP',\r
-'Netherlands Antilles' => 'AN',\r
-'Netherlands' => 'NL',\r
-'Neutral Zone' => 'NT',\r
-'New Caledonia' => 'NC',\r
-'New Zealand (Aotearoa)' => 'NZ',\r
-'Nicaragua' => 'NI',\r
-'Niger' => 'NE',\r
-'Nigeria' => 'NG',\r
-'Niue' => 'NU',\r
-'Norfolk Island' => 'NF',\r
-'Northern Mariana Islands' => 'MP',\r
-'Norway' => 'NO',\r
-'Oman' => 'OM',\r
-'Pakistan' => 'PK',\r
-'Palau' => 'PW',\r
-'Panama' => 'PA',\r
-'Papua New Guinea' => 'PG',\r
-'Paraguay' => 'PY',\r
-'Peru' => 'PE',\r
-'Philippines' => 'PH',\r
-'Pitcairn' => 'PN',\r
-'Poland' => 'PL',\r
-'Portugal' => 'PT',\r
-'Puerto Rico' => 'PR',\r
-'Qatar' => 'QA',\r
-'Reunion' => 'RE',\r
-'Romania' => 'RO',\r
-'Russian Federation' => 'RU',\r
-'Rwanda' => 'RW',\r
-'S. Georgia and S. Sandwich Isls.' => 'GS',\r
-'Saint Kitts and Nevis' => 'KN',\r
-'Saint Lucia' => 'LC',\r
-'Saint Vincent and the Grenadines' => 'VC',\r
-'Samoa' => 'WS',\r
-'San Marino' => 'SM',\r
-'Sao Tome and Principe' => 'ST',\r
-'Saudi Arabia' => 'SA',\r
-'Senegal' => 'SN',\r
-'Seychelles' => 'SC',\r
-'Sierra Leone' => 'SL',\r
-'Singapore' => 'SG',\r
-'Slovak Republic' => 'SK',\r
-'Slovenia' => 'SI',\r
-'Solomon Islands' => 'Sb',\r
-'Somalia' => 'SO',\r
-'South Africa' => 'ZA',\r
-'Spain' => 'ES',\r
-'Sri Lanka' => 'LK',\r
-'St. Helena' => 'SH',\r
-'St. Pierre and Miquelon' => 'PM',\r
-'Sudan' => 'SD',\r
-'Suriname' => 'SR',\r
-'Svalbard and Jan Mayen Islands' => 'SJ',\r
-'Swaziland' => 'SZ',\r
-'Sweden' => 'SE',\r
-'Switzerland' => 'CH',\r
-'Syria' => 'SY',\r
-'Taiwan' => 'TW',\r
-'Tajikistan' => 'TJ',\r
-'Tanzania' => 'TZ',\r
-'Thailand' => 'TH',\r
-'Togo' => 'TG',\r
-'Tokelau' => 'TK',\r
-'Tonga' => 'TO',\r
-'Trinidad and Tobago' => 'TT',\r
-'Tunisia' => 'TN',\r
-'Turkey' => 'TR',\r
-'Turkmenistan' => 'TM',\r
-'Turks and Caicos Islands' => 'TC',\r
-'Tuvalu' => 'TV',\r
-'US Minor Outlying Islands' => 'UM',\r
-'USSR (former)' => 'SU',\r
-'Uganda' => 'UG',\r
-'Ukraine' => 'UA',\r
-'United Arab Emirates' => 'AE',\r
-'United Kingdom' => 'UK',\r
-'United States' => 'US',\r
-'Uruguay' => 'UY',\r
-'Uzbekistan' => 'UZ',\r
-'Vanuatu' => 'VU',\r
-'Vatican City State (Holy See)' => 'VA',\r
-'Venezuela' => 'VE',\r
-'Viet Nam' => 'VN',\r
-'Virgin Islands (British)' => 'VG',\r
-'Virgin Islands (U.S.)' => 'VI',\r
-'Wallis and Futuna Islands' => 'WF',\r
-'Western Sahara' => 'EH',\r
-'Yemen' => 'YE',\r
-'Yugoslavia' => 'YU',\r
-'Zaire' => 'ZR',\r
-'Zambia' => 'ZM',\r
-'Zimbabwe' => 'ZW',\r
-);\r
-\r
-1;\r
-\r
+package Countries;
+
+%countries = (
+'Afghanistan' => 'AF',
+'Albania' => 'AL',
+'Algeria' => 'DZ',
+'American Samoa' => 'AS',
+'Andorra' => 'AD',
+'Angola' => 'AO',
+'Anguilla' => 'AI',
+'Antarctica' => 'AQ',
+'Antigua and Barbuda' => 'AG',
+'Argentina' => 'AR',
+'Armenia' => 'AM',
+'Aruba' => 'AW',
+'Australia' => 'AU',
+'Austria' => 'AT',
+'Azerbaijan' => 'AZ',
+'Bahamas' => 'BS',
+'Bahrain' => 'BH',
+'Bangladesh' => 'BD',
+'Barbados' => 'BB',
+'Belarus' => 'BY',
+'Belgium' => 'BE',
+'Belize' => 'BZ',
+'Benin' => 'BJ',
+'Bermuda' => 'BM',
+'Bhutan' => 'BT',
+'Bolivia' => 'BO',
+'Bosnia and Herzegovina' => 'BA',
+'Botswana' => 'BW',
+'Bouvet Island' => 'BV',
+'Brazil' => 'BR',
+'British Indian Ocean Territory' => 'IO',
+'Brunei Darussalam' => 'BN',
+'Bulgaria' => 'BG',
+'Burkina Faso' => 'BF',
+'Burundi' => 'BI',
+'Cambodia' => 'KH',
+'Cameroon' => 'CM',
+'Canada' => 'CA',
+'Cape Verde' => 'CV',
+'Cayman Islands' => 'KY',
+'Central African Republic' => 'CF',
+'Chad' => 'TD',
+'Chile' => 'CL',
+'China' => 'CN',
+'Christmas Island' => 'CX',
+'Cocos (Keeling) Islands' => 'CC',
+'Colombia' => 'CO',
+'Comoros' => 'KM',
+'Congo' => 'CG',
+'Cook Islands' => 'CK',
+'Costa Rica' => 'CR',
+'Cote D\'Ivoire (Ivory Coast)' => 'CI',
+'Croatia (Hrvatska)' => 'HR',
+'Cuba' => 'CU',
+'Cyprus' => 'CY',
+'Czech Republic' => 'CZ',
+'Czechoslovakia (former)' => 'CS',
+'Denmark' => 'DK',
+'Djibouti' => 'DJ',
+'Dominica' => 'DM',
+'Dominican Republic' => 'DO',
+'East Timor' => 'TP',
+'Ecuador' => 'EC',
+'Egypt' => 'EG',
+'El Salvador' => 'SV',
+'Equatorial Guinea' => 'GQ',
+'Eritrea' => 'ER',
+'Estonia' => 'EE',
+'Ethiopia' => 'ET',
+'Falkland Islands (Malvinas)' => 'FK',
+'Faroe Islands' => 'FO',
+'Fiji' => 'FJ',
+'Finland' => 'FI',
+'France' => 'FR',
+'France, Metropolitan' => 'FX',
+'French Guiana' => 'GF',
+'French Polynesia' => 'PF',
+'French Southern Territories' => 'TF',
+'Gabon' => 'GA',
+'Gambia' => 'GM',
+'Georgia' => 'GE',
+'Germany' => 'DE',
+'Ghana' => 'GH',
+'Gibraltar' => 'GI',
+'Great Britain (UK)' => 'GB',
+'Greece' => 'GR',
+'Greenland' => 'GL',
+'Grenada' => 'GD',
+'Guadeloupe' => 'GP',
+'Guam' => 'GU',
+'Guatemala' => 'GT',
+'Guinea' => 'GN',
+'Guinea-Bissau' => 'GW',
+'Guyana' => 'GY',
+'Haiti' => 'HT',
+'Heard and McDonald Islands' => 'HM',
+'Honduras' => 'HN',
+'Hong Kong' => 'HK',
+'Hungary' => 'HU',
+'Iceland' => 'IS',
+'India' => 'IN',
+'Indonesia' => 'ID',
+'Iran' => 'IR',
+'Iraq' => 'IQ',
+'Ireland' => 'IE',
+'Israel' => 'IL',
+'Italy' => 'IT',
+'Jamaica' => 'JM',
+'Japan' => 'JP',
+'Jordan' => 'JO',
+'Kazakhstan' => 'KZ',
+'Kenya' => 'KE',
+'Kiribati' => 'KI',
+'Korea (North)' => 'KP',
+'Korea (South)' => 'KR',
+'Kuwait' => 'KW',
+'Kyrgyzstan' => 'KG',
+'Laos' => 'LA',
+'Latvia' => 'LV',
+'Lebanon' => 'LB',
+'Lesotho' => 'LS',
+'Liberia' => 'LR',
+'Libya' => 'LY',
+'Liechtenstein' => 'LI',
+'Lithuania' => 'LT',
+'Luxembourg' => 'LU',
+'Macau' => 'MO',
+'Macedonia' => 'MK',
+'Madagascar' => 'MG',
+'Malawi' => 'MW',
+'Malaysia' => 'MY',
+'Maldives' => 'MV',
+'Mali' => 'ML',
+'Malta' => 'MT',
+'Marshall Islands' => 'MH',
+'Martinique' => 'MQ',
+'Mauritania' => 'MR',
+'Mauritius' => 'MU',
+'Mayotte' => 'YT',
+'Mexico' => 'MX',
+'Micronesia' => 'FM',
+'Moldova' => 'MD',
+'Monaco' => 'MC',
+'Mongolia' => 'MN',
+'Montserrat' => 'MS',
+'Morocco' => 'MA',
+'Mozambique' => 'MZ',
+'Myanmar' => 'MM',
+'Namibia' => 'NA',
+'Nauru' => 'NR',
+'Nepal' => 'NP',
+'Netherlands Antilles' => 'AN',
+'Netherlands' => 'NL',
+'Neutral Zone' => 'NT',
+'New Caledonia' => 'NC',
+'New Zealand (Aotearoa)' => 'NZ',
+'Nicaragua' => 'NI',
+'Niger' => 'NE',
+'Nigeria' => 'NG',
+'Niue' => 'NU',
+'Norfolk Island' => 'NF',
+'Northern Mariana Islands' => 'MP',
+'Norway' => 'NO',
+'Oman' => 'OM',
+'Pakistan' => 'PK',
+'Palau' => 'PW',
+'Panama' => 'PA',
+'Papua New Guinea' => 'PG',
+'Paraguay' => 'PY',
+'Peru' => 'PE',
+'Philippines' => 'PH',
+'Pitcairn' => 'PN',
+'Poland' => 'PL',
+'Portugal' => 'PT',
+'Puerto Rico' => 'PR',
+'Qatar' => 'QA',
+'Reunion' => 'RE',
+'Romania' => 'RO',
+'Russian Federation' => 'RU',
+'Rwanda' => 'RW',
+'S. Georgia and S. Sandwich Isls.' => 'GS',
+'Saint Kitts and Nevis' => 'KN',
+'Saint Lucia' => 'LC',
+'Saint Vincent and the Grenadines' => 'VC',
+'Samoa' => 'WS',
+'San Marino' => 'SM',
+'Sao Tome and Principe' => 'ST',
+'Saudi Arabia' => 'SA',
+'Senegal' => 'SN',
+'Seychelles' => 'SC',
+'Sierra Leone' => 'SL',
+'Singapore' => 'SG',
+'Slovak Republic' => 'SK',
+'Slovenia' => 'SI',
+'Solomon Islands' => 'Sb',
+'Somalia' => 'SO',
+'South Africa' => 'ZA',
+'Spain' => 'ES',
+'Sri Lanka' => 'LK',
+'St. Helena' => 'SH',
+'St. Pierre and Miquelon' => 'PM',
+'Sudan' => 'SD',
+'Suriname' => 'SR',
+'Svalbard and Jan Mayen Islands' => 'SJ',
+'Swaziland' => 'SZ',
+'Sweden' => 'SE',
+'Switzerland' => 'CH',
+'Syria' => 'SY',
+'Taiwan' => 'TW',
+'Tajikistan' => 'TJ',
+'Tanzania' => 'TZ',
+'Thailand' => 'TH',
+'Togo' => 'TG',
+'Tokelau' => 'TK',
+'Tonga' => 'TO',
+'Trinidad and Tobago' => 'TT',
+'Tunisia' => 'TN',
+'Turkey' => 'TR',
+'Turkmenistan' => 'TM',
+'Turks and Caicos Islands' => 'TC',
+'Tuvalu' => 'TV',
+'US Minor Outlying Islands' => 'UM',
+'USSR (former)' => 'SU',
+'Uganda' => 'UG',
+'Ukraine' => 'UA',
+'United Arab Emirates' => 'AE',
+'United Kingdom' => 'UK',
+'United States' => 'US',
+'Uruguay' => 'UY',
+'Uzbekistan' => 'UZ',
+'Vanuatu' => 'VU',
+'Vatican City State (Holy See)' => 'VA',
+'Venezuela' => 'VE',
+'Viet Nam' => 'VN',
+'Virgin Islands (British)' => 'VG',
+'Virgin Islands (U.S.)' => 'VI',
+'Wallis and Futuna Islands' => 'WF',
+'Western Sahara' => 'EH',
+'Yemen' => 'YE',
+'Yugoslavia' => 'YU',
+'Zaire' => 'ZR',
+'Zambia' => 'ZM',
+'Zimbabwe' => 'ZW',
+);
+
+1;
+
index 13021ca..b40327a 100644 (file)
-# SmoothWall CGIs\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) The SmoothWall Team\r
-# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite\r
-# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()\r
-# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions\r
-# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()\r
-# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()\r
-#\r
-# $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $\r
-#\r
-\r
-package General;\r
-\r
-use strict;\r
-use Socket;\r
-use IO::Socket;\r
-\r
-$|=1; # line buffering\r
-\r
-$General::version = 'VERSION';\r
-$General::swroot = 'CONFIG_ROOT';\r
-$General::noipprefix = 'noipg-';\r
-$General::adminmanualurl = 'http://www.ipcop.org/1.4.0/en/admin/html';\r
-\r
-sub log\r
-{\r
-       my $logmessage = $_[0];\r
-       $logmessage =~ /([\w\W]*)/;\r
-       $logmessage = $1;\r
-       system('/usr/bin/logger', '-t', 'ipcop', $logmessage);\r
-}\r
-\r
-sub readhash\r
-{\r
-       my $filename = $_[0];\r
-       my $hash = $_[1];\r
-       my ($var, $val);\r
-       \r
-       \r
-       # Some ipcop code expects that readhash 'complete' the hash if new entries\r
-       # are presents. Not clear it !!!\r
-       #%$hash = ();\r
-\r
-       open(FILE, $filename) or die "Unable to read file $filename";\r
-       \r
-       while (<FILE>)\r
-       {\r
-               chop;\r
-               ($var, $val) = split /=/, $_, 2;\r
-               if ($var)\r
-               {\r
-                       $val =~ s/^\'//g;\r
-                       $val =~ s/\'$//g;\r
-\r
-                       # Untaint variables read from hash\r
-                       $var =~ /([A-Za-z0-9_-]*)/;        $var = $1;\r
-                       $val =~ /([\w\W]*)/; $val = $1;\r
-                       $hash->{$var} = $val;\r
-               }\r
-       }\r
-       close FILE;\r
-}\r
-\r
-\r
-sub writehash\r
-{\r
-       my $filename = $_[0];\r
-       my $hash = $_[1];\r
-       my ($var, $val);\r
-       \r
-       # write cgi vars to the file.\r
-       open(FILE, ">${filename}") or die "Unable to write file $filename";\r
-       flock FILE, 2;\r
-       foreach $var (keys %$hash) \r
-       {\r
-               $val = $hash->{$var};\r
-               # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y\r
-               # location of the mouse are submitted as well, this was being written to the settings file causing\r
-               # some serious grief! This skips the variable.x and variable.y\r
-               if (!($var =~ /(.x|.y)$/)) {\r
-                       if ($val =~ / /) {\r
-                               $val = "\'$val\'"; }\r
-                       if (!($var =~ /^ACTION/)) {\r
-                               print FILE "${var}=${val}\n"; }\r
-               }\r
-       }\r
-       close FILE;\r
-}\r
-\r
-\r
-sub age\r
-{\r
-       my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,\r
-               $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];\r
-       my $now = time;\r
-\r
-       my $totalsecs = $now - $mtime;\r
-       my $days = int($totalsecs / 86400);\r
-       my $totalhours = int($totalsecs / 3600);\r
-       my $hours = $totalhours % 24;\r
-       my $totalmins = int($totalsecs / 60);\r
-       my $mins = $totalmins % 60;\r
-       my $secs = $totalsecs % 60;\r
-\r
-       return "${days}d ${hours}h ${mins}m ${secs}s";\r
-}\r
-\r
-sub validip\r
-{\r
-       my $ip = $_[0];\r
-\r
-       if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {\r
-               return 0; }\r
-       else \r
-       {\r
-               my @octets = ($1, $2, $3, $4);\r
-               foreach $_ (@octets)\r
-               {\r
-                       if (/^0./) {\r
-                               return 0; }\r
-                       if ($_ < 0 || $_ > 255) {\r
-                               return 0; }\r
-               }\r
-               return 1;\r
-       }\r
-}\r
-\r
-sub validmask\r
-{\r
-       my $mask = $_[0];\r
-\r
-       # secord part an ip?\r
-       if (&validip($mask)) {\r
-               return 1; }\r
-       # second part a number?\r
-       if (/^0/) {\r
-               return 0; }\r
-       if (!($mask =~ /^\d+$/)) {\r
-               return 0; }\r
-       if ($mask >= 0 && $mask <= 32) {\r
-               return 1; }\r
-       return 0;\r
-}\r
-\r
-sub validipormask\r
-{\r
-       my $ipormask = $_[0];\r
-\r
-       # see if it is a IP only.\r
-       if (&validip($ipormask)) {\r
-               return 1; }\r
-       # split it into number and mask.\r
-       if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {\r
-               return 0; }\r
-       my $ip = $1;\r
-       my $mask = $2;\r
-       # first part not a ip?\r
-       if (!(&validip($ip))) {\r
-               return 0; }\r
-       return &validmask($mask);\r
-}\r
-\r
-sub validipandmask\r
-{\r
-       my $ipandmask = $_[0];\r
-\r
-       # split it into number and mask.\r
-       if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {\r
-               return 0; }\r
-       my $ip = $1;\r
-       my $mask = $2;\r
-       # first part not a ip?\r
-       if (!(&validip($ip))) {\r
-               return 0; }\r
-       return &validmask($mask);\r
-}\r
-\r
-sub validport\r
-{\r
-       $_ = $_[0];\r
-\r
-       if (!/^\d+$/) {\r
-               return 0; }\r
-       if (/^0./) {\r
-               return 0; }\r
-       if ($_ >= 1 && $_ <= 65535) {\r
-               return 1; }\r
-       return 0;\r
-}\r
-\r
-sub validmac\r
-{\r
-       my $checkmac = $_[0];\r
-       my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)\r
-       if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)\r
-       {\r
-               return 0;\r
-       }\r
-       return 1;\r
-}\r
-\r
-sub validhostname\r
-{\r
-       # Checks a hostname against RFC1035\r
-        my $hostname = $_[0];\r
-\r
-       # Each part should be at least two characters in length\r
-       # but no more than 63 characters\r
-       if (length ($hostname) < 1 || length ($hostname) > 63) {\r
-               return 0;}\r
-       # Only valid characters are a-z, A-Z, 0-9 and -\r
-       if ($hostname !~ /^[a-zA-Z0-9-]*$/) {\r
-               return 0;}\r
-       # First character can only be a letter or a digit\r
-       if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
-               return 0;}\r
-       # Last character can only be a letter or a digit\r
-       if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
-               return 0;}\r
-       return 1;\r
-}\r
-\r
-sub validdomainname\r
-{\r
-       my $part;\r
-\r
-       # Checks a domain name against RFC1035\r
-        my $domainname = $_[0];\r
-       my @parts = split (/\./, $domainname);  # Split hostname at the '.'\r
-\r
-       foreach $part (@parts) {\r
-               # Each part should be at least two characters in length\r
-               # but no more than 63 characters\r
-               if (length ($part) < 2 || length ($part) > 63) {\r
-                       return 0;}\r
-               # Only valid characters are a-z, A-Z, 0-9 and -\r
-               if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
-                       return 0;}\r
-               # First character can only be a letter or a digit\r
-               if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
-                       return 0;}\r
-               # Last character can only be a letter or a digit\r
-               if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
-                       return 0;}\r
-       }\r
-       return 1;\r
-}\r
-\r
-sub validfqdn\r
-{\r
-       my $part;\r
-\r
-       # Checks a fully qualified domain name against RFC1035\r
-        my $fqdn = $_[0];\r
-       my @parts = split (/\./, $fqdn);        # Split hostname at the '.'\r
-       if (scalar(@parts) < 2) {               # At least two parts should\r
-               return 0;}                      # exist in a FQDN\r
-                                               # (i.e. hostname.domain)\r
-       foreach $part (@parts) {\r
-               # Each part should be at least one character in length\r
-               # but no more than 63 characters\r
-               if (length ($part) < 1 || length ($part) > 63) {\r
-                       return 0;}\r
-               # Only valid characters are a-z, A-Z, 0-9 and -\r
-               if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
-                       return 0;}\r
-               # First character can only be a letter or a digit\r
-               if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
-                       return 0;}\r
-               # Last character can only be a letter or a digit\r
-               if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
-                       return 0;}\r
-       }\r
-       return 1;\r
-}\r
-\r
-sub validportrange # used to check a port range \r
-{\r
-       my $port = $_[0]; # port values\r
-       $port =~ tr/-/:/; # replace all - with colons just in case someone used -\r
-       my $srcdst = $_[1]; # is it a source or destination port\r
-\r
-       if (!($port =~ /^(\d+)\:(\d+)$/)) {\r
-       \r
-               if (!(&validport($port))) {      \r
-                       if ($srcdst eq 'src'){\r
-                               return $Lang::tr{'source port numbers'};\r
-                       } else  {\r
-                               return $Lang::tr{'destination port numbers'};\r
-                       } \r
-               }\r
-       }\r
-       else \r
-       {\r
-               my @ports = ($1, $2);\r
-               if ($1 >= $2){\r
-                       if ($srcdst eq 'src'){\r
-                               return $Lang::tr{'bad source range'};\r
-                       } else  {\r
-                               return $Lang::tr{'bad destination range'};\r
-                       } \r
-               }\r
-               foreach $_ (@ports)\r
-               {\r
-                       if (!(&validport($_))) {\r
-                               if ($srcdst eq 'src'){\r
-                                       return $Lang::tr{'source port numbers'}; \r
-                               } else  {\r
-                                       return $Lang::tr{'destination port numbers'};\r
-                               } \r
-                       }\r
-               }\r
-               return;\r
-       }\r
-}\r
-\r
-# Test if IP is within a subnet\r
-# Call: IpInSubnet (Addr, Subnet, Subnet Mask)\r
-#       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1\r
-#       Everything in dottted notation\r
-# Return: TRUE/FALSE\r
-sub IpInSubnet\r
-{\r
-    my $ip = unpack('N', &Socket::inet_aton(shift));\r
-    my $start = unpack('N', &Socket::inet_aton(shift));\r
-    my $mask  = unpack('N', &Socket::inet_aton(shift));\r
-       $start &= $mask;  # base of subnet...\r
-    my $end   = $start + ~$mask;\r
-    return (($ip >= $start) && ($ip <= $end));\r
-}\r
-\r
-sub validemail {\r
-    my $mail = shift;\r
-    return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );\r
-    return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);\r
-    return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );\r
-    return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );\r
-    return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );\r
-    return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );\r
-    return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );\r
-    return 1;\r
-}\r
-\r
-sub readhasharray {\r
-    my ($filename, $hash) = @_;\r
-    %$hash = ();\r
-\r
-    open(FILE, $filename) or die "Unable to read file $filename";\r
-\r
-    while (<FILE>) {\r
-       my ($key, $rest, @temp);\r
-       chomp;\r
-       ($key, $rest) = split (/,/, $_, 2);\r
-       if ($key =~ /^[0-9]+$/ && $rest) {\r
-           @temp = split (/,/, $rest);\r
-           $hash->{$key} = \@temp;\r
-        }\r
-    }\r
-    close FILE;\r
-    return;\r
-}\r
-\r
-sub writehasharray {\r
-    my ($filename, $hash) = @_;\r
-    my ($key, @temp, $i);\r
-\r
-    open(FILE, ">$filename") or die "Unable to write to file $filename";\r
-\r
-    foreach $key (keys %$hash) {\r
-       if ( $hash->{$key} ) {\r
-           print FILE "$key";\r
-           foreach $i (0 .. $#{$hash->{$key}}) {\r
-               print FILE ",$hash->{$key}[$i]";\r
-           }\r
-       }\r
-       print FILE "\n";\r
-    }\r
-    close FILE;\r
-    return;\r
-}\r
-\r
-sub findhasharraykey {\r
-    foreach my $i (1 .. 1000000) {\r
-       if ( ! exists $_[0]{$i}) {\r
-            return $i;\r
-       }\r
-    }\r
-}\r
-\r
-sub srtarray \r
-# Darren Critchley - darrenc@telus.net - (c) 2003\r
-# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)\r
-# This subroutine will take the following parameters:\r
-#   ColumnNumber = the column which you want to sort on, starts at 1\r
-#   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic\r
-#   SortDirection = asc or dsc (lowercase) Ascending or Descending sort\r
-#   ArrayToBeSorted = the array that wants sorting\r
-#\r
-#   Returns an array that is sorted to your specs\r
-#\r
-#   If SortOrder is greater than the elements in array, then it defaults to the first element\r
-# \r
-{\r
-       my ($colno, $alpnum, $srtdir, @tobesorted) = @_;\r
-       my @tmparray;\r
-       my @srtedarray;\r
-       my $line;\r
-       my $newline;\r
-       my $ctr;\r
-       my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array\r
-       if ($ttlitems < 1){ # if no items, don't waste our time lets leave\r
-               return (@tobesorted);\r
-       }\r
-       my @tmp = split(/\,/,$tobesorted[0]);\r
-       $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array\r
-\r
-       # Darren Critchley - validate parameters\r
-       if ($colno > $ttlitems){$colno = '1';}\r
-       $colno--; # remove one from colno to deal with arrays starting at 0\r
-       if($colno < 0){$colno = '0';}\r
-       if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }\r
-       if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }\r
-\r
-       foreach $line (@tobesorted)\r
-       {\r
-               chomp($line);\r
-               if ($line ne '') {\r
-                       my @temp = split(/\,/,$line);\r
-                       # Darren Critchley - juggle the fields so that the one we want to sort on is first\r
-                       my $tmpholder = $temp[0];\r
-                       $temp[0] = $temp[$colno];\r
-                       $temp[$colno] = $tmpholder;\r
-                       $newline = "";\r
-                       for ($ctr=0; $ctr < $ttlitems ; $ctr++) {\r
-                               $newline=$newline . $temp[$ctr] . ",";\r
-                       }\r
-                       chop($newline);\r
-                       push(@tmparray,$newline);\r
-               }\r
-       }\r
-       if ($alpnum eq 'n') {\r
-               @tmparray = sort {$a <=> $b} @tmparray;\r
-       } else {\r
-               @tmparray = (sort @tmparray);\r
-       }\r
-       foreach $line (@tmparray)\r
-       {\r
-               chomp($line);\r
-               if ($line ne '') {\r
-                       my @temp = split(/\,/,$line);\r
-                       my $tmpholder = $temp[0];\r
-                       $temp[0] = $temp[$colno];\r
-                       $temp[$colno] = $tmpholder;\r
-                       $newline = "";\r
-                       for ($ctr=0; $ctr < $ttlitems ; $ctr++){\r
-                               $newline=$newline . $temp[$ctr] . ",";\r
-                       }\r
-                       chop($newline);\r
-                       push(@srtedarray,$newline);\r
-               }\r
-       }\r
-\r
-       if ($srtdir eq 'dsc') {\r
-               @tmparray = reverse(@srtedarray);\r
-               return (@tmparray);\r
-       } else {\r
-               return (@srtedarray);\r
-       }\r
-}\r
-\r
-sub FetchPublicIp {\r
-    my %proxysettings;\r
-    &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);\r
-    if ($_=$proxysettings{'UPSTREAM_PROXY'}) {\r
-        my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);\r
-        Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );\r
-    }\r
-    my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',\r
-                                                   80,\r
-                                                   "/",\r
-                                                   Net::SSLeay::make_headers('User-Agent' => 'Ipcop' )\r
-                                               );\r
-    if ($response =~ m%HTTP/1\.. 200 OK%) {\r
-       $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;\r
-       return $1;\r
-    }\r
-    return '';\r
-}\r
-\r
-#\r
-# Check if hostname.domain provided have IP provided\r
-# use gethostbyname to verify that\r
-# Params:\r
-#      IP\r
-#      hostname\r
-#      domain\r
-# Output \r
-#      1 IP matches host.domain\r
-#      0 not in sync\r
-#\r
-sub DyndnsServiceSync ($;$;$) {\r
\r
-    my ($ip,$hostName,$domain) = @_;\r
-    my @addresses;\r
-\r
-    #fix me no ip GROUP, what is the name ?\r
-    $hostName =~ s/$General::noipprefix//;\r
-    if ($hostName) { #may be empty\r
-       $hostName = "$hostName.$domain";\r
-       @addresses = gethostbyname($hostName);\r
-    }\r
-\r
-    if ($addresses[0] eq '') {                 # nothing returned ?\r
-       $hostName = $domain;                    # try resolving with domain only\r
-        @addresses = gethostbyname($hostName);\r
-    }\r
-\r
-    if ($addresses[0] ne '') {                         # got something ?\r
-       #&General::log("name:$addresses[0], alias:$addresses[1]");                          \r
-       # Build clear text list of IP\r
-       @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);\r
-       if (grep (/$ip/, @addresses)) {\r
-           return 1;\r
-       }\r
-    }\r
-    return 0;\r
-}\r
-#\r
-# This sub returns the red IP used to compare in DyndnsServiceSync\r
-#\r
-sub GetDyndnsRedIP {\r
-    my %settings;\r
-    &General::readhash("${General::swroot}/ddns/settings", \%settings);\r
-\r
-    open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';\r
-    my $ip = <IP>;\r
-    close(IP);\r
-    chomp $ip;\r
-\r
-    if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||\r
-        &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||\r
-        &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))\r
-    {\r
-       if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {\r
-           my $RealIP = &General::FetchPublicIp;\r
-           $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');\r
-       }\r
-    }\r
-    return $ip;\r
-}\r
-1;\r
+# SmoothWall CGIs
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) The SmoothWall Team
+# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
+# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
+# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
+# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
+# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
+#
+# $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
+#
+
+package General;
+
+use strict;
+use Socket;
+use IO::Socket;
+
+$|=1; # line buffering
+
+$General::version = 'VERSION';
+$General::swroot = 'CONFIG_ROOT';
+$General::noipprefix = 'noipg-';
+$General::adminmanualurl = 'http://www.ipcop.org/1.4.0/en/admin/html';
+
+sub log
+{
+       my $logmessage = $_[0];
+       $logmessage =~ /([\w\W]*)/;
+       $logmessage = $1;
+       system('/usr/bin/logger', '-t', 'ipcop', $logmessage);
+}
+
+sub readhash
+{
+       my $filename = $_[0];
+       my $hash = $_[1];
+       my ($var, $val);
+       
+       
+       # Some ipcop code expects that readhash 'complete' the hash if new entries
+       # are presents. Not clear it !!!
+       #%$hash = ();
+
+       open(FILE, $filename) or die "Unable to read file $filename";
+       
+       while (<FILE>)
+       {
+               chop;
+               ($var, $val) = split /=/, $_, 2;
+               if ($var)
+               {
+                       $val =~ s/^\'//g;
+                       $val =~ s/\'$//g;
+
+                       # Untaint variables read from hash
+                       $var =~ /([A-Za-z0-9_-]*)/;        $var = $1;
+                       $val =~ /([\w\W]*)/; $val = $1;
+                       $hash->{$var} = $val;
+               }
+       }
+       close FILE;
+}
+
+
+sub writehash
+{
+       my $filename = $_[0];
+       my $hash = $_[1];
+       my ($var, $val);
+       
+       # write cgi vars to the file.
+       open(FILE, ">${filename}") or die "Unable to write file $filename";
+       flock FILE, 2;
+       foreach $var (keys %$hash) 
+       {
+               $val = $hash->{$var};
+               # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
+               # location of the mouse are submitted as well, this was being written to the settings file causing
+               # some serious grief! This skips the variable.x and variable.y
+               if (!($var =~ /(.x|.y)$/)) {
+                       if ($val =~ / /) {
+                               $val = "\'$val\'"; }
+                       if (!($var =~ /^ACTION/)) {
+                               print FILE "${var}=${val}\n"; }
+               }
+       }
+       close FILE;
+}
+
+
+sub age
+{
+       my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
+               $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
+       my $now = time;
+
+       my $totalsecs = $now - $mtime;
+       my $days = int($totalsecs / 86400);
+       my $totalhours = int($totalsecs / 3600);
+       my $hours = $totalhours % 24;
+       my $totalmins = int($totalsecs / 60);
+       my $mins = $totalmins % 60;
+       my $secs = $totalsecs % 60;
+
+       return "${days}d ${hours}h ${mins}m ${secs}s";
+}
+
+sub validip
+{
+       my $ip = $_[0];
+
+       if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
+               return 0; }
+       else 
+       {
+               my @octets = ($1, $2, $3, $4);
+               foreach $_ (@octets)
+               {
+                       if (/^0./) {
+                               return 0; }
+                       if ($_ < 0 || $_ > 255) {
+                               return 0; }
+               }
+               return 1;
+       }
+}
+
+sub validmask
+{
+       my $mask = $_[0];
+
+       # secord part an ip?
+       if (&validip($mask)) {
+               return 1; }
+       # second part a number?
+       if (/^0/) {
+               return 0; }
+       if (!($mask =~ /^\d+$/)) {
+               return 0; }
+       if ($mask >= 0 && $mask <= 32) {
+               return 1; }
+       return 0;
+}
+
+sub validipormask
+{
+       my $ipormask = $_[0];
+
+       # see if it is a IP only.
+       if (&validip($ipormask)) {
+               return 1; }
+       # split it into number and mask.
+       if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
+               return 0; }
+       my $ip = $1;
+       my $mask = $2;
+       # first part not a ip?
+       if (!(&validip($ip))) {
+               return 0; }
+       return &validmask($mask);
+}
+
+sub validipandmask
+{
+       my $ipandmask = $_[0];
+
+       # split it into number and mask.
+       if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
+               return 0; }
+       my $ip = $1;
+       my $mask = $2;
+       # first part not a ip?
+       if (!(&validip($ip))) {
+               return 0; }
+       return &validmask($mask);
+}
+
+sub validport
+{
+       $_ = $_[0];
+
+       if (!/^\d+$/) {
+               return 0; }
+       if (/^0./) {
+               return 0; }
+       if ($_ >= 1 && $_ <= 65535) {
+               return 1; }
+       return 0;
+}
+
+sub validmac
+{
+       my $checkmac = $_[0];
+       my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
+       if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
+       {
+               return 0;
+       }
+       return 1;
+}
+
+sub validhostname
+{
+       # Checks a hostname against RFC1035
+        my $hostname = $_[0];
+
+       # Each part should be at least two characters in length
+       # but no more than 63 characters
+       if (length ($hostname) < 1 || length ($hostname) > 63) {
+               return 0;}
+       # Only valid characters are a-z, A-Z, 0-9 and -
+       if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
+               return 0;}
+       # First character can only be a letter or a digit
+       if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+               return 0;}
+       # Last character can only be a letter or a digit
+       if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+               return 0;}
+       return 1;
+}
+
+sub validdomainname
+{
+       my $part;
+
+       # Checks a domain name against RFC1035
+        my $domainname = $_[0];
+       my @parts = split (/\./, $domainname);  # Split hostname at the '.'
+
+       foreach $part (@parts) {
+               # Each part should be at least two characters in length
+               # but no more than 63 characters
+               if (length ($part) < 2 || length ($part) > 63) {
+                       return 0;}
+               # Only valid characters are a-z, A-Z, 0-9 and -
+               if ($part !~ /^[a-zA-Z0-9-]*$/) {
+                       return 0;}
+               # First character can only be a letter or a digit
+               if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+                       return 0;}
+               # Last character can only be a letter or a digit
+               if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+                       return 0;}
+       }
+       return 1;
+}
+
+sub validfqdn
+{
+       my $part;
+
+       # Checks a fully qualified domain name against RFC1035
+        my $fqdn = $_[0];
+       my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
+       if (scalar(@parts) < 2) {               # At least two parts should
+               return 0;}                      # exist in a FQDN
+                                               # (i.e. hostname.domain)
+       foreach $part (@parts) {
+               # Each part should be at least one character in length
+               # but no more than 63 characters
+               if (length ($part) < 1 || length ($part) > 63) {
+                       return 0;}
+               # Only valid characters are a-z, A-Z, 0-9 and -
+               if ($part !~ /^[a-zA-Z0-9-]*$/) {
+                       return 0;}
+               # First character can only be a letter or a digit
+               if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+                       return 0;}
+               # Last character can only be a letter or a digit
+               if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+                       return 0;}
+       }
+       return 1;
+}
+
+sub validportrange # used to check a port range 
+{
+       my $port = $_[0]; # port values
+       $port =~ tr/-/:/; # replace all - with colons just in case someone used -
+       my $srcdst = $_[1]; # is it a source or destination port
+
+       if (!($port =~ /^(\d+)\:(\d+)$/)) {
+       
+               if (!(&validport($port))) {      
+                       if ($srcdst eq 'src'){
+                               return $Lang::tr{'source port numbers'};
+                       } else  {
+                               return $Lang::tr{'destination port numbers'};
+                       } 
+               }
+       }
+       else 
+       {
+               my @ports = ($1, $2);
+               if ($1 >= $2){
+                       if ($srcdst eq 'src'){
+                               return $Lang::tr{'bad source range'};
+                       } else  {
+                               return $Lang::tr{'bad destination range'};
+                       } 
+               }
+               foreach $_ (@ports)
+               {
+                       if (!(&validport($_))) {
+                               if ($srcdst eq 'src'){
+                                       return $Lang::tr{'source port numbers'}; 
+                               } else  {
+                                       return $Lang::tr{'destination port numbers'};
+                               } 
+                       }
+               }
+               return;
+       }
+}
+
+# Test if IP is within a subnet
+# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
+#       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
+#       Everything in dottted notation
+# Return: TRUE/FALSE
+sub IpInSubnet
+{
+    my $ip = unpack('N', &Socket::inet_aton(shift));
+    my $start = unpack('N', &Socket::inet_aton(shift));
+    my $mask  = unpack('N', &Socket::inet_aton(shift));
+       $start &= $mask;  # base of subnet...
+    my $end   = $start + ~$mask;
+    return (($ip >= $start) && ($ip <= $end));
+}
+
+sub validemail {
+    my $mail = shift;
+    return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
+    return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
+    return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
+    return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
+    return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
+    return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
+    return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
+    return 1;
+}
+
+sub readhasharray {
+    my ($filename, $hash) = @_;
+    %$hash = ();
+
+    open(FILE, $filename) or die "Unable to read file $filename";
+
+    while (<FILE>) {
+       my ($key, $rest, @temp);
+       chomp;
+       ($key, $rest) = split (/,/, $_, 2);
+       if ($key =~ /^[0-9]+$/ && $rest) {
+           @temp = split (/,/, $rest);
+           $hash->{$key} = \@temp;
+        }
+    }
+    close FILE;
+    return;
+}
+
+sub writehasharray {
+    my ($filename, $hash) = @_;
+    my ($key, @temp, $i);
+
+    open(FILE, ">$filename") or die "Unable to write to file $filename";
+
+    foreach $key (keys %$hash) {
+       if ( $hash->{$key} ) {
+           print FILE "$key";
+           foreach $i (0 .. $#{$hash->{$key}}) {
+               print FILE ",$hash->{$key}[$i]";
+           }
+       }
+       print FILE "\n";
+    }
+    close FILE;
+    return;
+}
+
+sub findhasharraykey {
+    foreach my $i (1 .. 1000000) {
+       if ( ! exists $_[0]{$i}) {
+            return $i;
+       }
+    }
+}
+
+sub srtarray 
+# Darren Critchley - darrenc@telus.net - (c) 2003
+# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
+# This subroutine will take the following parameters:
+#   ColumnNumber = the column which you want to sort on, starts at 1
+#   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
+#   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
+#   ArrayToBeSorted = the array that wants sorting
+#
+#   Returns an array that is sorted to your specs
+#
+#   If SortOrder is greater than the elements in array, then it defaults to the first element
+# 
+{
+       my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
+       my @tmparray;
+       my @srtedarray;
+       my $line;
+       my $newline;
+       my $ctr;
+       my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
+       if ($ttlitems < 1){ # if no items, don't waste our time lets leave
+               return (@tobesorted);
+       }
+       my @tmp = split(/\,/,$tobesorted[0]);
+       $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
+
+       # Darren Critchley - validate parameters
+       if ($colno > $ttlitems){$colno = '1';}
+       $colno--; # remove one from colno to deal with arrays starting at 0
+       if($colno < 0){$colno = '0';}
+       if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
+       if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
+
+       foreach $line (@tobesorted)
+       {
+               chomp($line);
+               if ($line ne '') {
+                       my @temp = split(/\,/,$line);
+                       # Darren Critchley - juggle the fields so that the one we want to sort on is first
+                       my $tmpholder = $temp[0];
+                       $temp[0] = $temp[$colno];
+                       $temp[$colno] = $tmpholder;
+                       $newline = "";
+                       for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
+                               $newline=$newline . $temp[$ctr] . ",";
+                       }
+                       chop($newline);
+                       push(@tmparray,$newline);
+               }
+       }
+       if ($alpnum eq 'n') {
+               @tmparray = sort {$a <=> $b} @tmparray;
+       } else {
+               @tmparray = (sort @tmparray);
+       }
+       foreach $line (@tmparray)
+       {
+               chomp($line);
+               if ($line ne '') {
+                       my @temp = split(/\,/,$line);
+                       my $tmpholder = $temp[0];
+                       $temp[0] = $temp[$colno];
+                       $temp[$colno] = $tmpholder;
+                       $newline = "";
+                       for ($ctr=0; $ctr < $ttlitems ; $ctr++){
+                               $newline=$newline . $temp[$ctr] . ",";
+                       }
+                       chop($newline);
+                       push(@srtedarray,$newline);
+               }
+       }
+
+       if ($srtdir eq 'dsc') {
+               @tmparray = reverse(@srtedarray);
+               return (@tmparray);
+       } else {
+               return (@srtedarray);
+       }
+}
+
+sub FetchPublicIp {
+    my %proxysettings;
+    &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
+    if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
+        my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
+        Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
+    }
+    my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
+                                                   80,
+                                                   "/",
+                                                   Net::SSLeay::make_headers('User-Agent' => 'Ipcop' )
+                                               );
+    if ($response =~ m%HTTP/1\.. 200 OK%) {
+       $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
+       return $1;
+    }
+    return '';
+}
+
+#
+# Check if hostname.domain provided have IP provided
+# use gethostbyname to verify that
+# Params:
+#      IP
+#      hostname
+#      domain
+# Output 
+#      1 IP matches host.domain
+#      0 not in sync
+#
+sub DyndnsServiceSync ($;$;$) {
+    my ($ip,$hostName,$domain) = @_;
+    my @addresses;
+
+    #fix me no ip GROUP, what is the name ?
+    $hostName =~ s/$General::noipprefix//;
+    if ($hostName) { #may be empty
+       $hostName = "$hostName.$domain";
+       @addresses = gethostbyname($hostName);
+    }
+
+    if ($addresses[0] eq '') {                 # nothing returned ?
+       $hostName = $domain;                    # try resolving with domain only
+        @addresses = gethostbyname($hostName);
+    }
+
+    if ($addresses[0] ne '') {                         # got something ?
+       #&General::log("name:$addresses[0], alias:$addresses[1]");                          
+       # Build clear text list of IP
+       @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
+       if (grep (/$ip/, @addresses)) {
+           return 1;
+       }
+    }
+    return 0;
+}
+#
+# This sub returns the red IP used to compare in DyndnsServiceSync
+#
+sub GetDyndnsRedIP {
+    my %settings;
+    &General::readhash("${General::swroot}/ddns/settings", \%settings);
+
+    open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
+    my $ip = <IP>;
+    close(IP);
+    chomp $ip;
+
+    if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
+        &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
+        &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
+    {
+       if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
+           my $RealIP = &General::FetchPublicIp;
+           $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
+       }
+    }
+    return $ip;
+}
+1;
index b2151ea..ead049d 100644 (file)
@@ -1,24 +1,24 @@
-sub genmenu\r
-{\r
-    ... snip ...\r
-    if ( ! -e "${General::swroot}/proxy/enable" && ! -e "${General::swroot}/proxy/enable_blue" ) {\r
-       splice (@{$menu{'2.status'}{'subMenu'}}, 4, 1);\r
-       splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 2, 1);\r
-    }\r
-\r
-    # Read additionnal menus entry\r
-    # this have to be hardened and accepted. To be extended.\r
-    opendir (DIR, "${General::swroot}/addon-menu");\r
-    while (my $menuitem = readdir (DIR)) {\r
-\r
-       if ( $menuitem =~ /^menu\.([1-6]\..*)\..*/) {  #model is "menu.(N.submenu).filename"\r
-           my $submenu = $1;\r
-           open (FILE,"${General::swroot}/addon-menu/$menuitem") or die;\r
-           while (my $text = <FILE>) {     # file may content many entry\r
-               splice (@{$menu{$submenu}{'subMenu'}} ,-1,0, [ eval($text) ] );\r
-           }\r
-           close (FILE);\r
-       }\r
-    }\r
-    closedir (DIR);\r
-}\r
+sub genmenu
+{
+    ... snip ...
+    if ( ! -e "${General::swroot}/proxy/enable" && ! -e "${General::swroot}/proxy/enable_blue" ) {
+       splice (@{$menu{'2.status'}{'subMenu'}}, 4, 1);
+       splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 2, 1);
+    }
+
+    # Read additionnal menus entry
+    # this have to be hardened and accepted. To be extended.
+    opendir (DIR, "${General::swroot}/addon-menu");
+    while (my $menuitem = readdir (DIR)) {
+
+       if ( $menuitem =~ /^menu\.([1-6]\..*)\..*/) {  #model is "menu.(N.submenu).filename"
+           my $submenu = $1;
+           open (FILE,"${General::swroot}/addon-menu/$menuitem") or die;
+           while (my $text = <FILE>) {     # file may content many entry
+               splice (@{$menu{$submenu}{'subMenu'}} ,-1,0, [ eval($text) ] );
+           }
+           close (FILE);
+       }
+    }
+    closedir (DIR);
+}
index c15187a..b16a98c 100644 (file)
-# SmoothWall CGIs\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) The SmoothWall Team\r
-# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite\r
-# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()\r
-# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions\r
-# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()\r
-# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()\r
-#\r
-# $Id: header.pl,v 1.34.2.67 2005/10/03 20:01:05 gespinasse Exp $\r
-#\r
-\r
-package Header;\r
-\r
-use strict;\r
-use CGI();\r
-use Time::Local;\r
-\r
-# enable only the following on debugging purpose\r
-#use warnings;\r
-#use CGI::Carp 'fatalsToBrowser';\r
-\r
-\r
-$Header::pagecolour = '#ffffff';       # never used, will be removed\r
-$Header::tablecolour = '#FFFFFF';      # never used, will be removed\r
-$Header::bigboxcolour = '#F6F4F4';     # never used, will be removed\r
-$Header::boxcolour = '#EAE9EE';                # only header.pl, ? move in css ?\r
-$Header::bordercolour = '#000000';     # never used, will be removed\r
-$Header::table1colour = '#C0C0C0';\r
-$Header::table2colour = '#F2F2F2';\r
-$Header::colourred = '#993333';\r
-$Header::colourorange = '#FF9933';\r
-$Header::colouryellow = '#FFFF00';\r
-$Header::colourgreen = '#339933';\r
-$Header::colourblue = '#333399';\r
-$Header::colourfw = '#000000';         # only connections.cgi\r
-$Header::colourvpn = '#990099';                # only connections.cgi\r
-$Header::colourerr = '#FF0000';                # only header.pl, many scripts use colourred for warnings messages\r
-$Header::viewsize = 150;\r
-my %menu = ();\r
-my $hostnameintitle = 0;\r
-our $javascript = 1;\r
-\r
-### Initialize menu\r
-sub genmenu\r
-{\r
-    ### Initialize environment\r
-    my %ethsettings = ();\r
-    &General::readhash("${General::swroot}/ethernet/settings", \%ethsettings);\r
-\r
-    %{$menu{'1.system'}}=(\r
-               'contents' =>  $Lang::tr{'alt system'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'alt system'}",\r
-               'subMenu' =>   [[ $Lang::tr{'alt home'} , '/cgi-bin/index.cgi', "IPCop $Lang::tr{'alt home'}" ],\r
-                               [ $Lang::tr{'updates'} , '/cgi-bin/updates.cgi', "IPCop $Lang::tr{'updates'}" ],\r
-                               [ $Lang::tr{'sspasswords'} , '/cgi-bin/changepw.cgi', "IPCop $Lang::tr{'sspasswords'}" ],\r
-                               [ $Lang::tr{'ssh access'} , '/cgi-bin/remote.cgi', "IPCop $Lang::tr{'ssh access'}" ],\r
-                               [ $Lang::tr{'gui settings'} , '/cgi-bin/gui.cgi', "IPCop $Lang::tr{'gui settings'}" ],\r
-                               [ $Lang::tr{'backup'} , '/cgi-bin/backup.cgi', "IPCop $Lang::tr{'backup'} / $Lang::tr{'restore'}" ],\r
-                               [ $Lang::tr{'shutdown'} , '/cgi-bin/shutdown.cgi', "IPCop $Lang::tr{'shutdown'} / $Lang::tr{'reboot'}" ],\r
-                               [ $Lang::tr{'credits'} , '/cgi-bin/credits.cgi', "IPCop $Lang::tr{'credits'}" ]]\r
-    );\r
-    %{$menu{'2.status'}}=(\r
-               'contents' =>  $Lang::tr{'status'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'status information'}",\r
-               'subMenu' =>   [[ $Lang::tr{'sssystem status'} , '/cgi-bin/status.cgi', "IPCop $Lang::tr{'system status information'}" ],\r
-                               [ $Lang::tr{'ssnetwork status'} , '/cgi-bin/netstatus.cgi', "IPCop $Lang::tr{'network status information'}" ],\r
-                               [ $Lang::tr{'system graphs'} , '/cgi-bin/graphs.cgi', "IPCop $Lang::tr{'system graphs'}" ],\r
-                               [ $Lang::tr{'sstraffic graphs'} , '/cgi-bin/graphs.cgi?graph=network', "IPCop $Lang::tr{'network traffic graphs'}" ],\r
-                               [ $Lang::tr{'ssproxy graphs'} , '/cgi-bin/proxygraphs.cgi', "IPCop $Lang::tr{'proxy access graphs'}" ],\r
-                               [ $Lang::tr{'connections'} , '/cgi-bin/connections.cgi', "IPCop $Lang::tr{'connections'}" ]]\r
-    );\r
-    %{$menu{'3.network'}}=(\r
-               'contents' =>  $Lang::tr{'network'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'network configuration'}",\r
-               'subMenu' =>   [[ $Lang::tr{'alt dialup'} , '/cgi-bin/pppsetup.cgi', "IPCop $Lang::tr{'dialup settings'}" ],\r
-                               [ $Lang::tr{'upload'} , '/cgi-bin/upload.cgi', $Lang::tr{'firmware upload'} ],\r
-                               [ $Lang::tr{'modem'} , '/cgi-bin/modem.cgi', "IPCop $Lang::tr{'modem configuration'}" ],\r
-                               [ $Lang::tr{'aliases'} , '/cgi-bin/aliases.cgi', "IPCop $Lang::tr{'external aliases configuration'}" ]]\r
-    );\r
-    %{$menu{'4.services'}}=(\r
-               'contents' =>  $Lang::tr{'alt services'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'alt services'}",\r
-               'subMenu' =>   [[ $Lang::tr{'proxy'} , '/cgi-bin/proxy.cgi', "IPCop $Lang::tr{'web proxy configuration'}" ],\r
-                               [ $Lang::tr{'dhcp server'} , '/cgi-bin/dhcp.cgi', "IPCop $Lang::tr{'dhcp configuration'}" ],\r
-                               [ $Lang::tr{'dynamic dns'} , '/cgi-bin/ddns.cgi', "IPCop $Lang::tr{'dynamic dns client'}" ],\r
-                               [ $Lang::tr{'edit hosts'} , '/cgi-bin/hosts.cgi', "IPCop $Lang::tr{'host configuration'}" ],\r
-                               [ $Lang::tr{'time server'} , '/cgi-bin/time.cgi', "IPCop $Lang::tr{'time server'}" ],\r
-                               [ $Lang::tr{'traffic shaping'} , '/cgi-bin/shaping.cgi', "IPCop $Lang::tr{'traffic shaping settings'}" ],\r
-                               [ $Lang::tr{'intrusion detection'} , '/cgi-bin/ids.cgi', "IPCop $Lang::tr{'intrusion detection system'} (Snort)" ]]\r
-    );\r
-    %{$menu{'5.firewall'}}=(\r
-               'contents' =>  $Lang::tr{'firewall'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'firewall'}",\r
-               'subMenu' =>   [[ $Lang::tr{'ssport forwarding'} , '/cgi-bin/portfw.cgi', "IPCop $Lang::tr{'port forwarding configuration'}" ],\r
-                               [ $Lang::tr{'external access'} , '/cgi-bin/xtaccess.cgi', "IPCop $Lang::tr{'external access configuration'}" ],\r
-                               [ $Lang::tr{'ssdmz pinholes'} , '/cgi-bin/dmzholes.cgi', "IPCop $Lang::tr{'dmz pinhole configuration'}" ],\r
-                               [ $Lang::tr{'blue access'} , '/cgi-bin/wireless.cgi', "IPCop $Lang::tr{'blue access'}" ]\r
-                               ,[ $Lang::tr{'options fw'} , '/cgi-bin/optionsfw.cgi', "IPCop $Lang::tr{'options fw'}" ]\r
-                              ]\r
-    );\r
-    %{$menu{'6.vpns'}}=(\r
-               'contents' =>  $Lang::tr{'alt vpn'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'virtual private networking'}",\r
-               'subMenu' =>   [[ $Lang::tr{'alt vpn'} , '/cgi-bin/vpnmain.cgi', "IPCop $Lang::tr{'virtual private networking'}"]]\r
-    );\r
-    %{$menu{'7.mainlogs'}}=(\r
-               'contents' =>  $Lang::tr{'alt logs'},\r
-               'uri' => '',\r
-               'statusText' => "IPCop $Lang::tr{'alt logs'}",\r
-               'subMenu' =>   [[ $Lang::tr{'log settings'} , '/cgi-bin/logs.cgi/config.dat', "IPCop $Lang::tr{'log settings'}" ],\r
-                               [ $Lang::tr{'log summary'} , '/cgi-bin/logs.cgi/summary.dat', "IPCop $Lang::tr{'log summary'}" ],\r
-                               [ $Lang::tr{'proxy logs'} , '/cgi-bin/logs.cgi/proxylog.dat', "IPCop $Lang::tr{'proxy log viewer'}" ],\r
-                               [ $Lang::tr{'firewall logs'} , '/cgi-bin/logs.cgi/firewalllog.dat', "IPCop $Lang::tr{'firewall log viewer'}" ],\r
-                               [ $Lang::tr{'ids logs'} , '/cgi-bin/logs.cgi/ids.dat', "IPCop $Lang::tr{'intrusion detection system log viewer'}" ],\r
-                               [ $Lang::tr{'system logs'} , '/cgi-bin/logs.cgi/log.dat', "IPCop $Lang::tr{'system log viewer'}" ]]\r
-    );\r
-    if (! $ethsettings{'BLUE_DEV'}) {\r
-       splice (@{$menu{'5.firewall'}{'subMenu'}}, 3, 1);\r
-    }\r
-    if (! $ethsettings{'BLUE_DEV'} && ! $ethsettings{'ORANGE_DEV'}) {\r
-       splice (@{$menu{'5.firewall'}{'subMenu'}}, 2, 1);\r
-    }\r
-    unless ( $ethsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $ethsettings{'RED_TYPE'} eq 'STATIC' ) {\r
-       splice (@{$menu{'3.network'}{'subMenu'}}, 3, 1);\r
-    }\r
-    if ( ! -e "${General::swroot}/snort/enable" && ! -e "${General::swroot}/snort/enable_blue" &&\r
-       ! -e "${General::swroot}/snort/enable_green" && ! -e "${General::swroot}/snort/enable_orange") {\r
-       splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 4, 1);\r
-    }\r
-    if ( ! -e "${General::swroot}/proxy/enable" && ! -e "${General::swroot}/proxy/enable_blue" ) {\r
-       splice (@{$menu{'2.status'}{'subMenu'}}, 4, 1);\r
-       splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 2, 1);\r
-    }\r
-}\r
-\r
-sub showhttpheaders\r
-{\r
-    ### Make sure this is an SSL request\r
-    if ($ENV{'SERVER_ADDR'} && $ENV{'HTTPS'} ne 'on') {\r
-       print "Status: 302 Moved\r\n";\r
-       print "Location: https://$ENV{'SERVER_ADDR'}:445/$ENV{'PATH_INFO'}\r\n\r\n";\r
-       exit 0;\r
-    } else {\r
-       print "Pragma: no-cache\n";\r
-       print "Cache-control: no-cache\n";\r
-       print "Connection: close\n";\r
-       print "Content-type: text/html\n\n";\r
-    }\r
-}\r
-\r
-sub showjsmenu\r
-{\r
-    my $c1 = 1;\r
-\r
-    print "    <script type='text/javascript'>\n";\r
-    print "    domMenu_data.setItem('domMenu_main', new domMenu_Hash(\n";\r
-\r
-    foreach my $k1 ( sort keys %menu ) {\r
-       my $c2 = 1;\r
-       if ($c1 > 1) {\r
-           print "    ),\n";\r
-       }\r
-       print "    $c1, new domMenu_Hash(\n";\r
-       print "\t'contents', '" . &cleanhtml($menu{$k1}{'contents'}) . "',\n";\r
-       print "\t'uri', '$menu{$k1}{'uri'}',\n";\r
-       $menu{$k1}{'statusText'} =~  s/'/\\\'/g;\r
-       print "\t'statusText', '$menu{$k1}{'statusText'}',\n";\r
-       foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {\r
-           print "\t    $c2, new domMenu_Hash(\n";\r
-           print "\t\t'contents', '" . &cleanhtml(@{$k2}[0])  . "',\n";\r
-           print "\t\t'uri', '@{$k2}[1]',\n";\r
-           @{$k2}[2] =~ s/'/\\\'/g;\r
-           print "\t\t'statusText', '@{$k2}[2]'\n";\r
-           if ( $c2 <= $#{$menu{$k1}{'subMenu'}} ) {\r
-               print "\t    ),\n";\r
-           } else {\r
-               print "\t    )\n";\r
-           }\r
-           $c2++;\r
-       }\r
-       $c1++;\r
-    }\r
-    print "    )\n";\r
-    print "    ));\n\n";\r
-\r
-    print <<EOF\r
-    domMenu_settings.setItem('domMenu_main', new domMenu_Hash(\r
-       'menuBarWidth', '0%',\r
-       'menuBarClass', 'ipcop_menuBar',\r
-       'menuElementClass', 'ipcop_menuElement',\r
-       'menuElementHoverClass', 'ipcop_menuElementHover',\r
-       'menuElementActiveClass', 'ipcop_menuElementHover',\r
-       'subMenuBarClass', 'ipcop_subMenuBar',\r
-       'subMenuElementClass', 'ipcop_subMenuElement',\r
-       'subMenuElementHoverClass', 'ipcop_subMenuElementHover',\r
-       'subMenuElementActiveClass', 'ipcop_subMenuElementHover',\r
-       'subMenuMinWidth', 'auto',\r
-       'distributeSpace', false,\r
-       'openMouseoverMenuDelay', 0,\r
-       'openMousedownMenuDelay', 0,\r
-       'closeClickMenuDelay', 0,\r
-       'closeMouseoutMenuDelay', -1\r
-    ));\r
-    </script>\r
-EOF\r
-    ;\r
-}\r
-\r
-sub showmenu\r
-{\r
-    if ($javascript) {print "<noscript>";}\r
-    print "<table cellpadding='0' cellspacing='0' border='0'>\n";\r
-    print "<tr>\n";\r
-\r
-    foreach my $k1 ( sort keys %menu ) {\r
-       print "<td class='ipcop_menuElementTD'><a href='" . @{@{$menu{$k1}{'subMenu'}}[0]}[1] . "' class='ipcop_menuElementNoJS'>";\r
-       print $menu{$k1}{'contents'} . "</a></td>\n";\r
-    }\r
-    print "</tr></table>\n";\r
-    if ($javascript) {print "</noscript>";}\r
-}\r
-\r
-sub showsubsection\r
-{\r
-    my $location = $_[0];\r
-    my $c1 = 0;\r
-\r
-    if ($javascript) {print "<noscript>";}\r
-    print "<table width='100%' cellspacing='0' cellpadding='5' border='0'>\n";\r
-    print "<tr><td style='background-color: $Header::boxcolour;' width='53'><img src='/images/null.gif' width='43' height='1' alt='' /></td>\n";\r
-    print "<td style='background-color: $Header::boxcolour;' align='left' width='100%'>";\r
-    my @URI=split ('\?',  $ENV{'REQUEST_URI'} );\r
-\r
-    foreach my $k1 ( keys %menu ) {\r
-       \r
-       if ($menu{$k1}{'contents'} eq $location) {\r
-           foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {\r
-               if ($c1 > 0) {\r
-                   print " | ";\r
-               }\r
-               if (@{$k2}[1] eq "$URI[0]\?$URI[1]" || (@{$k2}[1] eq $URI[0] && length($URI[1]) == 0)) {\r
-               #if (@{$k2}[1] eq "$URI[0]") {\r
-                   print "<b>@{$k2}[0]</b>";\r
-               } else {\r
-                   print "<a href='@{$k2}[1]'>@{$k2}[0]</a>";\r
-               }\r
-               $c1++;\r
-           }\r
-       }\r
-    }\r
-    print "</td></tr></table>\n";\r
-    if ($javascript) { print "</noscript>";}\r
-}\r
-\r
-sub openpage\r
-{\r
-    my $title = $_[0];\r
-    my $menu = $_[1];\r
-    my $extrahead = $_[2];\r
-\r
-    ### Initialize environment\r
-    my %settings = ();\r
-    &General::readhash("${General::swroot}/main/settings", \%settings);\r
-\r
-    if ($settings{'JAVASCRIPT'} eq 'off') {\r
-       $javascript = 0;\r
-    } else {\r
-       $javascript = 1;\r
-    }\r
-\r
-    if ($settings{'WINDOWWITHHOSTNAME'} eq 'on') {\r
-        $hostnameintitle = 1;\r
-    } else {\r
-        $hostnameintitle = 0;\r
-    }\r
-\r
-    print <<END\r
-<!DOCTYPE html \r
-     PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\r
-     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\r
-\r
-<html><head>\r
-END\r
-    ;\r
-    print "    <title>";\r
-    if ($hostnameintitle) {\r
-        print "$settings{'HOSTNAME'}.$settings{'DOMAINNAME'} - $title"; \r
-    } else {\r
-        print "IPCop - $title";\r
-    }\r
-    print "</title>\n";\r
-\r
-    print <<END\r
-    $extrahead\r
-    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />\r
-    <link rel="shortcut icon" href="/favicon.ico" />\r
-    <style type="text/css">\@import url(/include/ipcop.css);</style>\r
-END\r
-    ;\r
-    if ($javascript) {\r
-       print "<script type='text/javascript' src='/include/domMenu.js'></script>\n";\r
-       &genmenu();\r
-       &showjsmenu();\r
-    } else {\r
-       &genmenu();\r
-    }\r
-\r
-    my $location = '';\r
-    my $sublocation = '';\r
-    my @URI=split ('\?',  $ENV{'REQUEST_URI'} );\r
-    foreach my $k1 ( keys %menu ) {\r
-       my $temp = $menu{$k1}{'contents'};\r
-       foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {\r
-           if ( @{$k2}[1] eq $URI[0] ) {\r
-               $location = $temp;\r
-               $sublocation = @{$k2}[0];\r
-           }\r
-       }\r
-    }\r
-\r
-    my @cgigraphs = split(/graph=/,$ENV{'QUERY_STRING'});\r
-    if (defined ($cgigraphs[1])){ \r
-       if ($cgigraphs[1] =~ /(GREEN|BLUE|ORANGE|RED|network)/) {\r
-               $location = $Lang::tr{'status'};\r
-               $sublocation = $Lang::tr{'sstraffic graphs'};\r
-       }\r
-       if ($cgigraphs[1] =~ /(cpu|memory|swap|disk)/) {\r
-               $location = $Lang::tr{'status'};\r
-               $sublocation = $Lang::tr{'system graphs'};\r
-       }\r
-    }\r
-    if ($ENV{'QUERY_STRING'} =~ /(ip)/) {\r
-        $location = $Lang::tr{'alt logs'};\r
-       $sublocation = "WHOIS";\r
-    }\r
-\r
-    if ($javascript) {\r
-           print <<END\r
-           <script type="text/javascript">\r
-           document.onmouseup = function()\r
-           {\r
-               domMenu_deactivate('domMenu_main');\r
-           }\r
-           </script>\r
-           </head>\r
-\r
-           <body onload="domMenu_activate('domMenu_main');">\r
-END\r
-           ;\r
-    } else {\r
-       print "</head>\n\n<body>\n";\r
-    }\r
-\r
-    print <<END\r
-<!-- IPCOP HEADER -->\r
-    <table width='100%' cellpadding='0' cellspacing='0'>\r
-    <col width='53' />\r
-    <col />\r
-    <tr><td><img src='/images/null.gif' width='53' height='27' alt='' /></td>\r
-       <td valign='bottom'><table width='100%' cellspacing='0' border='0'>\r
-           <col width='5' />\r
-           <col width='175' />\r
-           <col />\r
-           <tr><td><img src='/images/null.gif' width='5' height='1' alt='' /></td>\r
-               <td class="ipcop_menuLocationMain" valign='bottom'>$location</td>\r
-               <td class="ipcop_menuLocationSub"  valign='bottom'>$sublocation</td>\r
-           </tr></table>\r
-       </td></tr>\r
-    <tr><td valign='bottom' class='ipcop_Version'>\r
-           <img src='/images/null.gif' width='1' height='29' alt='' />${General::version}</td>\r
-       <td valign='bottom'>\r
-END\r
-    ;\r
-    if ($menu == 1) {\r
-       if ($javascript) {\r
-           print "<div id='domMenu_main'></div>\n";\r
-       }\r
-       &showmenu();\r
-    }\r
-    print "    </td></tr></table>\n";\r
-    &showsubsection($location);\r
-    print "<!-- IPCOP CONTENT -->\n";\r
-}\r
-\r
-sub closepage\r
-{\r
-       print <<END\r
-<!-- IPCOP FOOTER -->\r
-    <table width='100%' border='0'>\r
-    <tr><td valign='bottom'><img src='/images/bounceback.png' width='248' height='80' alt='' /></td>\r
-       <td align='center' valign='bottom'>\r
-END\r
-       ;\r
-       my $status = &connectionstatus();\r
-       print "$status<br />\n"; \r
-       print `/usr/bin/uptime`;\r
-\r
-       print <<END\r
-       </td>\r
-       <td valign='bottom'><a href='http://sf.net/projects/ipcop/' target='_blank'><img src='/images/sflogo.png' width='88' height='31' alt='Sourceforge logo' /></a></td>\r
-    </tr></table>\r
-</body></html>\r
-END\r
-       ;\r
-}\r
-\r
-sub openbigbox\r
-{\r
-       my $width = $_[0];\r
-       my $align = $_[1];\r
-       my $sideimg = $_[2];\r
-        my $errormessage = $_[3];\r
-       my $bgcolor;\r
-\r
-       if ($errormessage) {\r
-               $bgcolor = "style='background-color: $Header::colourerr;'";\r
-       } else {\r
-               $bgcolor = '';\r
-       }\r
-\r
-       print "<table width='100%' border='0'>\n";\r
-       if ($sideimg) {\r
-           print "<tr><td valign='top'><img src='/images/$sideimg' width='65' height='345' alt='' /></td>\n";\r
-       } else {\r
-           print "<tr>\n";\r
-       }\r
-       print "<td valign='top' align='center'><table width='$width' $bgcolor cellspacing='0' cellpadding='10' border='0'>\n";\r
-        print "<tr><td><img src='/images/null.gif' width='1' height='365' alt='' /></td>\n";\r
-       print "<td align='$align' valign='top'>\n";\r
-}\r
-\r
-sub closebigbox\r
-{\r
-       print "</td></tr></table></td></tr></table>\n" \r
-}\r
-\r
-sub openbox\r
-{\r
-       my $width = $_[0];\r
-       my $align = $_[1];\r
-       my $caption = $_[2];\r
-\r
-       print <<END\r
-       <table cellspacing="0" cellpadding="0" width="$width" border="0">\r
-           <col width='12' />\r
-           <col width='18' />\r
-           <col width='100%' />\r
-           <col width='152' />\r
-           <col width='11' />\r
-       \r
-           <tr><td width='12'  ><img src='/images/null.gif' width='12'  height='1' alt='' /></td>\r
-               <td width='18'  ><img src='/images/null.gif' width='18'  height='1' alt='' /></td>\r
-               <td width='100%'><img src='/images/null.gif' width='400' height='1' alt='' /></td>\r
-               <td width='152' ><img src='/images/null.gif' width='152' height='1' alt='' /></td>\r
-               <td width='11'  ><img src='/images/null.gif' width='11'   height='1' alt='' /></td></tr>\r
-           <tr><td colspan='2' ><img src='/images/boxtop1.png' width='30' height='53' alt='' /></td>\r
-               <td style='background: url(/images/boxtop2.png);'>\r
-END\r
-       ;\r
-       if ($caption) { print "<b>$caption</b>\n"; } else { print "&nbsp;"; }\r
-       print <<END\r
-               </td>\r
-               <td colspan='2'><img src='/images/boxtop3.png' width='163' height='53' alt='' /></td></tr>\r
-           <tr><td style='background: url(/images/boxleft.png);'><img src='/images/null.gif' width='12' height='1' alt='' /></td>\r
-               <td colspan='3' style='background-color: $Header::boxcolour;'>\r
-               <table width='100%' cellpadding='5'><tr><td align="$align" valign='top'>\r
-END\r
-       ;\r
-}\r
-\r
-sub closebox\r
-{\r
-       print <<END\r
-               </td></tr></table></td>\r
-                <td style='background: url(/images/boxright.png);'><img src='/images/null.gif' width='11' height='1' alt='' /></td></tr>\r
-            <tr><td style='background: url(/images/boxbottom1.png);background-repeat:no-repeat;'><img src='/images/null.gif' width='12' height='14' alt='' /></td>\r
-                <td style='background: url(/images/boxbottom2.png);background-repeat:repeat-x;' colspan='3'><img src='/images/null.gif' width='1' height='14' alt='' /></td>\r
-                <td style='background: url(/images/boxbottom3.png);background-repeat:no-repeat;'><img src='/images/null.gif' width='11' height='14' alt='' /></td></tr>\r
-        </table>\r
-END\r
-       ;\r
-}\r
-\r
-sub getcgihash {\r
-       my ($hash, $params) = @_;\r
-       my $cgi = CGI->new ();\r
-       return if ($ENV{'REQUEST_METHOD'} ne 'POST');\r
-       if (!$params->{'wantfile'}) {\r
-               $CGI::DISABLE_UPLOADS = 1;\r
-               $CGI::POST_MAX        = 512 * 1024;\r
-       } else {\r
-               $CGI::POST_MAX = 10 * 1024 * 1024;\r
-       }\r
-\r
-       $cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;\r
-       my $referer = $1;\r
-       $cgi->url() =~ m/^https?\:\/\/([^\/]+)/;\r
-       my $servername = $1;\r
-       return if ($referer ne $servername);\r
-\r
-       ### Modified for getting multi-vars, split by |\r
-       my %temp = $cgi->Vars();\r
-        foreach my $key (keys %temp) {\r
-               $hash->{$key} = $temp{$key};\r
-               $hash->{$key} =~ s/\0/|/g;\r
-               $hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;\r
-        }\r
-\r
-       if (($params->{'wantfile'})&&($params->{'filevar'})) {\r
-               $hash->{$params->{'filevar'}} = $cgi->upload\r
-                                               ($params->{'filevar'});\r
-       }\r
-       return;\r
-}\r
-\r
-sub cleanhtml\r
-{\r
-       my $outstring =$_[0];\r
-       $outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';\r
-       $outstring =~ s/&/&amp;/g;\r
-       $outstring =~ s/\'/&#039;/g;\r
-       $outstring =~ s/\"/&quot;/g;\r
-       $outstring =~ s/</&lt;/g;\r
-       $outstring =~ s/>/&gt;/g;\r
-       return $outstring;\r
-}\r
-\r
-sub connectionstatus\r
-{\r
-    my %pppsettings = ();\r
-    my %netsettings = ();\r
-    my $iface='';\r
-\r
-    $pppsettings{'PROFILENAME'} = 'None';\r
-    &General::readhash("${General::swroot}/ppp/settings", \%pppsettings);\r
-    &General::readhash("${General::swroot}/ethernet/settings", \%netsettings);\r
-\r
-    my $profileused='';\r
-    if ( ! ( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {\r
-       $profileused="- $pppsettings{'PROFILENAME'}";\r
-    }\r
-\r
-    if ( ( $pppsettings{'METHOD'} eq 'DHCP' && $netsettings{'RED_TYPE'} ne 'PPTP') \r
-                                               || $netsettings{'RED_TYPE'} eq 'DHCP' ) {\r
-               if (open(IFACE, "${General::swroot}/red/iface")) {\r
-                       $iface = <IFACE>;\r
-                       close IFACE;\r
-                       chomp ($iface);\r
-                       $iface =~ /([a-zA-Z0-9]*)/; $iface = $1;\r
-               }\r
-    }\r
-\r
-    my ($timestr, $connstate);\r
-    if ($netsettings{'CONFIG_TYPE'} =~ /^(0|1|4|5)$/ &&  $pppsettings{'TYPE'} =~ /^isdn/) {\r
-       # Count ISDN channels\r
-       my ($idmap, $chmap, $drmap, $usage, $flags, $phone);\r
-       my @phonenumbers;\r
-       my $count=0;\r
-\r
-       open (FILE, "/dev/isdninfo");\r
-\r
-       $idmap = <FILE>; chop $idmap;\r
-       $chmap = <FILE>; chop $chmap;\r
-       $drmap = <FILE>; chop $drmap;\r
-       $usage = <FILE>; chop $usage;\r
-       $flags = <FILE>; chop $flags;\r
-       $phone = <FILE>; chop $phone;\r
-\r
-       $phone =~ s/^phone(\s*):(\s*)//;\r
-\r
-       @phonenumbers = split / /, $phone;\r
-\r
-       foreach (@phonenumbers) {\r
-               if ($_ ne '???') {\r
-                       $count++;\r
-               }\r
-       }\r
-       close (FILE);\r
-\r
-       ## Connection status\r
-       my $number;\r
-       if ($count == 0) {\r
-               $number = 'none!';\r
-       } elsif ($count == 1) {\r
-               $number = 'single';\r
-       } else {\r
-               $number = 'dual';\r
-       }\r
-\r
-       if (-e "${General::swroot}/red/active") {\r
-               $timestr = &General::age("${General::swroot}/red/active");\r
-               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} - $number channel (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";\r
-       } else {\r
-               if ($count == 0) {\r
-                       if (-e "${General::swroot}/red/dial-on-demand") {\r
-                               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";\r
-                       } else {\r
-                               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";\r
-                       }\r
-               } else {\r
-                       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";\r
-               }\r
-       }\r
-    } elsif ($netsettings{'RED_TYPE'} eq "STATIC" || $pppsettings {'METHOD'} eq 'STATIC') {\r
-       if (-e "${General::swroot}/red/active") {\r
-               $timestr = &General::age("${General::swroot}/red/active");\r
-               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";\r
-       } else {\r
-               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";\r
-       }\r
-    } elsif ( ( (-e "${General::swroot}/dhcpc/dhcpcd-$iface.pid") && $netsettings{'RED_TYPE'} ne 'PPTP' ) || \r
-       !system("/bin/ps -ef | /bin/grep -q '[p]ppd'") || !system("/bin/ps -ef | /bin/grep -q '[c]onnectioncheck'")) {\r
-       if (-e "${General::swroot}/red/active") {\r
-               $timestr = &General::age("${General::swroot}/red/active");\r
-               if ($pppsettings{'TYPE'} =~ /^(modem|bewanadsl|conexantpciadsl|eagleusbadsl)$/) {\r
-                       my $speed;\r
-                       if ($pppsettings{'TYPE'} eq 'modem') {\r
-                               open(CONNECTLOG, "/var/log/connect.log");\r
-                               while (<CONNECTLOG>) {\r
-                                       if (/CONNECT/) {\r
-                                               $speed = (split / /)[6];\r
-                                       }\r
-                               }\r
-                               close (CONNECTLOG);\r
-                       } elsif ($pppsettings{'TYPE'} eq 'bewanadsl') {\r
-                               $speed = `/usr/bin/unicorn_status | /bin/grep Rate | /usr/bin/cut -f2 -d ':'`;\r
-                       } elsif ($pppsettings{'TYPE'} eq 'conexantpciadsl') {\r
-                               $speed = `/bin/cat /proc/net/atm/CnxAdsl:* | /bin/grep 'Line Rates' | /bin/sed -e 's+Line Rates:   Receive+Rx+' -e 's+Transmit+Tx+'`;\r
-                       } elsif ($pppsettings{'TYPE'} eq 'eagleusbadsl') {\r
-                               $speed = `/usr/sbin/eaglestat | /bin/grep Rate`;\r
-                       }\r
-                       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused (\@$speed)</span>";\r
-               } else {\r
-                       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";\r
-               }\r
-       } else {\r
-               if (-e "${General::swroot}/red/dial-on-demand") {\r
-                   $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";\r
-               } else {\r
-                   $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";\r
-               }\r
-       }\r
-    } else {\r
-       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";\r
-    }\r
-    return $connstate;\r
-}\r
-\r
-sub speedtouchversion\r
-{\r
-       my $speedtouch;\r
-       if (-f "/proc/bus/usb/devices")\r
-       {\r
-               $speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;\r
-               if ($speedtouch eq '') {\r
-                       $speedtouch= $Lang::tr{'connect the modem'};\r
-               }\r
-       } else {\r
-               $speedtouch='USB '.$Lang::tr{'not running'};\r
-       }\r
-       return $speedtouch\r
-}\r
-\r
-#Sorting of allocated leases\r
-sub CheckSortOrder {\r
-    my %dhcpsettings = ();\r
-    &General::readhash("${General::swroot}/dhcp/settings", \%dhcpsettings);\r
-\r
-    if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {\r
-       my $newsort=$ENV{'QUERY_STRING'};\r
-        my $act=$dhcpsettings{'SORT_LEASELIST'};\r
-        #Default sort if unspecified \r
-        $act='IPADDRRev' if !defined ($act); \r
-        #Reverse actual ?\r
-        if ($act =~ $newsort) {\r
-            my $Rev='';\r
-            if ($act !~ 'Rev') {$Rev='Rev'};\r
-            $newsort.=$Rev\r
-        };\r
-\r
-        $dhcpsettings{'SORT_LEASELIST'}=$newsort;\r
-       &General::writehash("${General::swroot}/dhcp/settings", \%dhcpsettings);\r
-    }\r
-}\r
-\r
-sub PrintActualLeases\r
-{\r
-    our %dhcpsettings = ();\r
-    our %entries = ();    \r
-    \r
-    sub leasesort {\r
-       my $qs ='';\r
-       if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)\r
-       {\r
-           $qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);\r
-           if ($qs eq 'IPADDR') {\r
-               my @a = split(/\./,$entries{$a}->{$qs});\r
-               my @b = split(/\./,$entries{$b}->{$qs});\r
-               ($b[0]<=>$a[0]) ||\r
-               ($b[1]<=>$a[1]) ||\r
-               ($b[2]<=>$a[2]) ||\r
-               ($b[3]<=>$a[3]);\r
-           }else {\r
-               $entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r
-           }\r
-        }\r
-        else #not reverse\r
-        {\r
-           $qs=$dhcpsettings{'SORT_LEASELIST'};\r
-           if ($qs eq 'IPADDR') {\r
-               my @a = split(/\./,$entries{$a}->{$qs});\r
-               my @b = split(/\./,$entries{$b}->{$qs});\r
-               ($a[0]<=>$b[0]) ||\r
-               ($a[1]<=>$b[1]) ||\r
-               ($a[2]<=>$b[2]) ||\r
-               ($a[3]<=>$b[3]);\r
-           }else {\r
-               $entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r
-           }\r
-       }\r
-    }\r
-\r
-    &Header::openbox('100%', 'left', $Lang::tr{'current dynamic leases'});\r
-    print <<END\r
-<table width='100%'>\r
-<tr>\r
-<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$Lang::tr{'ip address'}</b></a></td>\r
-<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$Lang::tr{'mac address'}</b></a></td>\r
-<td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$Lang::tr{'hostname'}</b></a></td>\r
-<td width='30%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ENDTIME'><b>$Lang::tr{'lease expires'} (local time d/m/y)</b></a></td>\r
-</tr>\r
-END\r
-    ;\r
-\r
-    my ($ip, $endtime, $ether, $hostname, @record, $record);\r
-    open(LEASES,"/var/state/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";\r
-    while (my $line = <LEASES>) {\r
-       next if( $line =~ /^\s*#/ );\r
-       chomp($line);\r
-       my @temp = split (' ', $line);\r
-\r
-       if ($line =~ /^\s*lease/) {\r
-           $ip = $temp[1];\r
-           #All field are not necessarily read. Clear everything\r
-           $endtime = 0;\r
-           $ether = "";\r
-           $hostname = "";\r
-       } elsif ($line =~ /^\s*ends never;/) {\r
-           $endtime = 'never';\r
-       } elsif ($line =~ /^\s*ends/) {\r
-           $line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;\r
-           $endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);\r
-       } elsif ($line =~ /^\s*hardware ethernet/) {\r
-           $ether = $temp[2];\r
-           $ether =~ s/;//g;\r
-       } elsif ($line =~ /^\s*client-hostname/) {\r
-           shift (@temp);\r
-           $hostname = join (' ',@temp);\r
-           $hostname =~ s/;//g;\r
-           $hostname =~ s/\"//g;\r
-       } elsif ($line eq "}") {\r
-           @record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);\r
-           $record = {};                                       # create a reference to empty hash\r
-           %{$record} = @record;                               # populate that hash with @record\r
-           $entries{$record->{'IPADDR'}} = $record;    # add this to a hash of hashes\r
-       } #unknown format line...\r
-    }\r
-    close(LEASES);\r
-\r
-    #Get sort method\r
-    $dhcpsettings{'SORT_LEASELIST'}='IPADDR';                                  #default\r
-    &General::readhash("${General::swroot}/dhcp/settings", \%dhcpsettings);    #or maybe saved !\r
-    my $id = 0;\r
-    foreach my $key (sort leasesort keys %entries) {\r
-\r
-       my $hostname = &Header::cleanhtml($entries{$key}->{HOSTNAME},"y");\r
-\r
-       if ($id % 2) {\r
-           print "<tr bgcolor='$Header::table1colour'>";\r
-       }\r
-       else {\r
-           print "<tr bgcolor='$Header::table2colour'>";\r
-       }\r
-\r
-       print <<END\r
-<td align='center'>$entries{$key}->{IPADDR}</td>\r
-<td align='center'>$entries{$key}->{ETHER}</td>\r
-<td align='center'>&nbsp;$hostname </td>\r
-<td align='center'>\r
-END\r
-       ;\r
-\r
-       if ($entries{$key}->{ENDTIME} eq 'never') {\r
-           print "$Lang::tr{'no time limit'}";\r
-       } else {\r
-           my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst);\r
-           ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});\r
-           my $enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);\r
-\r
-           if ($entries{$key}->{ENDTIME} < time() ){\r
-               print "<strike>$enddate</strike>";\r
-           } else {\r
-               print "$enddate";\r
-           }\r
-       }\r
-       print "</td></tr>";\r
-       $id++;\r
-    }\r
-\r
-    print "</table>";\r
-    &Header::closebox();\r
-}\r
-\r
-1;\r
+# SmoothWall CGIs
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) The SmoothWall Team
+# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
+# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
+# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
+# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
+# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
+#
+# $Id: header.pl,v 1.34.2.67 2005/10/03 20:01:05 gespinasse Exp $
+#
+
+package Header;
+
+use strict;
+use CGI();
+use Time::Local;
+
+# enable only the following on debugging purpose
+#use warnings;
+#use CGI::Carp 'fatalsToBrowser';
+
+
+$Header::pagecolour = '#ffffff';       # never used, will be removed
+$Header::tablecolour = '#FFFFFF';      # never used, will be removed
+$Header::bigboxcolour = '#F6F4F4';     # never used, will be removed
+$Header::boxcolour = '#EAE9EE';                # only header.pl, ? move in css ?
+$Header::bordercolour = '#000000';     # never used, will be removed
+$Header::table1colour = '#C0C0C0';
+$Header::table2colour = '#F2F2F2';
+$Header::colourred = '#993333';
+$Header::colourorange = '#FF9933';
+$Header::colouryellow = '#FFFF00';
+$Header::colourgreen = '#339933';
+$Header::colourblue = '#333399';
+$Header::colourfw = '#000000';         # only connections.cgi
+$Header::colourvpn = '#990099';                # only connections.cgi
+$Header::colourerr = '#FF0000';                # only header.pl, many scripts use colourred for warnings messages
+$Header::viewsize = 150;
+my %menu = ();
+my $hostnameintitle = 0;
+our $javascript = 1;
+
+### Initialize menu
+sub genmenu
+{
+    ### Initialize environment
+    my %ethsettings = ();
+    &General::readhash("${General::swroot}/ethernet/settings", \%ethsettings);
+
+    %{$menu{'1.system'}}=(
+               'contents' =>  $Lang::tr{'alt system'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'alt system'}",
+               'subMenu' =>   [[ $Lang::tr{'alt home'} , '/cgi-bin/index.cgi', "IPCop $Lang::tr{'alt home'}" ],
+                               [ $Lang::tr{'updates'} , '/cgi-bin/updates.cgi', "IPCop $Lang::tr{'updates'}" ],
+                               [ $Lang::tr{'sspasswords'} , '/cgi-bin/changepw.cgi', "IPCop $Lang::tr{'sspasswords'}" ],
+                               [ $Lang::tr{'ssh access'} , '/cgi-bin/remote.cgi', "IPCop $Lang::tr{'ssh access'}" ],
+                               [ $Lang::tr{'gui settings'} , '/cgi-bin/gui.cgi', "IPCop $Lang::tr{'gui settings'}" ],
+                               [ $Lang::tr{'backup'} , '/cgi-bin/backup.cgi', "IPCop $Lang::tr{'backup'} / $Lang::tr{'restore'}" ],
+                               [ $Lang::tr{'shutdown'} , '/cgi-bin/shutdown.cgi', "IPCop $Lang::tr{'shutdown'} / $Lang::tr{'reboot'}" ],
+                               [ $Lang::tr{'credits'} , '/cgi-bin/credits.cgi', "IPCop $Lang::tr{'credits'}" ]]
+    );
+    %{$menu{'2.status'}}=(
+               'contents' =>  $Lang::tr{'status'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'status information'}",
+               'subMenu' =>   [[ $Lang::tr{'sssystem status'} , '/cgi-bin/status.cgi', "IPCop $Lang::tr{'system status information'}" ],
+                               [ $Lang::tr{'ssnetwork status'} , '/cgi-bin/netstatus.cgi', "IPCop $Lang::tr{'network status information'}" ],
+                               [ $Lang::tr{'system graphs'} , '/cgi-bin/graphs.cgi', "IPCop $Lang::tr{'system graphs'}" ],
+                               [ $Lang::tr{'sstraffic graphs'} , '/cgi-bin/graphs.cgi?graph=network', "IPCop $Lang::tr{'network traffic graphs'}" ],
+                               [ $Lang::tr{'ssproxy graphs'} , '/cgi-bin/proxygraphs.cgi', "IPCop $Lang::tr{'proxy access graphs'}" ],
+                               [ $Lang::tr{'connections'} , '/cgi-bin/connections.cgi', "IPCop $Lang::tr{'connections'}" ]]
+    );
+    %{$menu{'3.network'}}=(
+               'contents' =>  $Lang::tr{'network'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'network configuration'}",
+               'subMenu' =>   [[ $Lang::tr{'alt dialup'} , '/cgi-bin/pppsetup.cgi', "IPCop $Lang::tr{'dialup settings'}" ],
+                               [ $Lang::tr{'upload'} , '/cgi-bin/upload.cgi', $Lang::tr{'firmware upload'} ],
+                               [ $Lang::tr{'modem'} , '/cgi-bin/modem.cgi', "IPCop $Lang::tr{'modem configuration'}" ],
+                               [ $Lang::tr{'aliases'} , '/cgi-bin/aliases.cgi', "IPCop $Lang::tr{'external aliases configuration'}" ]]
+    );
+    %{$menu{'4.services'}}=(
+               'contents' =>  $Lang::tr{'alt services'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'alt services'}",
+               'subMenu' =>   [[ $Lang::tr{'proxy'} , '/cgi-bin/proxy.cgi', "IPCop $Lang::tr{'web proxy configuration'}" ],
+                               [ $Lang::tr{'dhcp server'} , '/cgi-bin/dhcp.cgi', "IPCop $Lang::tr{'dhcp configuration'}" ],
+                               [ $Lang::tr{'dynamic dns'} , '/cgi-bin/ddns.cgi', "IPCop $Lang::tr{'dynamic dns client'}" ],
+                               [ $Lang::tr{'edit hosts'} , '/cgi-bin/hosts.cgi', "IPCop $Lang::tr{'host configuration'}" ],
+                               [ $Lang::tr{'time server'} , '/cgi-bin/time.cgi', "IPCop $Lang::tr{'time server'}" ],
+                               [ $Lang::tr{'traffic shaping'} , '/cgi-bin/shaping.cgi', "IPCop $Lang::tr{'traffic shaping settings'}" ],
+                               [ $Lang::tr{'intrusion detection'} , '/cgi-bin/ids.cgi', "IPCop $Lang::tr{'intrusion detection system'} (Snort)" ]]
+    );
+    %{$menu{'5.firewall'}}=(
+               'contents' =>  $Lang::tr{'firewall'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'firewall'}",
+               'subMenu' =>   [[ $Lang::tr{'ssport forwarding'} , '/cgi-bin/portfw.cgi', "IPCop $Lang::tr{'port forwarding configuration'}" ],
+                               [ $Lang::tr{'external access'} , '/cgi-bin/xtaccess.cgi', "IPCop $Lang::tr{'external access configuration'}" ],
+                               [ $Lang::tr{'ssdmz pinholes'} , '/cgi-bin/dmzholes.cgi', "IPCop $Lang::tr{'dmz pinhole configuration'}" ],
+                               [ $Lang::tr{'blue access'} , '/cgi-bin/wireless.cgi', "IPCop $Lang::tr{'blue access'}" ]
+                               ,[ $Lang::tr{'options fw'} , '/cgi-bin/optionsfw.cgi', "IPCop $Lang::tr{'options fw'}" ]
+                              ]
+    );
+    %{$menu{'6.vpns'}}=(
+               'contents' =>  $Lang::tr{'alt vpn'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'virtual private networking'}",
+               'subMenu' =>   [[ $Lang::tr{'alt vpn'} , '/cgi-bin/vpnmain.cgi', "IPCop $Lang::tr{'virtual private networking'}"]]
+    );
+    %{$menu{'7.mainlogs'}}=(
+               'contents' =>  $Lang::tr{'alt logs'},
+               'uri' => '',
+               'statusText' => "IPCop $Lang::tr{'alt logs'}",
+               'subMenu' =>   [[ $Lang::tr{'log settings'} , '/cgi-bin/logs.cgi/config.dat', "IPCop $Lang::tr{'log settings'}" ],
+                               [ $Lang::tr{'log summary'} , '/cgi-bin/logs.cgi/summary.dat', "IPCop $Lang::tr{'log summary'}" ],
+                               [ $Lang::tr{'proxy logs'} , '/cgi-bin/logs.cgi/proxylog.dat', "IPCop $Lang::tr{'proxy log viewer'}" ],
+                               [ $Lang::tr{'firewall logs'} , '/cgi-bin/logs.cgi/firewalllog.dat', "IPCop $Lang::tr{'firewall log viewer'}" ],
+                               [ $Lang::tr{'ids logs'} , '/cgi-bin/logs.cgi/ids.dat', "IPCop $Lang::tr{'intrusion detection system log viewer'}" ],
+                               [ $Lang::tr{'system logs'} , '/cgi-bin/logs.cgi/log.dat', "IPCop $Lang::tr{'system log viewer'}" ]]
+    );
+    if (! $ethsettings{'BLUE_DEV'}) {
+       splice (@{$menu{'5.firewall'}{'subMenu'}}, 3, 1);
+    }
+    if (! $ethsettings{'BLUE_DEV'} && ! $ethsettings{'ORANGE_DEV'}) {
+       splice (@{$menu{'5.firewall'}{'subMenu'}}, 2, 1);
+    }
+    unless ( $ethsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $ethsettings{'RED_TYPE'} eq 'STATIC' ) {
+       splice (@{$menu{'3.network'}{'subMenu'}}, 3, 1);
+    }
+    if ( ! -e "${General::swroot}/snort/enable" && ! -e "${General::swroot}/snort/enable_blue" &&
+       ! -e "${General::swroot}/snort/enable_green" && ! -e "${General::swroot}/snort/enable_orange") {
+       splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 4, 1);
+    }
+    if ( ! -e "${General::swroot}/proxy/enable" && ! -e "${General::swroot}/proxy/enable_blue" ) {
+       splice (@{$menu{'2.status'}{'subMenu'}}, 4, 1);
+       splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 2, 1);
+    }
+}
+
+sub showhttpheaders
+{
+    ### Make sure this is an SSL request
+    if ($ENV{'SERVER_ADDR'} && $ENV{'HTTPS'} ne 'on') {
+       print "Status: 302 Moved\r\n";
+       print "Location: https://$ENV{'SERVER_ADDR'}:445/$ENV{'PATH_INFO'}\r\n\r\n";
+       exit 0;
+    } else {
+       print "Pragma: no-cache\n";
+       print "Cache-control: no-cache\n";
+       print "Connection: close\n";
+       print "Content-type: text/html\n\n";
+    }
+}
+
+sub showjsmenu
+{
+    my $c1 = 1;
+
+    print "    <script type='text/javascript'>\n";
+    print "    domMenu_data.setItem('domMenu_main', new domMenu_Hash(\n";
+
+    foreach my $k1 ( sort keys %menu ) {
+       my $c2 = 1;
+       if ($c1 > 1) {
+           print "    ),\n";
+       }
+       print "    $c1, new domMenu_Hash(\n";
+       print "\t'contents', '" . &cleanhtml($menu{$k1}{'contents'}) . "',\n";
+       print "\t'uri', '$menu{$k1}{'uri'}',\n";
+       $menu{$k1}{'statusText'} =~  s/'/\\\'/g;
+       print "\t'statusText', '$menu{$k1}{'statusText'}',\n";
+       foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {
+           print "\t    $c2, new domMenu_Hash(\n";
+           print "\t\t'contents', '" . &cleanhtml(@{$k2}[0])  . "',\n";
+           print "\t\t'uri', '@{$k2}[1]',\n";
+           @{$k2}[2] =~ s/'/\\\'/g;
+           print "\t\t'statusText', '@{$k2}[2]'\n";
+           if ( $c2 <= $#{$menu{$k1}{'subMenu'}} ) {
+               print "\t    ),\n";
+           } else {
+               print "\t    )\n";
+           }
+           $c2++;
+       }
+       $c1++;
+    }
+    print "    )\n";
+    print "    ));\n\n";
+
+    print <<EOF
+    domMenu_settings.setItem('domMenu_main', new domMenu_Hash(
+       'menuBarWidth', '0%',
+       'menuBarClass', 'ipcop_menuBar',
+       'menuElementClass', 'ipcop_menuElement',
+       'menuElementHoverClass', 'ipcop_menuElementHover',
+       'menuElementActiveClass', 'ipcop_menuElementHover',
+       'subMenuBarClass', 'ipcop_subMenuBar',
+       'subMenuElementClass', 'ipcop_subMenuElement',
+       'subMenuElementHoverClass', 'ipcop_subMenuElementHover',
+       'subMenuElementActiveClass', 'ipcop_subMenuElementHover',
+       'subMenuMinWidth', 'auto',
+       'distributeSpace', false,
+       'openMouseoverMenuDelay', 0,
+       'openMousedownMenuDelay', 0,
+       'closeClickMenuDelay', 0,
+       'closeMouseoutMenuDelay', -1
+    ));
+    </script>
+EOF
+    ;
+}
+
+sub showmenu
+{
+    if ($javascript) {print "<noscript>";}
+    print "<table cellpadding='0' cellspacing='0' border='0'>\n";
+    print "<tr>\n";
+
+    foreach my $k1 ( sort keys %menu ) {
+       print "<td class='ipcop_menuElementTD'><a href='" . @{@{$menu{$k1}{'subMenu'}}[0]}[1] . "' class='ipcop_menuElementNoJS'>";
+       print $menu{$k1}{'contents'} . "</a></td>\n";
+    }
+    print "</tr></table>\n";
+    if ($javascript) {print "</noscript>";}
+}
+
+sub showsubsection
+{
+    my $location = $_[0];
+    my $c1 = 0;
+
+    if ($javascript) {print "<noscript>";}
+    print "<table width='100%' cellspacing='0' cellpadding='5' border='0'>\n";
+    print "<tr><td style='background-color: $Header::boxcolour;' width='53'><img src='/images/null.gif' width='43' height='1' alt='' /></td>\n";
+    print "<td style='background-color: $Header::boxcolour;' align='left' width='100%'>";
+    my @URI=split ('\?',  $ENV{'REQUEST_URI'} );
+
+    foreach my $k1 ( keys %menu ) {
+       
+       if ($menu{$k1}{'contents'} eq $location) {
+           foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {
+               if ($c1 > 0) {
+                   print " | ";
+               }
+               if (@{$k2}[1] eq "$URI[0]\?$URI[1]" || (@{$k2}[1] eq $URI[0] && length($URI[1]) == 0)) {
+               #if (@{$k2}[1] eq "$URI[0]") {
+                   print "<b>@{$k2}[0]</b>";
+               } else {
+                   print "<a href='@{$k2}[1]'>@{$k2}[0]</a>";
+               }
+               $c1++;
+           }
+       }
+    }
+    print "</td></tr></table>\n";
+    if ($javascript) { print "</noscript>";}
+}
+
+sub openpage
+{
+    my $title = $_[0];
+    my $menu = $_[1];
+    my $extrahead = $_[2];
+
+    ### Initialize environment
+    my %settings = ();
+    &General::readhash("${General::swroot}/main/settings", \%settings);
+
+    if ($settings{'JAVASCRIPT'} eq 'off') {
+       $javascript = 0;
+    } else {
+       $javascript = 1;
+    }
+
+    if ($settings{'WINDOWWITHHOSTNAME'} eq 'on') {
+        $hostnameintitle = 1;
+    } else {
+        $hostnameintitle = 0;
+    }
+
+    print <<END
+<!DOCTYPE html 
+     PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+
+<html><head>
+END
+    ;
+    print "    <title>";
+    if ($hostnameintitle) {
+        print "$settings{'HOSTNAME'}.$settings{'DOMAINNAME'} - $title"; 
+    } else {
+        print "IPCop - $title";
+    }
+    print "</title>\n";
+
+    print <<END
+    $extrahead
+    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
+    <link rel="shortcut icon" href="/favicon.ico" />
+    <style type="text/css">\@import url(/include/ipcop.css);</style>
+END
+    ;
+    if ($javascript) {
+       print "<script type='text/javascript' src='/include/domMenu.js'></script>\n";
+       &genmenu();
+       &showjsmenu();
+    } else {
+       &genmenu();
+    }
+
+    my $location = '';
+    my $sublocation = '';
+    my @URI=split ('\?',  $ENV{'REQUEST_URI'} );
+    foreach my $k1 ( keys %menu ) {
+       my $temp = $menu{$k1}{'contents'};
+       foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {
+           if ( @{$k2}[1] eq $URI[0] ) {
+               $location = $temp;
+               $sublocation = @{$k2}[0];
+           }
+       }
+    }
+
+    my @cgigraphs = split(/graph=/,$ENV{'QUERY_STRING'});
+    if (defined ($cgigraphs[1])){ 
+       if ($cgigraphs[1] =~ /(GREEN|BLUE|ORANGE|RED|network)/) {
+               $location = $Lang::tr{'status'};
+               $sublocation = $Lang::tr{'sstraffic graphs'};
+       }
+       if ($cgigraphs[1] =~ /(cpu|memory|swap|disk)/) {
+               $location = $Lang::tr{'status'};
+               $sublocation = $Lang::tr{'system graphs'};
+       }
+    }
+    if ($ENV{'QUERY_STRING'} =~ /(ip)/) {
+        $location = $Lang::tr{'alt logs'};
+       $sublocation = "WHOIS";
+    }
+
+    if ($javascript) {
+           print <<END
+           <script type="text/javascript">
+           document.onmouseup = function()
+           {
+               domMenu_deactivate('domMenu_main');
+           }
+           </script>
+           </head>
+
+           <body onload="domMenu_activate('domMenu_main');">
+END
+           ;
+    } else {
+       print "</head>\n\n<body>\n";
+    }
+
+    print <<END
+<!-- IPCOP HEADER -->
+    <table width='100%' cellpadding='0' cellspacing='0'>
+    <col width='53' />
+    <col />
+    <tr><td><img src='/images/null.gif' width='53' height='27' alt='' /></td>
+       <td valign='bottom'><table width='100%' cellspacing='0' border='0'>
+           <col width='5' />
+           <col width='175' />
+           <col />
+           <tr><td><img src='/images/null.gif' width='5' height='1' alt='' /></td>
+               <td class="ipcop_menuLocationMain" valign='bottom'>$location</td>
+               <td class="ipcop_menuLocationSub"  valign='bottom'>$sublocation</td>
+           </tr></table>
+       </td></tr>
+    <tr><td valign='bottom' class='ipcop_Version'>
+           <img src='/images/null.gif' width='1' height='29' alt='' />${General::version}</td>
+       <td valign='bottom'>
+END
+    ;
+    if ($menu == 1) {
+       if ($javascript) {
+           print "<div id='domMenu_main'></div>\n";
+       }
+       &showmenu();
+    }
+    print "    </td></tr></table>\n";
+    &showsubsection($location);
+    print "<!-- IPCOP CONTENT -->\n";
+}
+
+sub closepage
+{
+       print <<END
+<!-- IPCOP FOOTER -->
+    <table width='100%' border='0'>
+    <tr><td valign='bottom'><img src='/images/bounceback.png' width='248' height='80' alt='' /></td>
+       <td align='center' valign='bottom'>
+END
+       ;
+       my $status = &connectionstatus();
+       print "$status<br />\n"; 
+       print `/usr/bin/uptime`;
+
+       print <<END
+       </td>
+       <td valign='bottom'><a href='http://sf.net/projects/ipcop/' target='_blank'><img src='/images/sflogo.png' width='88' height='31' alt='Sourceforge logo' /></a></td>
+    </tr></table>
+</body></html>
+END
+       ;
+}
+
+sub openbigbox
+{
+       my $width = $_[0];
+       my $align = $_[1];
+       my $sideimg = $_[2];
+        my $errormessage = $_[3];
+       my $bgcolor;
+
+       if ($errormessage) {
+               $bgcolor = "style='background-color: $Header::colourerr;'";
+       } else {
+               $bgcolor = '';
+       }
+
+       print "<table width='100%' border='0'>\n";
+       if ($sideimg) {
+           print "<tr><td valign='top'><img src='/images/$sideimg' width='65' height='345' alt='' /></td>\n";
+       } else {
+           print "<tr>\n";
+       }
+       print "<td valign='top' align='center'><table width='$width' $bgcolor cellspacing='0' cellpadding='10' border='0'>\n";
+        print "<tr><td><img src='/images/null.gif' width='1' height='365' alt='' /></td>\n";
+       print "<td align='$align' valign='top'>\n";
+}
+
+sub closebigbox
+{
+       print "</td></tr></table></td></tr></table>\n" 
+}
+
+sub openbox
+{
+       my $width = $_[0];
+       my $align = $_[1];
+       my $caption = $_[2];
+
+       print <<END
+       <table cellspacing="0" cellpadding="0" width="$width" border="0">
+           <col width='12' />
+           <col width='18' />
+           <col width='100%' />
+           <col width='152' />
+           <col width='11' />
+       
+           <tr><td width='12'  ><img src='/images/null.gif' width='12'  height='1' alt='' /></td>
+               <td width='18'  ><img src='/images/null.gif' width='18'  height='1' alt='' /></td>
+               <td width='100%'><img src='/images/null.gif' width='400' height='1' alt='' /></td>
+               <td width='152' ><img src='/images/null.gif' width='152' height='1' alt='' /></td>
+               <td width='11'  ><img src='/images/null.gif' width='11'   height='1' alt='' /></td></tr>
+           <tr><td colspan='2' ><img src='/images/boxtop1.png' width='30' height='53' alt='' /></td>
+               <td style='background: url(/images/boxtop2.png);'>
+END
+       ;
+       if ($caption) { print "<b>$caption</b>\n"; } else { print "&nbsp;"; }
+       print <<END
+               </td>
+               <td colspan='2'><img src='/images/boxtop3.png' width='163' height='53' alt='' /></td></tr>
+           <tr><td style='background: url(/images/boxleft.png);'><img src='/images/null.gif' width='12' height='1' alt='' /></td>
+               <td colspan='3' style='background-color: $Header::boxcolour;'>
+               <table width='100%' cellpadding='5'><tr><td align="$align" valign='top'>
+END
+       ;
+}
+
+sub closebox
+{
+       print <<END
+               </td></tr></table></td>
+                <td style='background: url(/images/boxright.png);'><img src='/images/null.gif' width='11' height='1' alt='' /></td></tr>
+            <tr><td style='background: url(/images/boxbottom1.png);background-repeat:no-repeat;'><img src='/images/null.gif' width='12' height='14' alt='' /></td>
+                <td style='background: url(/images/boxbottom2.png);background-repeat:repeat-x;' colspan='3'><img src='/images/null.gif' width='1' height='14' alt='' /></td>
+                <td style='background: url(/images/boxbottom3.png);background-repeat:no-repeat;'><img src='/images/null.gif' width='11' height='14' alt='' /></td></tr>
+        </table>
+END
+       ;
+}
+
+sub getcgihash {
+       my ($hash, $params) = @_;
+       my $cgi = CGI->new ();
+       return if ($ENV{'REQUEST_METHOD'} ne 'POST');
+       if (!$params->{'wantfile'}) {
+               $CGI::DISABLE_UPLOADS = 1;
+               $CGI::POST_MAX        = 512 * 1024;
+       } else {
+               $CGI::POST_MAX = 10 * 1024 * 1024;
+       }
+
+       $cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;
+       my $referer = $1;
+       $cgi->url() =~ m/^https?\:\/\/([^\/]+)/;
+       my $servername = $1;
+       return if ($referer ne $servername);
+
+       ### Modified for getting multi-vars, split by |
+       my %temp = $cgi->Vars();
+        foreach my $key (keys %temp) {
+               $hash->{$key} = $temp{$key};
+               $hash->{$key} =~ s/\0/|/g;
+               $hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;
+        }
+
+       if (($params->{'wantfile'})&&($params->{'filevar'})) {
+               $hash->{$params->{'filevar'}} = $cgi->upload
+                                               ($params->{'filevar'});
+       }
+       return;
+}
+
+sub cleanhtml
+{
+       my $outstring =$_[0];
+       $outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';
+       $outstring =~ s/&/&amp;/g;
+       $outstring =~ s/\'/&#039;/g;
+       $outstring =~ s/\"/&quot;/g;
+       $outstring =~ s/</&lt;/g;
+       $outstring =~ s/>/&gt;/g;
+       return $outstring;
+}
+
+sub connectionstatus
+{
+    my %pppsettings = ();
+    my %netsettings = ();
+    my $iface='';
+
+    $pppsettings{'PROFILENAME'} = 'None';
+    &General::readhash("${General::swroot}/ppp/settings", \%pppsettings);
+    &General::readhash("${General::swroot}/ethernet/settings", \%netsettings);
+
+    my $profileused='';
+    if ( ! ( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {
+       $profileused="- $pppsettings{'PROFILENAME'}";
+    }
+
+    if ( ( $pppsettings{'METHOD'} eq 'DHCP' && $netsettings{'RED_TYPE'} ne 'PPTP') 
+                                               || $netsettings{'RED_TYPE'} eq 'DHCP' ) {
+               if (open(IFACE, "${General::swroot}/red/iface")) {
+                       $iface = <IFACE>;
+                       close IFACE;
+                       chomp ($iface);
+                       $iface =~ /([a-zA-Z0-9]*)/; $iface = $1;
+               }
+    }
+
+    my ($timestr, $connstate);
+    if ($netsettings{'CONFIG_TYPE'} =~ /^(0|1|4|5)$/ &&  $pppsettings{'TYPE'} =~ /^isdn/) {
+       # Count ISDN channels
+       my ($idmap, $chmap, $drmap, $usage, $flags, $phone);
+       my @phonenumbers;
+       my $count=0;
+
+       open (FILE, "/dev/isdninfo");
+
+       $idmap = <FILE>; chop $idmap;
+       $chmap = <FILE>; chop $chmap;
+       $drmap = <FILE>; chop $drmap;
+       $usage = <FILE>; chop $usage;
+       $flags = <FILE>; chop $flags;
+       $phone = <FILE>; chop $phone;
+
+       $phone =~ s/^phone(\s*):(\s*)//;
+
+       @phonenumbers = split / /, $phone;
+
+       foreach (@phonenumbers) {
+               if ($_ ne '???') {
+                       $count++;
+               }
+       }
+       close (FILE);
+
+       ## Connection status
+       my $number;
+       if ($count == 0) {
+               $number = 'none!';
+       } elsif ($count == 1) {
+               $number = 'single';
+       } else {
+               $number = 'dual';
+       }
+
+       if (-e "${General::swroot}/red/active") {
+               $timestr = &General::age("${General::swroot}/red/active");
+               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} - $number channel (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
+       } else {
+               if ($count == 0) {
+                       if (-e "${General::swroot}/red/dial-on-demand") {
+                               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";
+                       } else {
+                               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
+                       }
+               } else {
+                       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";
+               }
+       }
+    } elsif ($netsettings{'RED_TYPE'} eq "STATIC" || $pppsettings {'METHOD'} eq 'STATIC') {
+       if (-e "${General::swroot}/red/active") {
+               $timestr = &General::age("${General::swroot}/red/active");
+               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
+       } else {
+               $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
+       }
+    } elsif ( ( (-e "${General::swroot}/dhcpc/dhcpcd-$iface.pid") && $netsettings{'RED_TYPE'} ne 'PPTP' ) || 
+       !system("/bin/ps -ef | /bin/grep -q '[p]ppd'") || !system("/bin/ps -ef | /bin/grep -q '[c]onnectioncheck'")) {
+       if (-e "${General::swroot}/red/active") {
+               $timestr = &General::age("${General::swroot}/red/active");
+               if ($pppsettings{'TYPE'} =~ /^(modem|bewanadsl|conexantpciadsl|eagleusbadsl)$/) {
+                       my $speed;
+                       if ($pppsettings{'TYPE'} eq 'modem') {
+                               open(CONNECTLOG, "/var/log/connect.log");
+                               while (<CONNECTLOG>) {
+                                       if (/CONNECT/) {
+                                               $speed = (split / /)[6];
+                                       }
+                               }
+                               close (CONNECTLOG);
+                       } elsif ($pppsettings{'TYPE'} eq 'bewanadsl') {
+                               $speed = `/usr/bin/unicorn_status | /bin/grep Rate | /usr/bin/cut -f2 -d ':'`;
+                       } elsif ($pppsettings{'TYPE'} eq 'conexantpciadsl') {
+                               $speed = `/bin/cat /proc/net/atm/CnxAdsl:* | /bin/grep 'Line Rates' | /bin/sed -e 's+Line Rates:   Receive+Rx+' -e 's+Transmit+Tx+'`;
+                       } elsif ($pppsettings{'TYPE'} eq 'eagleusbadsl') {
+                               $speed = `/usr/sbin/eaglestat | /bin/grep Rate`;
+                       }
+                       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused (\@$speed)</span>";
+               } else {
+                       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
+               }
+       } else {
+               if (-e "${General::swroot}/red/dial-on-demand") {
+                   $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";
+               } else {
+                   $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";
+               }
+       }
+    } else {
+       $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
+    }
+    return $connstate;
+}
+
+sub speedtouchversion
+{
+       my $speedtouch;
+       if (-f "/proc/bus/usb/devices")
+       {
+               $speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;
+               if ($speedtouch eq '') {
+                       $speedtouch= $Lang::tr{'connect the modem'};
+               }
+       } else {
+               $speedtouch='USB '.$Lang::tr{'not running'};
+       }
+       return $speedtouch
+}
+
+#Sorting of allocated leases
+sub CheckSortOrder {
+    my %dhcpsettings = ();
+    &General::readhash("${General::swroot}/dhcp/settings", \%dhcpsettings);
+
+    if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {
+       my $newsort=$ENV{'QUERY_STRING'};
+        my $act=$dhcpsettings{'SORT_LEASELIST'};
+        #Default sort if unspecified 
+        $act='IPADDRRev' if !defined ($act); 
+        #Reverse actual ?
+        if ($act =~ $newsort) {
+            my $Rev='';
+            if ($act !~ 'Rev') {$Rev='Rev'};
+            $newsort.=$Rev
+        };
+
+        $dhcpsettings{'SORT_LEASELIST'}=$newsort;
+       &General::writehash("${General::swroot}/dhcp/settings", \%dhcpsettings);
+    }
+}
+
+sub PrintActualLeases
+{
+    our %dhcpsettings = ();
+    our %entries = ();    
+    
+    sub leasesort {
+       my $qs ='';
+       if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)
+       {
+           $qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);
+           if ($qs eq 'IPADDR') {
+               my @a = split(/\./,$entries{$a}->{$qs});
+               my @b = split(/\./,$entries{$b}->{$qs});
+               ($b[0]<=>$a[0]) ||
+               ($b[1]<=>$a[1]) ||
+               ($b[2]<=>$a[2]) ||
+               ($b[3]<=>$a[3]);
+           }else {
+               $entries{$b}->{$qs} cmp $entries{$a}->{$qs};
+           }
+        }
+        else #not reverse
+        {
+           $qs=$dhcpsettings{'SORT_LEASELIST'};
+           if ($qs eq 'IPADDR') {
+               my @a = split(/\./,$entries{$a}->{$qs});
+               my @b = split(/\./,$entries{$b}->{$qs});
+               ($a[0]<=>$b[0]) ||
+               ($a[1]<=>$b[1]) ||
+               ($a[2]<=>$b[2]) ||
+               ($a[3]<=>$b[3]);
+           }else {
+               $entries{$a}->{$qs} cmp $entries{$b}->{$qs};
+           }
+       }
+    }
+
+    &Header::openbox('100%', 'left', $Lang::tr{'current dynamic leases'});
+    print <<END
+<table width='100%'>
+<tr>
+<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$Lang::tr{'ip address'}</b></a></td>
+<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$Lang::tr{'mac address'}</b></a></td>
+<td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$Lang::tr{'hostname'}</b></a></td>
+<td width='30%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ENDTIME'><b>$Lang::tr{'lease expires'} (local time d/m/y)</b></a></td>
+</tr>
+END
+    ;
+
+    my ($ip, $endtime, $ether, $hostname, @record, $record);
+    open(LEASES,"/var/state/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";
+    while (my $line = <LEASES>) {
+       next if( $line =~ /^\s*#/ );
+       chomp($line);
+       my @temp = split (' ', $line);
+
+       if ($line =~ /^\s*lease/) {
+           $ip = $temp[1];
+           #All field are not necessarily read. Clear everything
+           $endtime = 0;
+           $ether = "";
+           $hostname = "";
+       } elsif ($line =~ /^\s*ends never;/) {
+           $endtime = 'never';
+       } elsif ($line =~ /^\s*ends/) {
+           $line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;
+           $endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);
+       } elsif ($line =~ /^\s*hardware ethernet/) {
+           $ether = $temp[2];
+           $ether =~ s/;//g;
+       } elsif ($line =~ /^\s*client-hostname/) {
+           shift (@temp);
+           $hostname = join (' ',@temp);
+           $hostname =~ s/;//g;
+           $hostname =~ s/\"//g;
+       } elsif ($line eq "}") {
+           @record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);
+           $record = {};                                       # create a reference to empty hash
+           %{$record} = @record;                               # populate that hash with @record
+           $entries{$record->{'IPADDR'}} = $record;    # add this to a hash of hashes
+       } #unknown format line...
+    }
+    close(LEASES);
+
+    #Get sort method
+    $dhcpsettings{'SORT_LEASELIST'}='IPADDR';                                  #default
+    &General::readhash("${General::swroot}/dhcp/settings", \%dhcpsettings);    #or maybe saved !
+    my $id = 0;
+    foreach my $key (sort leasesort keys %entries) {
+
+       my $hostname = &Header::cleanhtml($entries{$key}->{HOSTNAME},"y");
+
+       if ($id % 2) {
+           print "<tr bgcolor='$Header::table1colour'>";
+       }
+       else {
+           print "<tr bgcolor='$Header::table2colour'>";
+       }
+
+       print <<END
+<td align='center'>$entries{$key}->{IPADDR}</td>
+<td align='center'>$entries{$key}->{ETHER}</td>
+<td align='center'>&nbsp;$hostname </td>
+<td align='center'>
+END
+       ;
+
+       if ($entries{$key}->{ENDTIME} eq 'never') {
+           print "$Lang::tr{'no time limit'}";
+       } else {
+           my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst);
+           ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});
+           my $enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);
+
+           if ($entries{$key}->{ENDTIME} < time() ){
+               print "<strike>$enddate</strike>";
+           } else {
+               print "$enddate";
+           }
+       }
+       print "</td></tr>";
+       $id++;
+    }
+
+    print "</table>";
+    &Header::closebox();
+}
+
+1;
index 8d2be61..a650706 100644 (file)
-# SmoothWall CGIs\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) The SmoothWall Team\r
-# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> Split from header.pl\r
-#\r
-# $Id: lang.pl,v 1.1.2.11 2005/09/10 16:22:50 eoberlander Exp $\r
-#\r
-\r
-package Lang;\r
-require 'CONFIG_ROOT/general-functions.pl';\r
-use strict;\r
-\r
-### A cache file to avoid long recalculation\r
-$Lang::CacheLang = '/var/run/cache-lang.pl';\r
-\r
-# When you want to add your own language strings/entries to the ipcop language file,\r
-# you should create a file with <PREFIX>.<LANG>.pl into CONFIG_ROOT/addon-lang dir\r
-#      <PREFIX> is free choosable but should be significant. An Example might be "myAddnName"\r
-#      <LANG> is a mnemonic of the used language like en, de, it, nl etc.\r
-#              You can find a detailed list of possible mnemonic's in the file CONFIG_ROOT/langs/list\r
-# A file could be named "VirtualHttpd.en.pl" for example.\r
-#\r
-# The file content has to start with (of course without the leading #):\r
-# --------- CODE ---------\r
-#%tr = (%tr,\r
-# 'key1' => 'value',                           # add all your entries key/values here \r
-# 'key2' => 'value'                            # and end with (of course without the leading #):\r
-#);\r
-# --------- CODE END---------\r
-#\r
-# After you have copied all your files to CONFIG_ROOT/add-lang you have to run the\r
-# script compilation:\r
-# perl -e "require '/CONFIG_ROOT/lang.pl'; &Lang::BuildCacheLang"\r
-\r
-\r
-### Initialize language\r
-%Lang::tr = ();\r
-my %settings = ();\r
-&General::readhash("${General::swroot}/main/settings", \%settings);\r
-reload($settings{'LANGUAGE'});\r
-\r
-# language variable used by makegraphs script\r
-our $language;\r
-$language = $settings{'LANGUAGE'};\r
-\r
-#\r
-# Load requested language file from cachefile. If cachefile doesn't exist, build on the fly.\r
-# (it is a developper options)\r
-#\r
-sub reload {\r
-\r
-    my ($LG) = @_;\r
-    %Lang::tr = ();    # start with a clean array\r
-\r
-    # Use CacheLang if present & not empty.\r
-    if (-s "$Lang::CacheLang.$LG" ) {\r
-       ##fix: need to put a lock_shared on it in case rebuild is active ?\r
-       do "$Lang::CacheLang.$LG";\r
-        #&General::log ("cachelang file used [$LG]");  \r
-       return;\r
-    }\r
-    \r
-    #&General::log("Building on the fly cachelang file for [$LG]");\r
-    do "${General::swroot}/langs/en.pl";\r
-    do "${General::swroot}/langs/$LG.pl" if ($LG ne 'en');\r
-\r
-    my $AddonDir = ${General::swroot}.'/addon-lang';\r
-\r
-    opendir (DIR, $AddonDir);\r
-    my @files = readdir (DIR);\r
-    closedir (DIR);\r
-\r
-    # default is to load english first\r
-    foreach my $file ( grep (/.*\.en.pl$/,@files)) {\r
-       do "$AddonDir/$file";\r
-    }\r
-\r
-    # read again, overwriting 'en' with choosed lang\r
-    if ($LG ne 'en') {\r
-       foreach my $file (grep (/.*\.$LG\.pl$/,@files) ) {\r
-           do "$AddonDir/$file";\r
-       }\r
-    }\r
-}\r
-\r
-#\r
-# Assume this procedure is called with enough privileges.\r
-# Merge ipcop langage file + all other extension found in addon-lang\r
-# to build a 'cachefile' for selected language\r
-#\r
-sub BuildUniqueCacheLang {\r
-\r
-    my ($LG) = @_;\r
-    \r
-    # Make CacheLang empty so that it won't be used by Lang::reload\r
-    open (FILE, ">$Lang::CacheLang.$LG") or return 1;\r
-    flock (FILE, 2) or return 1;\r
-    close (FILE);\r
-\r
-    # Load languages files\r
-    &Lang::reload ($LG);\r
-    \r
-    # Write the unique %tr=('key'=>'value') array\r
-    open (FILE, ">$Lang::CacheLang.$LG") or return 1;\r
-    flock (FILE, 2) or return 1;\r
-    print FILE '%tr=(';\r
-    foreach my $k ( keys %Lang::tr ){\r
-       $Lang::tr{$k} =~ s/\'/\\\'/g;                   # quote ' => \'\r
-       print FILE "'$k' => '$Lang::tr{$k}',";          # key => value,\r
-    }\r
-    print FILE ');';\r
-    close (FILE);\r
-    \r
-    # Make nobody:nobody file's owner\r
-    # Will work when called by root/rc.sysinit\r
-    chown (0,0,"$Lang::CacheLang.$LG");\r
-    chmod (0004,"$Lang::CacheLang.$LG");\r
-    return 0;\r
-}\r
-\r
-#\r
-# Switch Ipcop Language for each lang then call build cachelang\r
-#\r
-sub BuildCacheLang {\r
-\r
-    my $AddonDir = ${General::swroot}.'/addon-lang';\r
-    \r
-    # Correct permission in case addon-installer did not do it\r
-    opendir (DIR, $AddonDir);\r
-    my @files = readdir (DIR);\r
-    foreach my $file (@files) {\r
-       next if (($file eq '..') || ($file eq '.'));\r
-       chown (0,0,"$AddonDir/$file");\r
-       chmod (0004,"$AddonDir/$file");\r
-    }\r
-    closedir (DIR);\r
-\r
-    my $selected = '';;\r
-    my $missed = '';\r
-    my $error = 0;\r
-    \r
-    open (LANGS, "${General::swroot}/langs/list");\r
-    while (<LANGS>) {\r
-       ($selected) = split (':');\r
-       if (BuildUniqueCacheLang ($selected) == 1) {\r
-           $missed = $selected; # will try latter. Can only be the current cachelang file locked\r
-       };\r
-    }\r
-    close (LANGS);\r
-\r
-    if ($missed) { # collision with current cache lang being used ?\r
-       $error = &BuildUniqueCacheLang ($missed);\r
-    }\r
-    \r
-    &General::log ("WARNING: cannot build cachelang file for [$missed].") if ($error);\r
-    return $error;\r
-}\r
-1;\r
+# SmoothWall CGIs
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) The SmoothWall Team
+# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> Split from header.pl
+#
+# $Id: lang.pl,v 1.1.2.11 2005/09/10 16:22:50 eoberlander Exp $
+#
+
+package Lang;
+require 'CONFIG_ROOT/general-functions.pl';
+use strict;
+
+### A cache file to avoid long recalculation
+$Lang::CacheLang = '/var/run/cache-lang.pl';
+
+# When you want to add your own language strings/entries to the ipcop language file,
+# you should create a file with <PREFIX>.<LANG>.pl into CONFIG_ROOT/addon-lang dir
+#      <PREFIX> is free choosable but should be significant. An Example might be "myAddnName"
+#      <LANG> is a mnemonic of the used language like en, de, it, nl etc.
+#              You can find a detailed list of possible mnemonic's in the file CONFIG_ROOT/langs/list
+# A file could be named "VirtualHttpd.en.pl" for example.
+#
+# The file content has to start with (of course without the leading #):
+# --------- CODE ---------
+#%tr = (%tr,
+# 'key1' => 'value',                           # add all your entries key/values here 
+# 'key2' => 'value'                            # and end with (of course without the leading #):
+#);
+# --------- CODE END---------
+#
+# After you have copied all your files to CONFIG_ROOT/add-lang you have to run the
+# script compilation:
+# perl -e "require '/CONFIG_ROOT/lang.pl'; &Lang::BuildCacheLang"
+
+
+### Initialize language
+%Lang::tr = ();
+my %settings = ();
+&General::readhash("${General::swroot}/main/settings", \%settings);
+reload($settings{'LANGUAGE'});
+
+# language variable used by makegraphs script
+our $language;
+$language = $settings{'LANGUAGE'};
+
+#
+# Load requested language file from cachefile. If cachefile doesn't exist, build on the fly.
+# (it is a developper options)
+#
+sub reload {
+
+    my ($LG) = @_;
+    %Lang::tr = ();    # start with a clean array
+
+    # Use CacheLang if present & not empty.
+    if (-s "$Lang::CacheLang.$LG" ) {
+       ##fix: need to put a lock_shared on it in case rebuild is active ?
+       do "$Lang::CacheLang.$LG";
+        #&General::log ("cachelang file used [$LG]");  
+       return;
+    }
+    
+    #&General::log("Building on the fly cachelang file for [$LG]");
+    do "${General::swroot}/langs/en.pl";
+    do "${General::swroot}/langs/$LG.pl" if ($LG ne 'en');
+
+    my $AddonDir = ${General::swroot}.'/addon-lang';
+
+    opendir (DIR, $AddonDir);
+    my @files = readdir (DIR);
+    closedir (DIR);
+
+    # default is to load english first
+    foreach my $file ( grep (/.*\.en.pl$/,@files)) {
+       do "$AddonDir/$file";
+    }
+
+    # read again, overwriting 'en' with choosed lang
+    if ($LG ne 'en') {
+       foreach my $file (grep (/.*\.$LG\.pl$/,@files) ) {
+           do "$AddonDir/$file";
+       }
+    }
+}
+
+#
+# Assume this procedure is called with enough privileges.
+# Merge ipcop langage file + all other extension found in addon-lang
+# to build a 'cachefile' for selected language
+#
+sub BuildUniqueCacheLang {
+
+    my ($LG) = @_;
+    
+    # Make CacheLang empty so that it won't be used by Lang::reload
+    open (FILE, ">$Lang::CacheLang.$LG") or return 1;
+    flock (FILE, 2) or return 1;
+    close (FILE);
+
+    # Load languages files
+    &Lang::reload ($LG);
+    
+    # Write the unique %tr=('key'=>'value') array
+    open (FILE, ">$Lang::CacheLang.$LG") or return 1;
+    flock (FILE, 2) or return 1;
+    print FILE '%tr=(';
+    foreach my $k ( keys %Lang::tr ){
+       $Lang::tr{$k} =~ s/\'/\\\'/g;                   # quote ' => \'
+       print FILE "'$k' => '$Lang::tr{$k}',";          # key => value,
+    }
+    print FILE ');';
+    close (FILE);
+    
+    # Make nobody:nobody file's owner
+    # Will work when called by root/rc.sysinit
+    chown (0,0,"$Lang::CacheLang.$LG");
+    chmod (0004,"$Lang::CacheLang.$LG");
+    return 0;
+}
+
+#
+# Switch Ipcop Language for each lang then call build cachelang
+#
+sub BuildCacheLang {
+
+    my $AddonDir = ${General::swroot}.'/addon-lang';
+    
+    # Correct permission in case addon-installer did not do it
+    opendir (DIR, $AddonDir);
+    my @files = readdir (DIR);
+    foreach my $file (@files) {
+       next if (($file eq '..') || ($file eq '.'));
+       chown (0,0,"$AddonDir/$file");
+       chmod (0004,"$AddonDir/$file");
+    }
+    closedir (DIR);
+
+    my $selected = '';;
+    my $missed = '';
+    my $error = 0;
+    
+    open (LANGS, "${General::swroot}/langs/list");
+    while (<LANGS>) {
+       ($selected) = split (':');
+       if (BuildUniqueCacheLang ($selected) == 1) {
+           $missed = $selected; # will try latter. Can only be the current cachelang file locked
+       };
+    }
+    close (LANGS);
+
+    if ($missed) { # collision with current cache lang being used ?
+       $error = &BuildUniqueCacheLang ($missed);
+    }
+    
+    &General::log ("WARNING: cannot build cachelang file for [$missed].") if ($error);
+    return $error;
+}
+1;
index d7ed2db..39fb676 100644 (file)
-# Protocols Data File\r
-#\r
-# This file is part of the IPCop Firewall.\r
-#\r
-# IPCop is free software; you can redistribute it and/or modify\r
-# it under the terms of the GNU General Public License as published by\r
-# the Free Software Foundation; either version 2 of the License, or\r
-# (at your option) any later version.\r
-#\r
-# IPCop is distributed in the hope that it will be useful,\r
-# but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
-# GNU General Public License for more details.\r
-#\r
-# You should have received a copy of the GNU General Public License\r
-# along with IPCop; if not, write to the Free Software\r
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA\r
-#\r
-# (c) The IPCop Team\r
-#\r
-# $Id: protocols.pl,v 1.2.2.1 2005/01/26 12:23:20 riddles Exp $\r
-#\r
-# Generated from /etc/protocols using:\r
-# cat /etc/protocols | grep -ve "^#" | grep -v "^$" | \\r
-#    awk '{ print "\""  $1  "\" => \"" $2 "\","}'\r
-#\r
-# Code supplied by Mark Wormgroor\r
-#\r
-\r
-package Protocols;\r
-\r
-%protocols = (\r
-"ip" => "0",\r
-"icmp" => "1",\r
-"igmp" => "2",\r
-"ggp" => "3",\r
-"ipencap" => "4",\r
-"st" => "5",\r
-"tcp" => "6",\r
-"cbt" => "7",\r
-"egp" => "8",\r
-"igp" => "9",\r
-"bbn-rcc" => "10",\r
-"nvp" => "11",\r
-"pup" => "12",\r
-"argus" => "13",\r
-"emcon" => "14",\r
-"xnet" => "15",\r
-"chaos" => "16",\r
-"udp" => "17",\r
-"mux" => "18",\r
-"dcn" => "19",\r
-"hmp" => "20",\r
-"prm" => "21",\r
-"xns-idp" => "22",\r
-"trunk-1" => "23",\r
-"trunk-2" => "24",\r
-"leaf-1" => "25",\r
-"leaf-2" => "26",\r
-"rdp" => "27",\r
-"irtp" => "28",\r
-"iso-tp4" => "29",\r
-"netblt" => "30",\r
-"mfe-nsp" => "31",\r
-"merit-inp" => "32",\r
-"sep" => "33",\r
-"3pc" => "34",\r
-"idpr" => "35",\r
-"xtp" => "36",\r
-"ddp" => "37",\r
-"idpr-cmtp" => "38",\r
-"tp++" => "39",\r
-"il" => "40",\r
-"ipv6" => "41",\r
-"sdrp" => "42",\r
-"ipv6-route" => "43",\r
-"ipv6-frag" => "44",\r
-"idrp" => "45",\r
-"rsvp" => "46",\r
-"gre" => "47",\r
-"mhrp" => "48",\r
-"bna" => "49",\r
-"ipv6-crypt" => "50",\r
-"ipv6-auth" => "51",\r
-"i-nlsp" => "52",\r
-"swipe" => "53",\r
-"narp" => "54",\r
-"mobile" => "55",\r
-"tlsp" => "56",\r
-"skip" => "57",\r
-"ipv6-icmp" => "58",\r
-"ipv6-nonxt" => "59",\r
-"ipv6-opts" => "60",\r
-"cftp" => "62",\r
-"sat-expak" => "64",\r
-"kryptolan" => "65",\r
-"rvd" => "66",\r
-"ippc" => "67",\r
-"sat-mon" => "69",\r
-"visa" => "70",\r
-"ipcv" => "71",\r
-"cpnx" => "72",\r
-"cphb" => "73",\r
-"wsn" => "74",\r
-"pvp" => "75",\r
-"br-sat-mon" => "76",\r
-"sun-nd" => "77",\r
-"wb-mon" => "78",\r
-"wb-expak" => "79",\r
-"iso-ip" => "80",\r
-"vmtp" => "81",\r
-"secure-vmtp" => "82",\r
-"vines" => "83",\r
-"ttp" => "84",\r
-"nsfnet-igp" => "85",\r
-"dgp" => "86",\r
-"tcf" => "87",\r
-"eigrp" => "88",\r
-"ospf" => "89",\r
-"sprite-rpc" => "90",\r
-"larp" => "91",\r
-"mtp" => "92",\r
-"ax.25" => "93",\r
-"ipip" => "94",\r
-"micp" => "95",\r
-"scc-sp" => "96",\r
-"etherip" => "97",\r
-"encap" => "98",\r
-"gmtp" => "100",\r
-"ifmp" => "101",\r
-"pnni" => "102",\r
-"pim" => "103",\r
-"aris" => "104",\r
-"scps" => "105",\r
-"qnx" => "106",\r
-"a/n" => "107",\r
-"ipcomp" => "108",\r
-"snp" => "109",\r
-"compaq-peer" => "110",\r
-"ipx-in-ip" => "111",\r
-"vrrp" => "112",\r
-"pgm" => "113",\r
-"l2tp" => "115",\r
-"ddx" => "116",\r
-"iatp" => "117",\r
-"stp" => "118",\r
-"srp" => "119",\r
-"uti" => "120",\r
-"smp" => "121",\r
-"sm" => "122",\r
-"ptp" => "123",\r
-"isis" => "124",\r
-"fire" => "125",\r
-"crtp" => "126",\r
-"crdup" => "127",\r
-"sscopmce" => "128",\r
-"iplt" => "129",\r
-"sps" => "130",\r
-"pipe" => "131",\r
-"sctp" => "132",\r
-"fc" => "133",\r
-);\r
+# Protocols Data File
+#
+# This file is part of the IPCop Firewall.
+#
+# IPCop is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# IPCop is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with IPCop; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
+#
+# (c) The IPCop Team
+#
+# $Id: protocols.pl,v 1.2.2.1 2005/01/26 12:23:20 riddles Exp $
+#
+# Generated from /etc/protocols using:
+# cat /etc/protocols | grep -ve "^#" | grep -v "^$" | \
+#    awk '{ print "\""  $1  "\" => \"" $2 "\","}'
+#
+# Code supplied by Mark Wormgroor
+#
+
+package Protocols;
+
+%protocols = (
+"ip" => "0",
+"icmp" => "1",
+"igmp" => "2",
+"ggp" => "3",
+"ipencap" => "4",
+"st" => "5",
+"tcp" => "6",
+"cbt" => "7",
+"egp" => "8",
+"igp" => "9",
+"bbn-rcc" => "10",
+"nvp" => "11",
+"pup" => "12",
+"argus" => "13",
+"emcon" => "14",
+"xnet" => "15",
+"chaos" => "16",
+"udp" => "17",
+"mux" => "18",
+"dcn" => "19",
+"hmp" => "20",
+"prm" => "21",
+"xns-idp" => "22",
+"trunk-1" => "23",
+"trunk-2" => "24",
+"leaf-1" => "25",
+"leaf-2" => "26",
+"rdp" => "27",
+"irtp" => "28",
+"iso-tp4" => "29",
+"netblt" => "30",
+"mfe-nsp" => "31",
+"merit-inp" => "32",
+"sep" => "33",
+"3pc" => "34",
+"idpr" => "35",
+"xtp" => "36",
+"ddp" => "37",
+"idpr-cmtp" => "38",
+"tp++" => "39",
+"il" => "40",
+"ipv6" => "41",
+"sdrp" => "42",
+"ipv6-route" => "43",
+"ipv6-frag" => "44",
+"idrp" => "45",
+"rsvp" => "46",
+"gre" => "47",
+"mhrp" => "48",
+"bna" => "49",
+"ipv6-crypt" => "50",
+"ipv6-auth" => "51",
+"i-nlsp" => "52",
+"swipe" => "53",
+"narp" => "54",
+"mobile" => "55",
+"tlsp" => "56",
+"skip" => "57",
+"ipv6-icmp" => "58",
+"ipv6-nonxt" => "59",
+"ipv6-opts" => "60",
+"cftp" => "62",
+"sat-expak" => "64",
+"kryptolan" => "65",
+"rvd" => "66",
+"ippc" => "67",
+"sat-mon" => "69",
+"visa" => "70",
+"ipcv" => "71",
+"cpnx" => "72",
+"cphb" => "73",
+"wsn" => "74",
+"pvp" => "75",
+"br-sat-mon" => "76",
+"sun-nd" => "77",
+"wb-mon" => "78",
+"wb-expak" => "79",
+"iso-ip" => "80",
+"vmtp" => "81",
+"secure-vmtp" => "82",
+"vines" => "83",
+"ttp" => "84",
+"nsfnet-igp" => "85",
+"dgp" => "86",
+"tcf" => "87",
+"eigrp" => "88",
+"ospf" => "89",
+"sprite-rpc" => "90",
+"larp" => "91",
+"mtp" => "92",
+"ax.25" => "93",
+"ipip" => "94",
+"micp" => "95",
+"scc-sp" => "96",
+"etherip" => "97",
+"encap" => "98",
+"gmtp" => "100",
+"ifmp" => "101",
+"pnni" => "102",
+"pim" => "103",
+"aris" => "104",
+"scps" => "105",
+"qnx" => "106",
+"a/n" => "107",
+"ipcomp" => "108",
+"snp" => "109",
+"compaq-peer" => "110",
+"ipx-in-ip" => "111",
+"vrrp" => "112",
+"pgm" => "113",
+"l2tp" => "115",
+"ddx" => "116",
+"iatp" => "117",
+"stp" => "118",
+"srp" => "119",
+"uti" => "120",
+"smp" => "121",
+"sm" => "122",
+"ptp" => "123",
+"isis" => "124",
+"fire" => "125",
+"crtp" => "126",
+"crdup" => "127",
+"sscopmce" => "128",
+"iplt" => "129",
+"sps" => "130",
+"pipe" => "131",
+"sctp" => "132",
+"fc" => "133",
+);
index 7c0ea66..5364d20 100644 (file)
@@ -303,6 +303,12 @@ CONFIG_IP_NF_ARPFILTER=m
 CONFIG_IP_NF_ARP_MANGLE=m
 # CONFIG_IP_NF_COMPAT_IPCHAINS is not set
 # CONFIG_IP_NF_COMPAT_IPFWADM is not set
+CONFIG_IP_NF_MATCH_IPP2P=m
+CONFIG_IP_NF_MATCH_COMMENT=m
+CONFIG_IP_NF_MATCH_LAYER7=m
+CONFIG_IP_NF_MATCH_LAYER7_DEBUG=n
+CONFIG_IP_NF_TARGET_IMQ=m
+CONFIG_IMQ=m
 
 #
 #   IP: Virtual Server Configuration
index bc4afd9..c9b8d94 100644 (file)
@@ -6,6 +6,7 @@
 * Digest-1.08
 * Digest-HMAC-1.01
 * Digest-SHA1-2.10
+* GD-2.12
 * HTML-Parser-3.45
 * HTML-Tagset-3.04
 * LPRng-3.8.28
index 040eb29..5c2a4a1 100644 (file)
-#!/usr/bin/perl\r
-#\r
-# IPCop CGI's - aliases.cgi\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) Steve Bootes 2002/04/13 - Manage IP Aliases\r
-#\r
-# $Id: aliases.cgi,v 1.5.2.14 2006/01/13 20:14:48 eoberlander Exp $\r
-\r
-\r
-# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines\r
-#use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work\r
-# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help\r
-use warnings;\r
-use strict;\r
-#use Carp ();\r
-#local $SIG{__WARN__} = \&Carp::cluck;\r
-\r
-require 'CONFIG_ROOT/general-functions.pl';    # replace CONFIG_ROOT with /var/ipcop in case of manual install\r
-require "${General::swroot}/lang.pl";\r
-require "${General::swroot}/header.pl";\r
-\r
-#workaround to suppress a warning when a variable is used only once\r
-my @dummy = ( ${Header::colouryellow} );\r
-   @dummy = ( ${Header::table1colour} );\r
-   @dummy = ( ${Header::table2colour} );\r
-undef (@dummy);\r
-\r
-# Files used\r
-my $setting = "${General::swroot}/ethernet/settings";\r
-our $datafile = "${General::swroot}/ethernet/aliases";\r
-\r
-\r
-our %settings=();\r
-#Settings1\r
-\r
-#Settings2 for editing the multi-line list\r
-#Must not be saved !\r
-$settings{'IP'} = '';\r
-$settings{'ENABLED'} = 'off';          # Every check box must be set to off\r
-$settings{'NAME'} = '';\r
-my @nosaved=('IP','ENABLED','NAME');   # List here ALL setting2 fields. Mandatory\r
-    \r
-$settings{'ACTION'} = '';              # add/edit/remove\r
-$settings{'KEY1'} = '';                        # point record for ACTION\r
-\r
-#Define each field that can be used to sort columns\r
-my $sortstring='^IP|^NAME';\r
-my $errormessage = '';\r
-my $warnmessage = '';\r
-\r
-&Header::showhttpheaders();\r
-\r
-# Read needed Ipcop netsettings\r
-my %netsettings=();\r
-$netsettings{'SORT_ALIASES'} = 'NAME';         # default sort\r
-&General::readhash($setting, \%netsettings);\r
-\r
-#Get GUI values\r
-&Header::getcgihash(\%settings);\r
-\r
-# Load multiline data\r
-our @current = ();\r
-if (open(FILE, "$datafile")) {\r
-    @current = <FILE>;\r
-    close (FILE);\r
-}\r
-\r
-#\r
-# Check Settings1 first because they are needed before working on @current\r
-#\r
-# Remove if no Setting1 needed\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'save'}) {\r
-    \r
-    #\r
-    #Validate static Settings1 here\r
-    #\r
-    \r
-    unless ($errormessage) {                                   # Everything is ok, save settings\r
-       #map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved \r
-       #&General::writehash($setting, \%settings);             # Save good settings\r
-       #$settings{'ACTION'} = $Lang::tr{'save'};               # Recreate  'ACTION'\r
-       #map ($settings{$_}= '',(@nosaved,'KEY1'));             # and reinit var to empty\r
-       \r
-       # Rebuild configuration file if needed\r
-       &BuildConfiguration;\r
-    }\r
-\r
-    ERROR:                                             # Leave the faulty field untouched\r
-} else {\r
-    #&General::readhash($setting, \%settings);         # Get saved settings and reset to good if needed\r
-}\r
-\r
-## Now manipulate the multi-line list with Settings2\r
-# Basic actions are:\r
-#      toggle the check box\r
-#      add/update a new line\r
-#      begin editing a line\r
-#      remove a line\r
-\r
-\r
-# Toggle enable/disable field.  Field is in second position\r
-if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {\r
-    #move out new line\r
-    chomp(@current[$settings{'KEY1'}]);\r
-    my @temp = split(/\,/,@current[$settings{'KEY1'}]);\r
-    $temp[1] = $temp[1] eq 'on' ? '' : 'on';           # Toggle the field\r
-    @current[$settings{'KEY1'}] = join (',',@temp)."\n";\r
-    $settings{'KEY1'} = '';                            # End edit mode\r
-    \r
-    &General::log($Lang::tr{'ip alias changed'});\r
-    \r
-    #Save current\r
-    open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
-    print FILE @current;\r
-    close(FILE);\r
-       \r
-    # Rebuild configuration file\r
-    &BuildConfiguration;\r
-}\r
-\r
-if ($settings{'ACTION'} eq $Lang::tr{'add'}) {\r
-    # Validate inputs\r
-    if (! &General::validip($settings{'IP'})) {$errormessage = "invalid ip"};\r
-    $settings{'NAME'} = &Header::cleanhtml($settings{'NAME'});\r
-\r
-    # Make sure we haven't duplicated an alias or RED\r
-    my $spacer='';\r
-    if ($settings{'IP'} eq $netsettings{'RED_ADDRESS'}) {\r
-       $errormessage = $Lang::tr{'duplicate ip'} . ' (RED)';\r
-        $spacer=" & ";\r
-    }\r
-    my $idx=0;\r
-    foreach my $line (@current) {\r
-        chomp ($line);\r
-        my @temp = split (/\,/, $line);\r
-        if ( ($settings{'KEY1'} eq '')||(($settings{'KEY1'} ne '') && ($settings{'KEY1'} != $idx))) { # update\r
-           if ($temp[0] eq $settings{'IP'}) {\r
-               $errormessage .= $spacer.$Lang::tr{'duplicate ip'};\r
-               $spacer=" & ";\r
-           }\r
-           if ($temp[2] eq $settings{'NAME'} && $temp[2] ne '') {\r
-               $errormessage .= $spacer.$Lang::tr{'duplicate name'};\r
-               $spacer=" & ";\r
-               }\r
-       }\r
-       $idx++;\r
-    }\r
-    unless ($errormessage) {\r
-       if ($settings{'KEY1'} eq '') { #add or edit ?\r
-           unshift (@current, "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n");\r
-           &General::log($Lang::tr{'ip alias added'});\r
-       } else {\r
-           @current[$settings{'KEY1'}] = "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n";\r
-           $settings{'KEY1'} = '';       # End edit mode\r
-           &General::log($Lang::tr{'ip alias changed'});\r
-       }\r
-\r
-       # Write changes to config file.\r
-       &SortDataFile;                          # sort newly added/modified entry\r
-\r
-       &BuildConfiguration;                    # then re-build conf which use new data\r
-       \r
-##\r
-## if entering data line is repetitive, choose here to not erase fields between each addition\r
-##\r
-       map ($settings{$_}='' ,@nosaved);       # Clear fields\r
-    }\r
-}\r
-\r
-if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {\r
-    #move out new line\r
-    my $line = @current[$settings{'KEY1'}];    # KEY1 is the index in current\r
-    chomp($line);\r
-    my @temp = split(/\,/, $line);\r
-\r
-##\r
-## move data fields to Setting2 for edition\r
-##\r
-    $settings{'IP'}=$temp[0];                  # Prepare the screen for editing\r
-    $settings{'ENABLED'}=$temp[1];\r
-    $settings{'NAME'}=$temp[2];\r
-}\r
-\r
-if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {\r
-    splice (@current,$settings{'KEY1'},1);             # Delete line \r
-    open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
-    print FILE @current;\r
-    close(FILE);\r
-    $settings{'KEY1'} = '';                            # End remove mode\r
-    &General::log($Lang::tr{'ip alias removed'});\r
-\r
-    &BuildConfiguration;                               # then re-build conf which use new data\r
-}\r
-\r
-\r
-\r
-##  Check if sorting is asked\r
-# If same column clicked, reverse the sort.\r
-if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {\r
-    my $newsort=$ENV{'QUERY_STRING'};\r
-    my $actual=$netsettings{'SORT_ALIASES'};\r
-    #Reverse actual sort ?\r
-    if ($actual =~ $newsort) {\r
-       my $Rev='';\r
-       if ($actual !~ 'Rev') {\r
-           $Rev='Rev';\r
-       }\r
-       $newsort.=$Rev;\r
-    }\r
-    $netsettings{'SORT_ALIASES'}=$newsort;\r
-    &General::writehash($setting, \%netsettings);\r
-    &SortDataFile;\r
-    $settings{'ACTION'} = 'SORT';                      # Recreate  'ACTION'\r
-}\r
-\r
-# Default initial value\r
-if ($settings{'ACTION'} eq '' ) { # First launch from GUI\r
-    $settings{'ENABLED'} ='on';\r
-}\r
-    \r
-&Header::openpage($Lang::tr{'external aliases configuration'}, 1, '');\r
-&Header::openbigbox('100%', 'left', '', $errormessage);\r
-my %checked =();     # Checkbox manipulations\r
-\r
-if ($errormessage) {\r
-    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
-    print "<font class='base'>$errormessage&nbsp;</font>";\r
-    &Header::closebox();\r
-}\r
-unless (( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ ) && ($netsettings{'RED_TYPE'} eq 'STATIC'))\r
-{\r
-    &Header::openbox('100%', 'left', $Lang::tr{'capswarning'});\r
-    print <<END\r
-    <table width='100%'>\r
-    <tr>\r
-    <td width='100%' class='boldbase' align='center'><font color='${Header::colourred}'><b>$Lang::tr{'aliases not active'}</b></font></td>\r
-    </tr>\r
-    </table>\r
-END\r
-;\r
-    &Header::closebox();\r
-}\r
-                                                                       \r
-#\r
-# Second check box is for editing the list\r
-#\r
-$checked{'ENABLED'}{'on'} = ($settings{'ENABLED'} eq '') ? '' :  "checked='checked'";\r
-\r
-my $buttontext = $Lang::tr{'add'};\r
-if ($settings{'KEY1'} ne '') {\r
-    $buttontext = $Lang::tr{'update'};\r
-    &Header::openbox('100%', 'left', $Lang::tr{'edit an existing alias'});\r
-} else {\r
-    &Header::openbox('100%', 'left', $Lang::tr{'add new alias'});\r
-}\r
-\r
-#Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'\r
-print <<END\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />\r
-<table width='100%'>\r
-<tr>\r
-<td class='base'><font color='${Header::colourred}'>$Lang::tr{'name'}:&nbsp;<img src='/blob.gif' alt='*' /></font></td>\r
-<td><input type='text' name='NAME' value='$settings{'NAME'}' size='32' /></td>\r
-<td class='base' align='right'><font color='${Header::colourred}'>$Lang::tr{'alias ip'}:&nbsp;</font></td>\r
-<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>\r
-<td class='base' align='right'>$Lang::tr{'enabled'}&nbsp;</td>\r
-<td><input type='checkbox' name='ENABLED' $checked{'ENABLED'}{'on'} /></td>\r
-</tr>\r
-</table>\r
-<hr />\r
-<table width='100%'>\r
-<tr>\r
-    <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>\r
-    <td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>\r
-</tr>\r
-</table>\r
-</form>\r
-END\r
-;\r
-&Header::closebox();\r
-\r
-#\r
-# Third box shows the list, in columns\r
-#\r
-# Columns headers may content a link. In this case it must be named in $sortstring\r
-#\r
-&Header::openbox('100%', 'left', $Lang::tr{'current aliases'});\r
-print <<END\r
-<table width='100%'>\r
-<tr>\r
-    <td width='50%' align='center'><a href='$ENV{'SCRIPT_NAME'}?NAME'><b>$Lang::tr{'name'}</b></a></td>\r
-    <td width='40%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a></td>\r
-    <td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>\r
-</tr>\r
-END\r
-;\r
-\r
-#\r
-# Print each line of @current list\r
-#\r
-# each data line is splitted into @temp.\r
-#\r
-\r
-my $key = 0;\r
-foreach my $line (@current) {\r
-    chomp($line);\r
-    my @temp = split(/\,/,$line);\r
-\r
-    #Choose icon for checkbox\r
-    my $gif = '';\r
-    my $gdesc = '';\r
-    if ($temp[1] eq "on") {\r
-       $gif = 'on.gif';\r
-       $gdesc = $Lang::tr{'click to disable'};\r
-    } else {\r
-       $gif = 'off.gif';\r
-       $gdesc = $Lang::tr{'click to enable'}; \r
-    }\r
-\r
-    #Colorize each line\r
-    if ($settings{'KEY1'} eq $key) {\r
-       print "<tr bgcolor='${Header::colouryellow}'>";\r
-    } elsif ($key % 2) {\r
-       print "<tr bgcolor='${Header::table2colour}'>";\r
-    } else {\r
-       print "<tr bgcolor='${Header::table1colour}'>"; \r
-    }\r
-\r
-    print <<END\r
-<td align='center'>$temp[2]</td>\r
-<td align='center'>$temp[0]</td>\r
-\r
-<td align='center'>\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />\r
-<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />\r
-<input type='hidden' name='KEY1' value='$key' />\r
-</form>\r
-</td>\r
-\r
-<td align='center'>\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />\r
-<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />\r
-<input type='hidden' name='KEY1' value='$key' />\r
-</form>\r
-</td>\r
-\r
-<td align='center'>\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />\r
-<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />\r
-<input type='hidden' name='KEY1' value='$key' />\r
-</form>\r
-</td>\r
-</tr>\r
-END\r
-;\r
-    $key++;\r
-}\r
-print "</table>";\r
-\r
-# If table contains entries, print 'Key to action icons'\r
-if ($key) {\r
-print <<END\r
-<table>\r
-<tr>\r
-    <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>\r
-    <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>\r
-    <td class='base'>$Lang::tr{'click to disable'}</td>\r
-    <td>&nbsp;&nbsp;</td>\r
-    <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>\r
-    <td class='base'>$Lang::tr{'click to enable'}</td>\r
-    <td>&nbsp;&nbsp;</td>\r
-    <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>\r
-    <td class='base'>$Lang::tr{'edit'}</td>\r
-    <td>&nbsp;&nbsp;</td>\r
-    <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>\r
-    <td class='base'>$Lang::tr{'remove'}</td>\r
-</tr>\r
-</table>\r
-END\r
-;\r
-}\r
-\r
-&Header::closebox();\r
-&Header::closebigbox();\r
-&Header::closepage();\r
-\r
-## Ouf it's the end !\r
-\r
-\r
-\r
-# Sort the "current" array according to choices\r
-sub SortDataFile\r
-{\r
-    our %entries = ();\r
-    \r
-    # Sort pair of record received in $a $b special vars.\r
-    # When IP is specified use numeric sort else alpha.\r
-    # If sortname ends with 'Rev', do reverse sort.\r
-    #\r
-    sub fixedleasesort {\r
-       my $qs='';             # The sort field specified minus 'Rev'\r
-       if (rindex ($netsettings{'SORT_ALIASES'},'Rev') != -1) {\r
-           $qs=substr ($netsettings{'SORT_ALIASES'},0,length($netsettings{'SORT_ALIASES'})-3);\r
-           if ($qs eq 'IP') {\r
-               my @a = split(/\./,$entries{$a}->{$qs});\r
-               my @b = split(/\./,$entries{$b}->{$qs});\r
-               ($b[0]<=>$a[0]) ||\r
-               ($b[1]<=>$a[1]) ||\r
-               ($b[2]<=>$a[2]) ||\r
-               ($b[3]<=>$a[3]);\r
-           } else {\r
-               $entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r
-           }\r
-       } else { #not reverse\r
-           $qs=$netsettings{'SORT_ALIASES'};\r
-           if ($qs eq 'IP') {\r
-               my @a = split(/\./,$entries{$a}->{$qs});\r
-               my @b = split(/\./,$entries{$b}->{$qs});\r
-               ($a[0]<=>$b[0]) ||\r
-               ($a[1]<=>$b[1]) ||\r
-               ($a[2]<=>$b[2]) ||\r
-               ($a[3]<=>$b[3]);\r
-           } else {\r
-               $entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r
-           }\r
-       }\r
-    }\r
-\r
-    #Use an associative array (%entries)\r
-    my $key = 0;\r
-    foreach my $line (@current) {\r
-       chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)\r
-       my @temp = split (',',$line);\r
-       \r
-       # Build a pair 'Field Name',value for each of the data dataline.\r
-       # Each SORTABLE field must have is pair.\r
-       # Other data fields (non sortable) can be grouped in one\r
-       \r
-       # Exemple\r
-       # F1,F2,F3,F4,F5       only F1 F2 for sorting\r
-       # my @record = ('KEY',$key++,\r
-       #               'F1',$temp[0],\r
-       #               'F2',$temp[1],\r
-       #               'DATA',join(',',@temp[2..4])    );  #group remainning values, with separator (,)\r
-       \r
-       # The KEY,key record permits doublons. If removed, then F1 becomes the key without doublon permitted.\r
-       \r
-       \r
-       my @record = ('KEY',$key++,'IP',$temp[0],'ENABLED',$temp[1],'NAME',$temp[2]);\r
-       my $record = {};                                # create a reference to empty hash\r
-       %{$record} = @record;                           # populate that hash with @record\r
-       $entries{$record->{KEY}} = $record;             # add this to a hash of hashes\r
-    }\r
-    \r
-    open(FILE, ">$datafile") or die 'Unable to open aliases file.';\r
-\r
-    # Each field value is printed , with the newline ! Don't forget separator and order of them.\r
-    foreach my $entry (sort fixedleasesort keys %entries) {\r
-       print FILE "$entries{$entry}->{IP},$entries{$entry}->{ENABLED},$entries{$entry}->{NAME}\n";\r
-    }\r
-\r
-    close(FILE);\r
-    # Reload sorted  @current\r
-    open (FILE, "$datafile");\r
-    @current = <FILE>;\r
-    close (FILE);\r
-}\r
-\r
-#                                                  \r
-# Build the configuration file for application aliases\r
-#\r
-sub BuildConfiguration {\r
-    # Restart service associated with this\r
-    system '/usr/local/bin/setaliases';\r
-}\r
+#!/usr/bin/perl
+#
+# IPCop CGI's - aliases.cgi
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) Steve Bootes 2002/04/13 - Manage IP Aliases
+#
+# $Id: aliases.cgi,v 1.5.2.14 2006/01/13 20:14:48 eoberlander Exp $
+
+
+# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines
+#use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work
+# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help
+use warnings;
+use strict;
+#use Carp ();
+#local $SIG{__WARN__} = \&Carp::cluck;
+
+require 'CONFIG_ROOT/general-functions.pl';    # replace CONFIG_ROOT with /var/ipcop in case of manual install
+require "${General::swroot}/lang.pl";
+require "${General::swroot}/header.pl";
+
+#workaround to suppress a warning when a variable is used only once
+my @dummy = ( ${Header::colouryellow} );
+   @dummy = ( ${Header::table1colour} );
+   @dummy = ( ${Header::table2colour} );
+undef (@dummy);
+
+# Files used
+my $setting = "${General::swroot}/ethernet/settings";
+our $datafile = "${General::swroot}/ethernet/aliases";
+
+
+our %settings=();
+#Settings1
+
+#Settings2 for editing the multi-line list
+#Must not be saved !
+$settings{'IP'} = '';
+$settings{'ENABLED'} = 'off';          # Every check box must be set to off
+$settings{'NAME'} = '';
+my @nosaved=('IP','ENABLED','NAME');   # List here ALL setting2 fields. Mandatory
+    
+$settings{'ACTION'} = '';              # add/edit/remove
+$settings{'KEY1'} = '';                        # point record for ACTION
+
+#Define each field that can be used to sort columns
+my $sortstring='^IP|^NAME';
+my $errormessage = '';
+my $warnmessage = '';
+
+&Header::showhttpheaders();
+
+# Read needed Ipcop netsettings
+my %netsettings=();
+$netsettings{'SORT_ALIASES'} = 'NAME';         # default sort
+&General::readhash($setting, \%netsettings);
+
+#Get GUI values
+&Header::getcgihash(\%settings);
+
+# Load multiline data
+our @current = ();
+if (open(FILE, "$datafile")) {
+    @current = <FILE>;
+    close (FILE);
+}
+
+#
+# Check Settings1 first because they are needed before working on @current
+#
+# Remove if no Setting1 needed
+#
+if ($settings{'ACTION'} eq $Lang::tr{'save'}) {
+    
+    #
+    #Validate static Settings1 here
+    #
+    
+    unless ($errormessage) {                                   # Everything is ok, save settings
+       #map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved 
+       #&General::writehash($setting, \%settings);             # Save good settings
+       #$settings{'ACTION'} = $Lang::tr{'save'};               # Recreate  'ACTION'
+       #map ($settings{$_}= '',(@nosaved,'KEY1'));             # and reinit var to empty
+       
+       # Rebuild configuration file if needed
+       &BuildConfiguration;
+    }
+
+    ERROR:                                             # Leave the faulty field untouched
+} else {
+    #&General::readhash($setting, \%settings);         # Get saved settings and reset to good if needed
+}
+
+## Now manipulate the multi-line list with Settings2
+# Basic actions are:
+#      toggle the check box
+#      add/update a new line
+#      begin editing a line
+#      remove a line
+
+
+# Toggle enable/disable field.  Field is in second position
+if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {
+    #move out new line
+    chomp(@current[$settings{'KEY1'}]);
+    my @temp = split(/\,/,@current[$settings{'KEY1'}]);
+    $temp[1] = $temp[1] eq 'on' ? '' : 'on';           # Toggle the field
+    @current[$settings{'KEY1'}] = join (',',@temp)."\n";
+    $settings{'KEY1'} = '';                            # End edit mode
+    
+    &General::log($Lang::tr{'ip alias changed'});
+    
+    #Save current
+    open(FILE, ">$datafile") or die 'Unable to open aliases file.';
+    print FILE @current;
+    close(FILE);
+       
+    # Rebuild configuration file
+    &BuildConfiguration;
+}
+
+if ($settings{'ACTION'} eq $Lang::tr{'add'}) {
+    # Validate inputs
+    if (! &General::validip($settings{'IP'})) {$errormessage = "invalid ip"};
+    $settings{'NAME'} = &Header::cleanhtml($settings{'NAME'});
+
+    # Make sure we haven't duplicated an alias or RED
+    my $spacer='';
+    if ($settings{'IP'} eq $netsettings{'RED_ADDRESS'}) {
+       $errormessage = $Lang::tr{'duplicate ip'} . ' (RED)';
+        $spacer=" & ";
+    }
+    my $idx=0;
+    foreach my $line (@current) {
+        chomp ($line);
+        my @temp = split (/\,/, $line);
+        if ( ($settings{'KEY1'} eq '')||(($settings{'KEY1'} ne '') && ($settings{'KEY1'} != $idx))) { # update
+           if ($temp[0] eq $settings{'IP'}) {
+               $errormessage .= $spacer.$Lang::tr{'duplicate ip'};
+               $spacer=" & ";
+           }
+           if ($temp[2] eq $settings{'NAME'} && $temp[2] ne '') {
+               $errormessage .= $spacer.$Lang::tr{'duplicate name'};
+               $spacer=" & ";
+               }
+       }
+       $idx++;
+    }
+    unless ($errormessage) {
+       if ($settings{'KEY1'} eq '') { #add or edit ?
+           unshift (@current, "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n");
+           &General::log($Lang::tr{'ip alias added'});
+       } else {
+           @current[$settings{'KEY1'}] = "$settings{'IP'},$settings{'ENABLED'},$settings{'NAME'}\n";
+           $settings{'KEY1'} = '';       # End edit mode
+           &General::log($Lang::tr{'ip alias changed'});
+       }
+
+       # Write changes to config file.
+       &SortDataFile;                          # sort newly added/modified entry
+
+       &BuildConfiguration;                    # then re-build conf which use new data
+       
+##
+## if entering data line is repetitive, choose here to not erase fields between each addition
+##
+       map ($settings{$_}='' ,@nosaved);       # Clear fields
+    }
+}
+
+if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {
+    #move out new line
+    my $line = @current[$settings{'KEY1'}];    # KEY1 is the index in current
+    chomp($line);
+    my @temp = split(/\,/, $line);
+
+##
+## move data fields to Setting2 for edition
+##
+    $settings{'IP'}=$temp[0];                  # Prepare the screen for editing
+    $settings{'ENABLED'}=$temp[1];
+    $settings{'NAME'}=$temp[2];
+}
+
+if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {
+    splice (@current,$settings{'KEY1'},1);             # Delete line 
+    open(FILE, ">$datafile") or die 'Unable to open aliases file.';
+    print FILE @current;
+    close(FILE);
+    $settings{'KEY1'} = '';                            # End remove mode
+    &General::log($Lang::tr{'ip alias removed'});
+
+    &BuildConfiguration;                               # then re-build conf which use new data
+}
+
+
+
+##  Check if sorting is asked
+# If same column clicked, reverse the sort.
+if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {
+    my $newsort=$ENV{'QUERY_STRING'};
+    my $actual=$netsettings{'SORT_ALIASES'};
+    #Reverse actual sort ?
+    if ($actual =~ $newsort) {
+       my $Rev='';
+       if ($actual !~ 'Rev') {
+           $Rev='Rev';
+       }
+       $newsort.=$Rev;
+    }
+    $netsettings{'SORT_ALIASES'}=$newsort;
+    &General::writehash($setting, \%netsettings);
+    &SortDataFile;
+    $settings{'ACTION'} = 'SORT';                      # Recreate  'ACTION'
+}
+
+# Default initial value
+if ($settings{'ACTION'} eq '' ) { # First launch from GUI
+    $settings{'ENABLED'} ='on';
+}
+    
+&Header::openpage($Lang::tr{'external aliases configuration'}, 1, '');
+&Header::openbigbox('100%', 'left', '', $errormessage);
+my %checked =();     # Checkbox manipulations
+
+if ($errormessage) {
+    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
+    print "<font class='base'>$errormessage&nbsp;</font>";
+    &Header::closebox();
+}
+unless (( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ ) && ($netsettings{'RED_TYPE'} eq 'STATIC'))
+{
+    &Header::openbox('100%', 'left', $Lang::tr{'capswarning'});
+    print <<END
+    <table width='100%'>
+    <tr>
+    <td width='100%' class='boldbase' align='center'><font color='${Header::colourred}'><b>$Lang::tr{'aliases not active'}</b></font></td>
+    </tr>
+    </table>
+END
+;
+    &Header::closebox();
+}
+                                                                       
+#
+# Second check box is for editing the list
+#
+$checked{'ENABLED'}{'on'} = ($settings{'ENABLED'} eq '') ? '' :  "checked='checked'";
+
+my $buttontext = $Lang::tr{'add'};
+if ($settings{'KEY1'} ne '') {
+    $buttontext = $Lang::tr{'update'};
+    &Header::openbox('100%', 'left', $Lang::tr{'edit an existing alias'});
+} else {
+    &Header::openbox('100%', 'left', $Lang::tr{'add new alias'});
+}
+
+#Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'
+print <<END
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />
+<table width='100%'>
+<tr>
+<td class='base'><font color='${Header::colourred}'>$Lang::tr{'name'}:&nbsp;<img src='/blob.gif' alt='*' /></font></td>
+<td><input type='text' name='NAME' value='$settings{'NAME'}' size='32' /></td>
+<td class='base' align='right'><font color='${Header::colourred}'>$Lang::tr{'alias ip'}:&nbsp;</font></td>
+<td><input type='text' name='IP' value='$settings{'IP'}' size='16' /></td>
+<td class='base' align='right'>$Lang::tr{'enabled'}&nbsp;</td>
+<td><input type='checkbox' name='ENABLED' $checked{'ENABLED'}{'on'} /></td>
+</tr>
+</table>
+<hr />
+<table width='100%'>
+<tr>
+    <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>
+    <td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>
+</tr>
+</table>
+</form>
+END
+;
+&Header::closebox();
+
+#
+# Third box shows the list, in columns
+#
+# Columns headers may content a link. In this case it must be named in $sortstring
+#
+&Header::openbox('100%', 'left', $Lang::tr{'current aliases'});
+print <<END
+<table width='100%'>
+<tr>
+    <td width='50%' align='center'><a href='$ENV{'SCRIPT_NAME'}?NAME'><b>$Lang::tr{'name'}</b></a></td>
+    <td width='40%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'alias ip'}</b></a></td>
+    <td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>
+</tr>
+END
+;
+
+#
+# Print each line of @current list
+#
+# each data line is splitted into @temp.
+#
+
+my $key = 0;
+foreach my $line (@current) {
+    chomp($line);
+    my @temp = split(/\,/,$line);
+
+    #Choose icon for checkbox
+    my $gif = '';
+    my $gdesc = '';
+    if ($temp[1] eq "on") {
+       $gif = 'on.gif';
+       $gdesc = $Lang::tr{'click to disable'};
+    } else {
+       $gif = 'off.gif';
+       $gdesc = $Lang::tr{'click to enable'}; 
+    }
+
+    #Colorize each line
+    if ($settings{'KEY1'} eq $key) {
+       print "<tr bgcolor='${Header::colouryellow}'>";
+    } elsif ($key % 2) {
+       print "<tr bgcolor='${Header::table2colour}'>";
+    } else {
+       print "<tr bgcolor='${Header::table1colour}'>"; 
+    }
+
+    print <<END
+<td align='center'>$temp[2]</td>
+<td align='center'>$temp[0]</td>
+
+<td align='center'>
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />
+<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />
+<input type='hidden' name='KEY1' value='$key' />
+</form>
+</td>
+
+<td align='center'>
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />
+<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />
+<input type='hidden' name='KEY1' value='$key' />
+</form>
+</td>
+
+<td align='center'>
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />
+<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />
+<input type='hidden' name='KEY1' value='$key' />
+</form>
+</td>
+</tr>
+END
+;
+    $key++;
+}
+print "</table>";
+
+# If table contains entries, print 'Key to action icons'
+if ($key) {
+print <<END
+<table>
+<tr>
+    <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>
+    <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>
+    <td class='base'>$Lang::tr{'click to disable'}</td>
+    <td>&nbsp;&nbsp;</td>
+    <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>
+    <td class='base'>$Lang::tr{'click to enable'}</td>
+    <td>&nbsp;&nbsp;</td>
+    <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>
+    <td class='base'>$Lang::tr{'edit'}</td>
+    <td>&nbsp;&nbsp;</td>
+    <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>
+    <td class='base'>$Lang::tr{'remove'}</td>
+</tr>
+</table>
+END
+;
+}
+
+&Header::closebox();
+&Header::closebigbox();
+&Header::closepage();
+
+## Ouf it's the end !
+
+
+
+# Sort the "current" array according to choices
+sub SortDataFile
+{
+    our %entries = ();
+    
+    # Sort pair of record received in $a $b special vars.
+    # When IP is specified use numeric sort else alpha.
+    # If sortname ends with 'Rev', do reverse sort.
+    #
+    sub fixedleasesort {
+       my $qs='';             # The sort field specified minus 'Rev'
+       if (rindex ($netsettings{'SORT_ALIASES'},'Rev') != -1) {
+           $qs=substr ($netsettings{'SORT_ALIASES'},0,length($netsettings{'SORT_ALIASES'})-3);
+           if ($qs eq 'IP') {
+               my @a = split(/\./,$entries{$a}->{$qs});
+               my @b = split(/\./,$entries{$b}->{$qs});
+               ($b[0]<=>$a[0]) ||
+               ($b[1]<=>$a[1]) ||
+               ($b[2]<=>$a[2]) ||
+               ($b[3]<=>$a[3]);
+           } else {
+               $entries{$b}->{$qs} cmp $entries{$a}->{$qs};
+           }
+       } else { #not reverse
+           $qs=$netsettings{'SORT_ALIASES'};
+           if ($qs eq 'IP') {
+               my @a = split(/\./,$entries{$a}->{$qs});
+               my @b = split(/\./,$entries{$b}->{$qs});
+               ($a[0]<=>$b[0]) ||
+               ($a[1]<=>$b[1]) ||
+               ($a[2]<=>$b[2]) ||
+               ($a[3]<=>$b[3]);
+           } else {
+               $entries{$a}->{$qs} cmp $entries{$b}->{$qs};
+           }
+       }
+    }
+
+    #Use an associative array (%entries)
+    my $key = 0;
+    foreach my $line (@current) {
+       chomp( $line); #remove newline because can be on field 5 or 6 (addition of REMARK)
+       my @temp = split (',',$line);
+       
+       # Build a pair 'Field Name',value for each of the data dataline.
+       # Each SORTABLE field must have is pair.
+       # Other data fields (non sortable) can be grouped in one
+       
+       # Exemple
+       # F1,F2,F3,F4,F5       only F1 F2 for sorting
+       # my @record = ('KEY',$key++,
+       #               'F1',$temp[0],
+       #               'F2',$temp[1],
+       #               'DATA',join(',',@temp[2..4])    );  #group remainning values, with separator (,)
+       
+       # The KEY,key record permits doublons. If removed, then F1 becomes the key without doublon permitted.
+       
+       
+       my @record = ('KEY',$key++,'IP',$temp[0],'ENABLED',$temp[1],'NAME',$temp[2]);
+       my $record = {};                                # create a reference to empty hash
+       %{$record} = @record;                           # populate that hash with @record
+       $entries{$record->{KEY}} = $record;             # add this to a hash of hashes
+    }
+    
+    open(FILE, ">$datafile") or die 'Unable to open aliases file.';
+
+    # Each field value is printed , with the newline ! Don't forget separator and order of them.
+    foreach my $entry (sort fixedleasesort keys %entries) {
+       print FILE "$entries{$entry}->{IP},$entries{$entry}->{ENABLED},$entries{$entry}->{NAME}\n";
+    }
+
+    close(FILE);
+    # Reload sorted  @current
+    open (FILE, "$datafile");
+    @current = <FILE>;
+    close (FILE);
+}
+
+#                                                  
+# Build the configuration file for application aliases
+#
+sub BuildConfiguration {
+    # Restart service associated with this
+    system '/usr/local/bin/setaliases';
+}
index dd9b149..b818409 100644 (file)
-#!/usr/bin/perl\r
-#\r
-# IPCop CGI's - backup.cgi: manage import/export of configuration files\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) The IPCop Team\r
-# 2005 Franck Bourdonnec, major rewrite\r
-#\r
-# $Id: backup.cgi,v 1.2.2.15 2006/01/29 15:31:49 eoberlander Exp $\r
-#\r
-#\r
-\r
-\r
-# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines\r
-# use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work\r
-# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help\r
-#use warnings;\r
-use strict;\r
-#use Carp ();\r
-#local $SIG{__WARN__} = \&Carp::cluck;\r
-use File::Copy;\r
-use Sys::Hostname;\r
-\r
-require 'CONFIG_ROOT/general-functions.pl';\r
-require "${General::swroot}/lang.pl";\r
-require "${General::swroot}/header.pl";\r
-\r
-my $errormessage = '';\r
-my $warnmessage = '';\r
-my $setdir = '/home/httpd/html/backup'; # location where sets are stored and imported\r
-my $datafile = hostname() . '.dat';    # file containing data backup\r
-my $datefile = $datafile . '.time';    # and creation date\r
-\r
-# ask if backup crypting key exists\r
-my $tmpkeyfile = "$setdir/key";                # import the backup key\r
-\r
-# Get GUI values\r
-my %settings = ();\r
-&Header::getcgihash(\%settings, {'wantfile' => 1, 'filevar' => 'FH'});\r
-\r
-##\r
-## Backup key management\r
-##\r
-\r
-#\r
-# Export the key. root pw is required to avoid user 'noboby' uses the helper to read it and creates\r
-# fake backup.\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'backup export key'})  {\r
-\r
-    my $size = 0;\r
-    if ($settings{'PASSWORD1'} ne '' && $settings{'PASSWORD1'} ne $settings{'PASSWORD2'} ){\r
-       $errormessage = $Lang::tr{'passwords do not match'}\r
-    } else {\r
-       my @lines = `/usr/local/bin/ipcopbackup -keycat $settings{'PASSWORD'}`;\r
-       # If previous operation succeded and the key need to be crypted, redo operation with pipe to openssl\r
-       if (@lines && $settings{'PASSWORD1'}) {\r
-           @lines = `/usr/local/bin/ipcopbackup -keycat $settings{'PASSWORD'}|openssl enc -a -e -aes256 -salt -pass pass:$settings{'PASSWORD1'} `;\r
-       }\r
-        if (@lines) {\r
-           use bytes;\r
-           foreach (@lines) {$size += length($_)};\r
-           print "Pragma: no-cache\n";\r
-           print "Cache-control: no-cache\n";\r
-           print "Connection: close\n";\r
-           print "Content-type: application/octet-stream\n";\r
-           print "Content-Disposition: filename=backup.key\n";\r
-           print "Content-Length: $size\n\n";\r
-           print @lines;\r
-           exit (0);\r
-       } else {\r
-           $errormessage = $Lang::tr{'incorrect password'};\r
-       }\r
-    }  \r
-}\r
-#\r
-#  Import the key. Fail if key exists. This avoid creating fake backup.\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'backup import key'})  {\r
-    if (ref ($settings{'FH'}) ne 'Fh') {\r
-       $errormessage = $Lang::tr{'no cfg upload'};\r
-    } else {\r
-       if (copy ($settings{'FH'}, $tmpkeyfile) != 1) {\r
-           $errormessage = $Lang::tr{'save error'};\r
-       } else {\r
-           # if a password is given, decrypt the key received in $tmpkeyfile file with it.\r
-           # no error is produce if the password is wrong.\r
-           if ($settings{'PASSWORD1'}) {\r
-               my @lines = `openssl enc -a -d -aes256 -salt -pass pass:$settings{'PASSWORD1'} -in $tmpkeyfile`;\r
-               open(FILE,">$tmpkeyfile");\r
-               print FILE @lines;\r
-               close (FILE);\r
-           }\r
-           $errormessage = &get_bk_error(system ('/usr/local/bin/ipcopbackup -key import')>>8);\r
-       }\r
-    }\r
-}\r
-#\r
-#  Import the key. Fail if key exists. Key is extracted from a non-encrypted backup (pre 1.4.10)\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'backup extract key'})  {\r
-    if (ref ($settings{'FH'}) ne 'Fh') {\r
-       $errormessage = $Lang::tr{'no cfg upload'};\r
-    } else {\r
-       if (copy ($settings{'FH'}, '/tmp/tmptarfile.tgz') != 1) {\r
-           $errormessage = $Lang::tr{'save error'};\r
-       } else {\r
-           system( "tar -C /tmp -xzf /tmp/tmptarfile.tgz */backup/backup.key;\\r
-                   mv -f /tmp${General::swroot}/backup/backup.key $tmpkeyfile;\\r
-                   rm -rf /tmp${General::swroot};\\r
-                   rm /tmp/tmptarfile.tgz");\r
-           $errormessage = &get_bk_error(system ('/usr/local/bin/ipcopbackup -key import')>>8);\r
-       }\r
-    }\r
-}\r
-#\r
-#  Create the key. Cannot overwrite existing key to avoid difference with exported (saved) key\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'backup generate key'})  {\r
-    $errormessage = &get_bk_error(system('/usr/local/bin/ipcopbackup -key new')>>8);\r
-}\r
-\r
-my $cryptkeymissing = system ('/usr/local/bin/ipcopbackup -key exist')>>8;\r
-\r
-&Header::showhttpheaders();\r
-if ($cryptkeymissing) {  #If no key is present, force creation or import\r
-    &Header::openpage($Lang::tr{'backup configuration'}, 1, '');\r
-    &Header::openbigbox('100%', 'left', '', $errormessage);\r
-    if ($errormessage) {\r
-       &Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
-       print "<font class='base'>$errormessage&nbsp;</font>";\r
-       &Header::closebox();\r
-    }\r
-    &Header::openbox('100%', 'left', $Lang::tr{'backup key'});\r
-    print <<END\r
-    <form method = 'post' enctype = 'multipart/form-data'>\r
-      <table>\r
-        <tr>\r
-         <td colspan='2'>\r
-         $Lang::tr{'backup explain key'}:\r
-         <ul>\r
-         <li>$Lang::tr{'backup explain key li1'}\r
-         <li>$Lang::tr{'backup explain key li2'}\r
-         <li>$Lang::tr{'backup explain key li3'}\r
-         </ul>\r
-          </td>\r
-       </tr><tr>\r
-         <td width='15%'></td><td width='20%'></td><td>\r
-         <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup generate key'}' />\r
-          </td>\r
-       </tr><tr>\r
-         <td align='right'>$Lang::tr{'backup key file'}:</td><td><input type = 'file' name = 'FH' size = '30' value='backup.key' />\r
-         </td><td>\r
-         <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup import key'}' />\r
-       </tr><tr>\r
-         <td align='right'>$Lang::tr{'backup protect key password'}:<td><input type = 'password' name='PASSWORD1' size='10' />\r
-          </td>\r
-       </tr><tr>\r
-         <td align='right'>$Lang::tr{'backup clear archive'}:</td><td><input type = 'file' name = 'FH' size = '30' value='your-ipcop.tar.gz' />\r
-         </td><td>\r
-         <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup extract key'}' />\r
-          </td>\r
-       </tr>\r
-      </table>\r
-      $Lang::tr{'notes'}:\r
-      <ul>\r
-         <li>$Lang::tr{'backup explain key no1'}\r
-         <li>$Lang::tr{'backup explain key no2'}\r
-      </ul>\r
-    </form>\r
-END\r
-;\r
-    &floppybox();\r
-    &Header::closebox();\r
-    &Header::closebigbox();\r
-    &Header::closepage();\r
-    exit (0);\r
-}\r
-\r
-##\r
-## Sets management (create/delete/import/restore)\r
-##\r
-\r
-erase_files ($setdir);                 #clean up\r
-\r
-#\r
-# create new archive set\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'create'}) {\r
-    $errormessage = &get_bk_error(system('/usr/local/bin/ipcopbkcfg > /dev/null')>>8);\r
-    &import_set (" ".&Header::cleanhtml ($settings{'COMMENT'})) if (!$errormessage);\r
-}\r
-#\r
-# delete a backup set\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {\r
-    erase_files (&Header::cleanhtml ($settings{'KEY'}));       # remove files\r
-    rmdir($settings{'KEY'});           # remove directory\r
-}\r
-#\r
-# import an archive set\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'import'}) {\r
-    if (ref ($settings{'FH'}) ne 'Fh') {\r
-       $errormessage = $Lang::tr{'no cfg upload'};\r
-    } else {\r
-       if (!copy ($settings{'FH'}, "$setdir/$datafile")) {\r
-           $errormessage = $Lang::tr{'save error'};\r
-       } else {\r
-           &import_set ('&nbsp;(imported)');\r
-       }\r
-    }\r
-}\r
-#\r
-# restore an archive\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'restore'}) {\r
-    if ($settings{'AreYouSure'} eq 'yes') {\r
-       if (!$cryptkeymissing) {                        # if keyfile exists\r
-           if (-e "$settings{'KEY'}/$datafile"){       # encrypted dat is required\r
-               copy_files($settings{'KEY'}, $setdir);  # to working dir\r
-               $errormessage = get_rs_error(system("/usr/local/bin/ipcoprscfg" \r
-                                       . ($settings{'RESTOREHW'} eq 'on' ? ' --hardware' : '') \r
-                                       . ' >/dev/null')>>8);\r
-               if (!$errormessage) {\r
-                   # restored ok, recommend restarting system\r
-                   $warnmessage = $Lang::tr{'cfg restart'};\r
-               }\r
-               erase_files ($setdir);                  #clean up\r
-           } else {\r
-               $errormessage = $Lang::tr{'missing dat'}."$settings{'KEY'}/$datafile";\r
-           }\r
-       } else {  # if keyfile does not exist\r
-           $errormessage = $Lang::tr{'backup missing key'};\r
-       }\r
-    \r
-    } else {  # not AreYouSure=yes\r
-       &Header::openpage($Lang::tr{'backup configuration'}, 1, '');\r
-       &Header::openbigbox('100%', 'left');\r
-       &Header::openbox('100%', 'left', $Lang::tr{'are you sure'});\r
-       print <<END\r
-<form method = 'post'>\r
-  <input type = 'hidden' name = 'KEY' value ='$settings{'KEY'}' /> \r
-  <input type = 'hidden' name = 'AreYouSure' value ='yes' />\r
-  <table align = 'center'>\r
-    <tr>\r
-      <td align = 'center'>\r
-       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'restore'}' />\r
-      </td><td>\r
-       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'cancel'}' />\r
-      </td>\r
-    </tr><tr>\r
-      <td>\r
-       $Lang::tr{'restore hardware settings'}: <input type = 'checkbox' name = 'RESTOREHW'>\r
-      </td>\r
-    </tr>\r
-</table>\r
-</form>\r
-END\r
-;\r
-       &Header::closebox();\r
-       &Header::closebigbox();\r
-       &Header::closepage();\r
-       exit (0);\r
-    }\r
-}\r
-##\r
-##  Media management\r
-##\r
-#\r
-# now build the list of removable device\r
-#\r
-\r
-# Read partitions sizes registered with the system\r
-my %partitions;\r
-foreach my $li (`/usr/local/bin/ipcopbackup -proc partitions`) {               # use suid helper...\r
-    # partitions{'sda1'} = 128M        if         /major minor  blocks name/\r
-    $partitions{$4} = &kmgt($3*1024,4) if ($li =~ /(\d+) +(\d+) +(\d+) +(.*)/);\r
-}\r
-\r
-# Search usb-storage scsi device\r
-my %medias;\r
-    \r
-foreach (`/usr/local/bin/ipcopbackup -glob '/proc/scsi/usb-storage*/*'`) {# use suid helper...\r
-    my $m;\r
-    foreach ( `cat $_` ) {     # list each line of information for the device:\r
-#      Host scsi0: usb-storage\r
-#      Vendor: SWISSBIT\r
-#      Product: Black Silver\r
-#      Serial Number: D0ED423A4F84A31E\r
-#      Protocol: Transparent SCSI\r
-#      Transport: Bulk\r
-#      GUID: 13706828d0ed423a4f84a31e\r
-#      Attached: Yes\r
-                                      \r
-       chomp;\r
-       my ($key,$val) = split(': ',$_,2);\r
-       $key =~ s/^ *//;        # remove front space\r
-\r
-       # convert 'scsi?' key to sda, sdb,... and use it as a %medias keyhash\r
-       if ($key =~ /Host scsi(.)/) {\r
-           $val = $m = 'sd' . chr(97+$1);\r
-           $key = 'Host';\r
-       }\r
-       $medias{$m}{$key} = $val;               # save data\r
-    }\r
-}\r
-\r
-#\r
-# Switch mounted media\r
-#\r
-if ($settings{'ACTION'} eq $Lang::tr{'mount'})\r
-{\r
-    # Find what is really mounted under backup. Can be local hard disk or any removable media\r
-    my $mounted = &findmounted();\r
-    #umount previous, even if same device already mouted.\r
-    system ("/usr/local/bin/ipcopbackup -U $mounted") if ($mounted ne $Lang::tr{'local hard disk'});\r
-    $errormessage = `/usr/local/bin/ipcopbackup -M $settings{'SELECT'}` if (grep (/$settings{'SELECT'}/,%partitions));\r
-}\r
-#\r
-# Compute a full description of device\r
-#\r
-my $mounted = &findmounted();\r
-my $media_des = $mounted;      # Description\r
-if ($mounted ne $Lang::tr{'local hard disk'}) {\r
-    $_ = $mounted;     # sda1 => sda\r
-    tr/0-9//d;\r
-    $media_des = "$medias{$_}{'Product'} ($media_des, $partitions{$mounted})";\r
-}\r
-&Header::openpage($Lang::tr{'backup configuration'}, 1, '');\r
-&Header::openbigbox('100%', 'left', '', $errormessage);\r
-\r
-if ($errormessage) {\r
-    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
-    print "<font class='base'>$errormessage&nbsp;</font>";\r
-    &Header::closebox();\r
-}\r
-\r
-$warnmessage = "<font color=${Header::colourred}><b>$Lang::tr{'capswarning'}</b></font>: $warnmessage <p>" if ($warnmessage);\r
-\r
-&Header::openbox('100%', 'left', $Lang::tr{'backup configuration'});\r
-\r
-#Divide the window in two : left and right\r
-print <<END\r
-    <table width = '100%' >\r
-    <tr>\r
-       <th width = '50%'>$Lang::tr{'current media'}:<font color=${Header::colourred}><b>$media_des</b></font></th>\r
-       <th width = '3%'></th>\r
-       <th>$Lang::tr{'choose media'}</th>\r
-    </tr>\r
-END\r
-;\r
-\r
-# Left part of window\r
-print <<END\r
-    <tr><td>\r
-    <ul>\r
-    <li>$Lang::tr{'backup sets'}:\r
-    <table width = '80%' border='0'>\r
-    <tr>\r
-       <th  class = 'boldbase' align = 'center'>$Lang::tr{'name'}</th>\r
-       <th  class = 'boldbase' align = 'center' colspan = '3'>$Lang::tr{'action'}</th>\r
-    </tr>\r
-END\r
-;\r
-\r
-# get list of available sets by globbing directories under $setdir\r
-# External device (usk key) are mounted in $setdir. -R permits finding sets in hierarchy.\r
-my $i = 0;\r
-foreach my $set (`ls -Rt1 $setdir`) {\r
-    chop ($set);       #remove ':' & newline from line\r
-    chop ($set);\r
-    if (-d $set && ($set =~ m!/.+/\d{8}_\d{6}! ) ) { # filter out things not sets !\r
-       if ($i++ % 2) {\r
-           print "<tr bgcolor = '$Header::table2colour'>";\r
-       } else {\r
-           print "<tr bgcolor = '$Header::table1colour'>";\r
-       }\r
-       my $settime = read_timefile( "$set/$datefile", "$set/$datafile" );\r
-       my $name = substr ($set,length($setdir)+1);\r
-       print<<EOF\r
-<td>\r
-    $settime\r
-</td>\r
-\r
-<td align = 'center'>\r
-<form method = 'post'>\r
-<input type = 'hidden' name = 'ACTION' value ='$Lang::tr{'restore'}' />\r
-<input type = 'image'  name = '$Lang::tr{'restore'}' src = '/images/reload.gif' alt = '$Lang::tr{'restore'}' title = '$Lang::tr{'restore'}' />\r
-<input type = 'hidden' name = 'KEY' value = '$set' />\r
-</form>\r
-</td>\r
-\r
-<td align = 'center'>\r
-<a href = '/backup/$name/$datafile'><img src = '/images/floppy.gif' title = '$Lang::tr{'export'}'></a>\r
-</td>\r
-\r
-<td align = 'center'>\r
-<form method = 'post'>\r
-<input type = 'hidden' name = 'ACTION' value = '$Lang::tr{'remove'}' />\r
-<input type = 'image'  name = '$Lang::tr{'remove'}' src = '/images/delete.gif' alt = '$Lang::tr{'remove'}' title = '$Lang::tr{'remove'}' border = '0' />\r
-<input type = 'hidden' name = 'KEY' value = '$set' />\r
-</form>\r
-</td>\r
-</tr>\r
-EOF\r
-;\r
-    }\r
-}\r
-print "</table>" . ($i ? "<br>" : "$Lang::tr{'empty'}!<hr /><br>");\r
-print <<EOF\r
-$warnmessage\r
-<form method = 'post'>\r
-       <li>$Lang::tr{'backup configuration'}<br>\r
-       $Lang::tr{'description'}:<input type = 'text' name = 'COMMENT' size='30' />\r
-       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'create'}' />\r
-</form><p>\r
-<form method = 'post' enctype = 'multipart/form-data'>\r
-       <li>$Lang::tr{'backup import dat file'}:<br>\r
-       <input type = 'file' name = 'FH' size = '20' />\r
-       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'import'}' />\r
-</form>\r
-</ul>\r
-EOF\r
-;\r
-\r
-print "</td><td></td><td valign='top'>";  # Start right part (devices selection)\r
-print $Lang::tr{'backup media info'};\r
-\r
-print "<form method = 'post'>";\r
-print "<table width = '100%'><tr><td>";\r
-my $nodev = 1;             # nothing present\r
-foreach my $media (keys %medias) {\r
-    if ( $medias{$media}{'Attached'} eq 'Yes') {       # device is attached to USB bus ?\r
-       $nodev = 0;             # at least one device present\r
-       my $checked = $medias{$media}{'Host'} eq $mounted ? "checked='checked'" : '';\r
-       print "<input type='radio' name = 'SELECT' value = '$medias{$media}{'Host'}' $checked />";\r
-       print "<b>$medias{$media}{'Product'}</b><br>";\r
-       # list attached partitions to this media\r
-       foreach my $part (sort (keys (%partitions))) {\r
-           if ($part =~ /$medias{$media}{'Host'}./) {\r
-               my $checked = $part eq $mounted ? "checked='checked'" : '';\r
-               print "&nbsp;&nbsp;&nbsp;<input type='radio' name = 'SELECT' value = '$part' $checked />$part ($partitions{$part})<br>";\r
-           }\r
-       }\r
-    }\r
-}\r
-if ($nodev) {\r
-    print "<br>$Lang::tr{'insert removable device'}";\r
-    print "</td><td>";\r
-    print "<br><input type = 'submit' name = 'ACTION' value = '$Lang::tr{'done'}' />";\r
-} else {\r
-    #Add an entry for the local disk\r
-    my $checked =  $Lang::tr{'local hard disk'} eq $mounted ? "checked='checked'" : '';\r
-    print "<input type = 'radio' name = 'SELECT' value = '$Lang::tr{'local hard disk'}' $checked />";\r
-    print "<b>$Lang::tr{'local hard disk'}</b>";\r
-    print "</td><td>";\r
-    print "<br><input type = 'submit' name = 'ACTION' value = '$Lang::tr{'mount'}' />";\r
-}\r
-print "</tr></table>";\r
-print "</form>";\r
-#\r
-#Backup key\r
-#\r
-print<<EOF\r
-    <hr />\r
-<form method='post'>\r
-    <b>$Lang::tr{'backup key'}</b><br>\r
-    $Lang::tr{'backup key info'}<br>\r
-    <table><tr>\r
-    <td align= 'right'>$Lang::tr{'root user password'}:\r
-    <td align='left'><input type = 'password' name='PASSWORD' />\r
-    <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup export key'}' />\r
-    </tr><tr>\r
-    <td align='right'>$Lang::tr{'backup protect key password'}:\r
-    <td align='left'><input type = 'password' name='PASSWORD1' size='10' />\r
-    </tr><tr>\r
-    <td align='right'>$Lang::tr{'again'}\r
-    <td align='left'><input type = 'password' name='PASSWORD2'  size='10'/>\r
-    </tr></table>\r
-</form>\r
-\r
-EOF\r
-;\r
-# End of right table\r
-print "</td></tr></table>";\r
-\r
-&floppybox();\r
-\r
-&Header::closebox();\r
-&Header::closebigbox();\r
-&Header::closepage();\r
-\r
-sub floppybox {\r
-    print <<END\r
-<hr />\r
-<form method = 'post'>\r
-<table width='100%'>\r
-<tr>\r
-    <td>\r
-         <b>$Lang::tr{'backup to floppy'}</b>\r
-    </td>\r
-</tr>\r
-<tr>\r
-    <td width='50%'>\r
-       $Lang::tr{'insert floppy'}\r
-    </td>\r
-    <td align='center'> \r
-       <input type='submit' name='ACTION' value='$Lang::tr{'backup to floppy'}' />\r
-    </td> \r
-</tr>\r
-</table>\r
-</form>\r
-END\r
-;\r
-    print   "<b>$Lang::tr{'alt information'}</b><pre>" .\r
-           `/usr/local/bin/ipcopbackup -savecfg floppy` .\r
-           '&nbsp;</pre>' if ($settings{'ACTION'} eq $Lang::tr{'backup to floppy'} );\r
-}\r
-\r
-# Return device name of what is mounted under 'backup'\r
-sub findmounted() {\r
-    my $mounted = `mount|grep ' /home/httpd/html/backup '`;\r
-    if ($mounted) {                            # extract device name\r
-        $mounted =~ m!^/dev/(.*) on!;          # device on mountmoint options\r
-        return $1; \r
-    } else {                                   # it's the normal subdir\r
-        return $Lang::tr{'local hard disk'};\r
-    }\r
-}\r
-# read and return a date/time string from a time file\r
-sub read_timefile() {\r
-    my $fname = shift;   # name of file to read from\r
-    my $fname2 = shift;  # if first file doesn't exist, get date of this file\r
-\r
-    my $dt;\r
-    if (defined(open(FH, "<$fname"))) {\r
-       $dt = <FH>;\r
-       chomp $dt;\r
-       close(FH);\r
-    } else {\r
-       $dt = &get_fdate($fname2);    # get file date/time\r
-       write_timefile($fname, $dt); # write to expected time file\r
-    }\r
-    return $dt;\r
-}\r
-# write a date/time string to a time file\r
-sub write_timefile() {\r
-    my $fname = shift; # name of file to write to\r
-    my $dt = shift;    # date/time string to write\r
-\r
-    if (open(FH, ">$fname")) {\r
-      print FH "$dt\n";\r
-      close(FH);\r
-    }  \r
-}\r
-# move a dat file without time stamp to subdir\r
-sub import_set() {\r
-    my $dt = get_fdate("$setdir/$datafile") . shift;\r
-    &write_timefile("$setdir/$datefile", $dt);\r
-\r
-    # create set directory\r
-    my $setname = "$setdir/" . get_ddate("$setdir/$datafile");\r
-    mkdir($setname);\r
-\r
-    # move files to the new set directory\r
-    copy_files($setdir, $setname);\r
-    erase_files ($setdir);\r
-}\r
-\r
-# get date/time string from file\r
-sub get_fdate() {\r
-    my $fname = shift;\r
-    open(DT, "/bin/date -r $fname|");\r
-    my $dt = <DT>;\r
-    close(DT);\r
-    chomp $dt;\r
-    $dt =~ s/\s+/ /g;  # remove duplicate spaces\r
-    return $dt;\r
-}\r
-# get date/time string from file for use as directory name\r
-sub get_ddate() {\r
-    my $fname = shift;\r
-    open(DT, "/bin/date -r $fname +%Y%m%d_%H%M%S|");\r
-    my $dt = <DT>;\r
-    close(DT);\r
-    chomp $dt;\r
-    return $dt;\r
-}\r
-# copy archive files from source directory to destination directory\r
-sub copy_files() {\r
-    my $src_dir = shift;\r
-    my $dest_dir = shift;\r
-    map (copy ("$src_dir/$_", "$dest_dir/$_"),  ($datafile, $datefile) );\r
-}\r
-# erase set files\r
-sub erase_files() {\r
-    my $src_dir = shift;\r
-    map (unlink ("$src_dir/$_"),  ($datafile, $datefile));\r
-}\r
-# get backup error text\r
-sub get_bk_error() {\r
-    my $exit_code = shift || return '';\r
-    if ($exit_code == 0) {\r
-       return '';\r
-    } elsif ($exit_code == 2) {\r
-       return $Lang::tr{'err bk 2 key'};\r
-    } elsif ($exit_code == 3) {\r
-       return $Lang::tr{'err bk 3 tar'};\r
-    } elsif ($exit_code == 4) {\r
-       return $Lang::tr{'err bk 4 gz'};\r
-    } elsif ($exit_code == 5) {\r
-       return $Lang::tr{'err bk 5 encrypt'};\r
-    } else {\r
-       return $Lang::tr{'err bk 1'};\r
-    }\r
-}\r
-# show any restore errors\r
-sub get_rs_error() {\r
-    \r
-    my $exit_code = shift || return '';\r
-    if ($exit_code == 0) {\r
-       return '';\r
-    } elsif ($exit_code == 6) {\r
-       return $Lang::tr{'err rs 6 decrypt'};\r
-    } elsif ($exit_code == 7) {\r
-       return $Lang::tr{'err rs 7 untartst'};\r
-    } elsif ($exit_code == 8) {\r
-       return $Lang::tr{'err rs 8 untar'};\r
-    } elsif ($exit_code == 9) {\r
-       return $Lang::tr{'missing dat'};\r
-    } else {\r
-       return $Lang::tr{'err rs 1'}."($exit_code)";\r
-    }\r
-}\r
-sub kmgt {\r
-    my ($value,$length,$opt_U) = @_;\r
-    if      ( $value > 10**( $length + 8 ) or $opt_U eq 'T' ) {\r
-       return sprintf( "%d%s", int( ( $value / 1024**4 ) + .5 ), 'T' );\r
-    } elsif ( $value > 10**( $length + 5 ) or $opt_U eq 'G' ) {\r
-       return sprintf( "%d%s", int( ( $value / 1024**3 ) + .5 ), 'G' );\r
-    } elsif ( $value > 10**( $length + 2 ) or $opt_U eq 'M' ) {\r
-       return sprintf( "%d%s", int( ( $value / 1024**2 ) + .5 ), 'M' );\r
-    } elsif ( $value > 10**($length) or $opt_U eq 'K' ) {\r
-       return sprintf( "%d%s", int( ( $value / 1024 ) + .5 ), 'K' );\r
-    } else {\r
-       return $value;\r
-    }\r
-}\r
-\r
-1;\r
+#!/usr/bin/perl
+#
+# IPCop CGI's - backup.cgi: manage import/export of configuration files
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) The IPCop Team
+# 2005 Franck Bourdonnec, major rewrite
+#
+# $Id: backup.cgi,v 1.2.2.15 2006/01/29 15:31:49 eoberlander Exp $
+#
+#
+
+
+# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines
+# use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work
+# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help
+#use warnings;
+use strict;
+#use Carp ();
+#local $SIG{__WARN__} = \&Carp::cluck;
+use File::Copy;
+use Sys::Hostname;
+
+require 'CONFIG_ROOT/general-functions.pl';
+require "${General::swroot}/lang.pl";
+require "${General::swroot}/header.pl";
+
+my $errormessage = '';
+my $warnmessage = '';
+my $setdir = '/home/httpd/html/backup'; # location where sets are stored and imported
+my $datafile = hostname() . '.dat';    # file containing data backup
+my $datefile = $datafile . '.time';    # and creation date
+
+# ask if backup crypting key exists
+my $tmpkeyfile = "$setdir/key";                # import the backup key
+
+# Get GUI values
+my %settings = ();
+&Header::getcgihash(\%settings, {'wantfile' => 1, 'filevar' => 'FH'});
+
+##
+## Backup key management
+##
+
+#
+# Export the key. root pw is required to avoid user 'noboby' uses the helper to read it and creates
+# fake backup.
+#
+if ($settings{'ACTION'} eq $Lang::tr{'backup export key'})  {
+
+    my $size = 0;
+    if ($settings{'PASSWORD1'} ne '' && $settings{'PASSWORD1'} ne $settings{'PASSWORD2'} ){
+       $errormessage = $Lang::tr{'passwords do not match'}
+    } else {
+       my @lines = `/usr/local/bin/ipcopbackup -keycat $settings{'PASSWORD'}`;
+       # If previous operation succeded and the key need to be crypted, redo operation with pipe to openssl
+       if (@lines && $settings{'PASSWORD1'}) {
+           @lines = `/usr/local/bin/ipcopbackup -keycat $settings{'PASSWORD'}|openssl enc -a -e -aes256 -salt -pass pass:$settings{'PASSWORD1'} `;
+       }
+        if (@lines) {
+           use bytes;
+           foreach (@lines) {$size += length($_)};
+           print "Pragma: no-cache\n";
+           print "Cache-control: no-cache\n";
+           print "Connection: close\n";
+           print "Content-type: application/octet-stream\n";
+           print "Content-Disposition: filename=backup.key\n";
+           print "Content-Length: $size\n\n";
+           print @lines;
+           exit (0);
+       } else {
+           $errormessage = $Lang::tr{'incorrect password'};
+       }
+    }  
+}
+#
+#  Import the key. Fail if key exists. This avoid creating fake backup.
+#
+if ($settings{'ACTION'} eq $Lang::tr{'backup import key'})  {
+    if (ref ($settings{'FH'}) ne 'Fh') {
+       $errormessage = $Lang::tr{'no cfg upload'};
+    } else {
+       if (copy ($settings{'FH'}, $tmpkeyfile) != 1) {
+           $errormessage = $Lang::tr{'save error'};
+       } else {
+           # if a password is given, decrypt the key received in $tmpkeyfile file with it.
+           # no error is produce if the password is wrong.
+           if ($settings{'PASSWORD1'}) {
+               my @lines = `openssl enc -a -d -aes256 -salt -pass pass:$settings{'PASSWORD1'} -in $tmpkeyfile`;
+               open(FILE,">$tmpkeyfile");
+               print FILE @lines;
+               close (FILE);
+           }
+           $errormessage = &get_bk_error(system ('/usr/local/bin/ipcopbackup -key import')>>8);
+       }
+    }
+}
+#
+#  Import the key. Fail if key exists. Key is extracted from a non-encrypted backup (pre 1.4.10)
+#
+if ($settings{'ACTION'} eq $Lang::tr{'backup extract key'})  {
+    if (ref ($settings{'FH'}) ne 'Fh') {
+       $errormessage = $Lang::tr{'no cfg upload'};
+    } else {
+       if (copy ($settings{'FH'}, '/tmp/tmptarfile.tgz') != 1) {
+           $errormessage = $Lang::tr{'save error'};
+       } else {
+           system( "tar -C /tmp -xzf /tmp/tmptarfile.tgz */backup/backup.key;\
+                   mv -f /tmp${General::swroot}/backup/backup.key $tmpkeyfile;\
+                   rm -rf /tmp${General::swroot};\
+                   rm /tmp/tmptarfile.tgz");
+           $errormessage = &get_bk_error(system ('/usr/local/bin/ipcopbackup -key import')>>8);
+       }
+    }
+}
+#
+#  Create the key. Cannot overwrite existing key to avoid difference with exported (saved) key
+#
+if ($settings{'ACTION'} eq $Lang::tr{'backup generate key'})  {
+    $errormessage = &get_bk_error(system('/usr/local/bin/ipcopbackup -key new')>>8);
+}
+
+my $cryptkeymissing = system ('/usr/local/bin/ipcopbackup -key exist')>>8;
+
+&Header::showhttpheaders();
+if ($cryptkeymissing) {  #If no key is present, force creation or import
+    &Header::openpage($Lang::tr{'backup configuration'}, 1, '');
+    &Header::openbigbox('100%', 'left', '', $errormessage);
+    if ($errormessage) {
+       &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
+       print "<font class='base'>$errormessage&nbsp;</font>";
+       &Header::closebox();
+    }
+    &Header::openbox('100%', 'left', $Lang::tr{'backup key'});
+    print <<END
+    <form method = 'post' enctype = 'multipart/form-data'>
+      <table>
+        <tr>
+         <td colspan='2'>
+         $Lang::tr{'backup explain key'}:
+         <ul>
+         <li>$Lang::tr{'backup explain key li1'}
+         <li>$Lang::tr{'backup explain key li2'}
+         <li>$Lang::tr{'backup explain key li3'}
+         </ul>
+          </td>
+       </tr><tr>
+         <td width='15%'></td><td width='20%'></td><td>
+         <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup generate key'}' />
+          </td>
+       </tr><tr>
+         <td align='right'>$Lang::tr{'backup key file'}:</td><td><input type = 'file' name = 'FH' size = '30' value='backup.key' />
+         </td><td>
+         <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup import key'}' />
+       </tr><tr>
+         <td align='right'>$Lang::tr{'backup protect key password'}:<td><input type = 'password' name='PASSWORD1' size='10' />
+          </td>
+       </tr><tr>
+         <td align='right'>$Lang::tr{'backup clear archive'}:</td><td><input type = 'file' name = 'FH' size = '30' value='your-ipcop.tar.gz' />
+         </td><td>
+         <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup extract key'}' />
+          </td>
+       </tr>
+      </table>
+      $Lang::tr{'notes'}:
+      <ul>
+         <li>$Lang::tr{'backup explain key no1'}
+         <li>$Lang::tr{'backup explain key no2'}
+      </ul>
+    </form>
+END
+;
+    &floppybox();
+    &Header::closebox();
+    &Header::closebigbox();
+    &Header::closepage();
+    exit (0);
+}
+
+##
+## Sets management (create/delete/import/restore)
+##
+
+erase_files ($setdir);                 #clean up
+
+#
+# create new archive set
+#
+if ($settings{'ACTION'} eq $Lang::tr{'create'}) {
+    $errormessage = &get_bk_error(system('/usr/local/bin/ipcopbkcfg > /dev/null')>>8);
+    &import_set (" ".&Header::cleanhtml ($settings{'COMMENT'})) if (!$errormessage);
+}
+#
+# delete a backup set
+#
+if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {
+    erase_files (&Header::cleanhtml ($settings{'KEY'}));       # remove files
+    rmdir($settings{'KEY'});           # remove directory
+}
+#
+# import an archive set
+#
+if ($settings{'ACTION'} eq $Lang::tr{'import'}) {
+    if (ref ($settings{'FH'}) ne 'Fh') {
+       $errormessage = $Lang::tr{'no cfg upload'};
+    } else {
+       if (!copy ($settings{'FH'}, "$setdir/$datafile")) {
+           $errormessage = $Lang::tr{'save error'};
+       } else {
+           &import_set ('&nbsp;(imported)');
+       }
+    }
+}
+#
+# restore an archive
+#
+if ($settings{'ACTION'} eq $Lang::tr{'restore'}) {
+    if ($settings{'AreYouSure'} eq 'yes') {
+       if (!$cryptkeymissing) {                        # if keyfile exists
+           if (-e "$settings{'KEY'}/$datafile"){       # encrypted dat is required
+               copy_files($settings{'KEY'}, $setdir);  # to working dir
+               $errormessage = get_rs_error(system("/usr/local/bin/ipcoprscfg" 
+                                       . ($settings{'RESTOREHW'} eq 'on' ? ' --hardware' : '') 
+                                       . ' >/dev/null')>>8);
+               if (!$errormessage) {
+                   # restored ok, recommend restarting system
+                   $warnmessage = $Lang::tr{'cfg restart'};
+               }
+               erase_files ($setdir);                  #clean up
+           } else {
+               $errormessage = $Lang::tr{'missing dat'}."$settings{'KEY'}/$datafile";
+           }
+       } else {  # if keyfile does not exist
+           $errormessage = $Lang::tr{'backup missing key'};
+       }
+    
+    } else {  # not AreYouSure=yes
+       &Header::openpage($Lang::tr{'backup configuration'}, 1, '');
+       &Header::openbigbox('100%', 'left');
+       &Header::openbox('100%', 'left', $Lang::tr{'are you sure'});
+       print <<END
+<form method = 'post'>
+  <input type = 'hidden' name = 'KEY' value ='$settings{'KEY'}' /> 
+  <input type = 'hidden' name = 'AreYouSure' value ='yes' />
+  <table align = 'center'>
+    <tr>
+      <td align = 'center'>
+       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'restore'}' />
+      </td><td>
+       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'cancel'}' />
+      </td>
+    </tr><tr>
+      <td>
+       $Lang::tr{'restore hardware settings'}: <input type = 'checkbox' name = 'RESTOREHW'>
+      </td>
+    </tr>
+</table>
+</form>
+END
+;
+       &Header::closebox();
+       &Header::closebigbox();
+       &Header::closepage();
+       exit (0);
+    }
+}
+##
+##  Media management
+##
+#
+# now build the list of removable device
+#
+
+# Read partitions sizes registered with the system
+my %partitions;
+foreach my $li (`/usr/local/bin/ipcopbackup -proc partitions`) {               # use suid helper...
+    # partitions{'sda1'} = 128M        if         /major minor  blocks name/
+    $partitions{$4} = &kmgt($3*1024,4) if ($li =~ /(\d+) +(\d+) +(\d+) +(.*)/);
+}
+
+# Search usb-storage scsi device
+my %medias;
+    
+foreach (`/usr/local/bin/ipcopbackup -glob '/proc/scsi/usb-storage*/*'`) {# use suid helper...
+    my $m;
+    foreach ( `cat $_` ) {     # list each line of information for the device:
+#      Host scsi0: usb-storage
+#      Vendor: SWISSBIT
+#      Product: Black Silver
+#      Serial Number: D0ED423A4F84A31E
+#      Protocol: Transparent SCSI
+#      Transport: Bulk
+#      GUID: 13706828d0ed423a4f84a31e
+#      Attached: Yes
+                                      
+       chomp;
+       my ($key,$val) = split(': ',$_,2);
+       $key =~ s/^ *//;        # remove front space
+
+       # convert 'scsi?' key to sda, sdb,... and use it as a %medias keyhash
+       if ($key =~ /Host scsi(.)/) {
+           $val = $m = 'sd' . chr(97+$1);
+           $key = 'Host';
+       }
+       $medias{$m}{$key} = $val;               # save data
+    }
+}
+
+#
+# Switch mounted media
+#
+if ($settings{'ACTION'} eq $Lang::tr{'mount'})
+{
+    # Find what is really mounted under backup. Can be local hard disk or any removable media
+    my $mounted = &findmounted();
+    #umount previous, even if same device already mouted.
+    system ("/usr/local/bin/ipcopbackup -U $mounted") if ($mounted ne $Lang::tr{'local hard disk'});
+    $errormessage = `/usr/local/bin/ipcopbackup -M $settings{'SELECT'}` if (grep (/$settings{'SELECT'}/,%partitions));
+}
+#
+# Compute a full description of device
+#
+my $mounted = &findmounted();
+my $media_des = $mounted;      # Description
+if ($mounted ne $Lang::tr{'local hard disk'}) {
+    $_ = $mounted;     # sda1 => sda
+    tr/0-9//d;
+    $media_des = "$medias{$_}{'Product'} ($media_des, $partitions{$mounted})";
+}
+&Header::openpage($Lang::tr{'backup configuration'}, 1, '');
+&Header::openbigbox('100%', 'left', '', $errormessage);
+
+if ($errormessage) {
+    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
+    print "<font class='base'>$errormessage&nbsp;</font>";
+    &Header::closebox();
+}
+
+$warnmessage = "<font color=${Header::colourred}><b>$Lang::tr{'capswarning'}</b></font>: $warnmessage <p>" if ($warnmessage);
+
+&Header::openbox('100%', 'left', $Lang::tr{'backup configuration'});
+
+#Divide the window in two : left and right
+print <<END
+    <table width = '100%' >
+    <tr>
+       <th width = '50%'>$Lang::tr{'current media'}:<font color=${Header::colourred}><b>$media_des</b></font></th>
+       <th width = '3%'></th>
+       <th>$Lang::tr{'choose media'}</th>
+    </tr>
+END
+;
+
+# Left part of window
+print <<END
+    <tr><td>
+    <ul>
+    <li>$Lang::tr{'backup sets'}:
+    <table width = '80%' border='0'>
+    <tr>
+       <th  class = 'boldbase' align = 'center'>$Lang::tr{'name'}</th>
+       <th  class = 'boldbase' align = 'center' colspan = '3'>$Lang::tr{'action'}</th>
+    </tr>
+END
+;
+
+# get list of available sets by globbing directories under $setdir
+# External device (usk key) are mounted in $setdir. -R permits finding sets in hierarchy.
+my $i = 0;
+foreach my $set (`ls -Rt1 $setdir`) {
+    chop ($set);       #remove ':' & newline from line
+    chop ($set);
+    if (-d $set && ($set =~ m!/.+/\d{8}_\d{6}! ) ) { # filter out things not sets !
+       if ($i++ % 2) {
+           print "<tr bgcolor = '$Header::table2colour'>";
+       } else {
+           print "<tr bgcolor = '$Header::table1colour'>";
+       }
+       my $settime = read_timefile( "$set/$datefile", "$set/$datafile" );
+       my $name = substr ($set,length($setdir)+1);
+       print<<EOF
+<td>
+    $settime
+</td>
+
+<td align = 'center'>
+<form method = 'post'>
+<input type = 'hidden' name = 'ACTION' value ='$Lang::tr{'restore'}' />
+<input type = 'image'  name = '$Lang::tr{'restore'}' src = '/images/reload.gif' alt = '$Lang::tr{'restore'}' title = '$Lang::tr{'restore'}' />
+<input type = 'hidden' name = 'KEY' value = '$set' />
+</form>
+</td>
+
+<td align = 'center'>
+<a href = '/backup/$name/$datafile'><img src = '/images/floppy.gif' title = '$Lang::tr{'export'}'></a>
+</td>
+
+<td align = 'center'>
+<form method = 'post'>
+<input type = 'hidden' name = 'ACTION' value = '$Lang::tr{'remove'}' />
+<input type = 'image'  name = '$Lang::tr{'remove'}' src = '/images/delete.gif' alt = '$Lang::tr{'remove'}' title = '$Lang::tr{'remove'}' border = '0' />
+<input type = 'hidden' name = 'KEY' value = '$set' />
+</form>
+</td>
+</tr>
+EOF
+;
+    }
+}
+print "</table>" . ($i ? "<br>" : "$Lang::tr{'empty'}!<hr /><br>");
+print <<EOF
+$warnmessage
+<form method = 'post'>
+       <li>$Lang::tr{'backup configuration'}<br>
+       $Lang::tr{'description'}:<input type = 'text' name = 'COMMENT' size='30' />
+       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'create'}' />
+</form><p>
+<form method = 'post' enctype = 'multipart/form-data'>
+       <li>$Lang::tr{'backup import dat file'}:<br>
+       <input type = 'file' name = 'FH' size = '20' />
+       <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'import'}' />
+</form>
+</ul>
+EOF
+;
+
+print "</td><td></td><td valign='top'>";  # Start right part (devices selection)
+print $Lang::tr{'backup media info'};
+
+print "<form method = 'post'>";
+print "<table width = '100%'><tr><td>";
+my $nodev = 1;             # nothing present
+foreach my $media (keys %medias) {
+    if ( $medias{$media}{'Attached'} eq 'Yes') {       # device is attached to USB bus ?
+       $nodev = 0;             # at least one device present
+       my $checked = $medias{$media}{'Host'} eq $mounted ? "checked='checked'" : '';
+       print "<input type='radio' name = 'SELECT' value = '$medias{$media}{'Host'}' $checked />";
+       print "<b>$medias{$media}{'Product'}</b><br>";
+       # list attached partitions to this media
+       foreach my $part (sort (keys (%partitions))) {
+           if ($part =~ /$medias{$media}{'Host'}./) {
+               my $checked = $part eq $mounted ? "checked='checked'" : '';
+               print "&nbsp;&nbsp;&nbsp;<input type='radio' name = 'SELECT' value = '$part' $checked />$part ($partitions{$part})<br>";
+           }
+       }
+    }
+}
+if ($nodev) {
+    print "<br>$Lang::tr{'insert removable device'}";
+    print "</td><td>";
+    print "<br><input type = 'submit' name = 'ACTION' value = '$Lang::tr{'done'}' />";
+} else {
+    #Add an entry for the local disk
+    my $checked =  $Lang::tr{'local hard disk'} eq $mounted ? "checked='checked'" : '';
+    print "<input type = 'radio' name = 'SELECT' value = '$Lang::tr{'local hard disk'}' $checked />";
+    print "<b>$Lang::tr{'local hard disk'}</b>";
+    print "</td><td>";
+    print "<br><input type = 'submit' name = 'ACTION' value = '$Lang::tr{'mount'}' />";
+}
+print "</tr></table>";
+print "</form>";
+#
+#Backup key
+#
+print<<EOF
+    <hr />
+<form method='post'>
+    <b>$Lang::tr{'backup key'}</b><br>
+    $Lang::tr{'backup key info'}<br>
+    <table><tr>
+    <td align= 'right'>$Lang::tr{'root user password'}:
+    <td align='left'><input type = 'password' name='PASSWORD' />
+    <input type = 'submit' name = 'ACTION' value = '$Lang::tr{'backup export key'}' />
+    </tr><tr>
+    <td align='right'>$Lang::tr{'backup protect key password'}:
+    <td align='left'><input type = 'password' name='PASSWORD1' size='10' />
+    </tr><tr>
+    <td align='right'>$Lang::tr{'again'}
+    <td align='left'><input type = 'password' name='PASSWORD2'  size='10'/>
+    </tr></table>
+</form>
+
+EOF
+;
+# End of right table
+print "</td></tr></table>";
+
+&floppybox();
+
+&Header::closebox();
+&Header::closebigbox();
+&Header::closepage();
+
+sub floppybox {
+    print <<END
+<hr />
+<form method = 'post'>
+<table width='100%'>
+<tr>
+    <td>
+         <b>$Lang::tr{'backup to floppy'}</b>
+    </td>
+</tr>
+<tr>
+    <td width='50%'>
+       $Lang::tr{'insert floppy'}
+    </td>
+    <td align='center'> 
+       <input type='submit' name='ACTION' value='$Lang::tr{'backup to floppy'}' />
+    </td> 
+</tr>
+</table>
+</form>
+END
+;
+    print   "<b>$Lang::tr{'alt information'}</b><pre>" .
+           `/usr/local/bin/ipcopbackup -savecfg floppy` .
+           '&nbsp;</pre>' if ($settings{'ACTION'} eq $Lang::tr{'backup to floppy'} );
+}
+
+# Return device name of what is mounted under 'backup'
+sub findmounted() {
+    my $mounted = `mount|grep ' /home/httpd/html/backup '`;
+    if ($mounted) {                            # extract device name
+        $mounted =~ m!^/dev/(.*) on!;          # device on mountmoint options
+        return $1; 
+    } else {                                   # it's the normal subdir
+        return $Lang::tr{'local hard disk'};
+    }
+}
+# read and return a date/time string from a time file
+sub read_timefile() {
+    my $fname = shift;   # name of file to read from
+    my $fname2 = shift;  # if first file doesn't exist, get date of this file
+
+    my $dt;
+    if (defined(open(FH, "<$fname"))) {
+       $dt = <FH>;
+       chomp $dt;
+       close(FH);
+    } else {
+       $dt = &get_fdate($fname2);    # get file date/time
+       write_timefile($fname, $dt); # write to expected time file
+    }
+    return $dt;
+}
+# write a date/time string to a time file
+sub write_timefile() {
+    my $fname = shift; # name of file to write to
+    my $dt = shift;    # date/time string to write
+
+    if (open(FH, ">$fname")) {
+      print FH "$dt\n";
+      close(FH);
+    }  
+}
+# move a dat file without time stamp to subdir
+sub import_set() {
+    my $dt = get_fdate("$setdir/$datafile") . shift;
+    &write_timefile("$setdir/$datefile", $dt);
+
+    # create set directory
+    my $setname = "$setdir/" . get_ddate("$setdir/$datafile");
+    mkdir($setname);
+
+    # move files to the new set directory
+    copy_files($setdir, $setname);
+    erase_files ($setdir);
+}
+
+# get date/time string from file
+sub get_fdate() {
+    my $fname = shift;
+    open(DT, "/bin/date -r $fname|");
+    my $dt = <DT>;
+    close(DT);
+    chomp $dt;
+    $dt =~ s/\s+/ /g;  # remove duplicate spaces
+    return $dt;
+}
+# get date/time string from file for use as directory name
+sub get_ddate() {
+    my $fname = shift;
+    open(DT, "/bin/date -r $fname +%Y%m%d_%H%M%S|");
+    my $dt = <DT>;
+    close(DT);
+    chomp $dt;
+    return $dt;
+}
+# copy archive files from source directory to destination directory
+sub copy_files() {
+    my $src_dir = shift;
+    my $dest_dir = shift;
+    map (copy ("$src_dir/$_", "$dest_dir/$_"),  ($datafile, $datefile) );
+}
+# erase set files
+sub erase_files() {
+    my $src_dir = shift;
+    map (unlink ("$src_dir/$_"),  ($datafile, $datefile));
+}
+# get backup error text
+sub get_bk_error() {
+    my $exit_code = shift || return '';
+    if ($exit_code == 0) {
+       return '';
+    } elsif ($exit_code == 2) {
+       return $Lang::tr{'err bk 2 key'};
+    } elsif ($exit_code == 3) {
+       return $Lang::tr{'err bk 3 tar'};
+    } elsif ($exit_code == 4) {
+       return $Lang::tr{'err bk 4 gz'};
+    } elsif ($exit_code == 5) {
+       return $Lang::tr{'err bk 5 encrypt'};
+    } else {
+       return $Lang::tr{'err bk 1'};
+    }
+}
+# show any restore errors
+sub get_rs_error() {
+    
+    my $exit_code = shift || return '';
+    if ($exit_code == 0) {
+       return '';
+    } elsif ($exit_code == 6) {
+       return $Lang::tr{'err rs 6 decrypt'};
+    } elsif ($exit_code == 7) {
+       return $Lang::tr{'err rs 7 untartst'};
+    } elsif ($exit_code == 8) {
+       return $Lang::tr{'err rs 8 untar'};
+    } elsif ($exit_code == 9) {
+       return $Lang::tr{'missing dat'};
+    } else {
+       return $Lang::tr{'err rs 1'}."($exit_code)";
+    }
+}
+sub kmgt {
+    my ($value,$length,$opt_U) = @_;
+    if      ( $value > 10**( $length + 8 ) or $opt_U eq 'T' ) {
+       return sprintf( "%d%s", int( ( $value / 1024**4 ) + .5 ), 'T' );
+    } elsif ( $value > 10**( $length + 5 ) or $opt_U eq 'G' ) {
+       return sprintf( "%d%s", int( ( $value / 1024**3 ) + .5 ), 'G' );
+    } elsif ( $value > 10**( $length + 2 ) or $opt_U eq 'M' ) {
+       return sprintf( "%d%s", int( ( $value / 1024**2 ) + .5 ), 'M' );
+    } elsif ( $value > 10**($length) or $opt_U eq 'K' ) {
+       return sprintf( "%d%s", int( ( $value / 1024 ) + .5 ), 'K' );
+    } else {
+       return $value;
+    }
+}
+
+1;
index cc11800..b98e991 100644 (file)
-#!/usr/bin/perl\r
-#\r
-# IPCop CGI's - base.cgi\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) place a name here\r
-#\r
-# $Id: base.cgi,v 1.1.2.10 2005/11/03 19:20:50 franck78 Exp $\r
-#\r
-#\r
-\r
-\r
-# This file is a starting base for writting a new GUI screen using the three box model\r
-#      Box 1 : global settings for the application\r
-#      Box 2 : line editor for multiple data line\r
-#      Box 3 : the list of data line, with edit/remove buttons\r
-#\r
-#      This example do the following\r
-#      Read global settings:\r
-#              a NAME and an interface (IT)\r
-#      Lines of data composed of:\r
-#              an ipaddress (IP), an enabled/disabled options (CB), a comment (CO)\r
-#\r
-#\r
-# All you need to do is\r
-#      replace 'XY' with your app name\r
-#      define your global $settings{'var name'}\r
-#      define your strings\r
-#      write validation code for Settings1 and Settings2\r
-#      write HTML box Settings1 and Settings2\r
-#      adapt the sort function\r
-#      write the correct configuration file\r
-#\r
-#\r
-# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines\r
-# use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work\r
-# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help\r
-#use warnings;\r
-use strict;\r
-#use Carp ();\r
-#local $SIG{__WARN__} = \&Carp::cluck;\r
-\r
-require '/var/ipcop/general-functions.pl';     # Replace all occurences of </var/ipcop> with CONFIG_ROOT\r
-                                               # before updating cvs IPCop file.\r
-require "${General::swroot}/lang.pl";\r
-require "${General::swroot}/header.pl";\r
-\r
-# Files used\r
-our $setting  = "${General::swroot}/XY/settings";              # particular settings\r
-my  $datafile = "${General::swroot}/XY/data";                  # repeted settings (multilines)\r
-our $conffile = "${General::swroot}/XY/XY.conf";               # Config file for application XY\r
-\r
-# strings to add to languages databases or in addon language file\r
-$Lang::tr{'XY title'}     = 'XY service';\r
-$Lang::tr{'XY settings'}  = 'XY setup';\r
-$Lang::tr{'XY add data'}  = 'add data';\r
-$Lang::tr{'XY edit data'} = 'edit data';\r
-$Lang::tr{'XY data'}      = 'XY data';\r
-\r
-# informationnal & log strings, no translation required\r
-my  $msg_added           = 'XY added';\r
-my  $msg_modified        = 'XY modified';\r
-my  $msg_deleted         = 'XY removed';\r
-my  $msg_datafileerror   = 'XY data file error';\r
-our $msg_configfileerror = 'XY configuration file error';\r
-\r
-my %settings=();\r
-\r
-# Settings1\r
-$settings{'NAME'} = '';                # a string field than must be 'GOOD' or 'good'\r
-$settings{'IT'} = '';          # a 'choose' field for color interface\r
-$settings{'TURBO'} = 'off';    # a checkbox field to enable something\r
-\r
-# Settings2 for editing the multi-line list\r
-# Must not be saved by writehash !\r
-$settings{'IP'} = '';                  # datalines are: IPaddress,enable,comment \r
-$settings{'CB'} = 'off';               # Every check box must be set to off\r
-$settings{'COMMENT'} = '';\r
-my @nosaved=('IP','CB','COMMENT');        # List here ALL setting2 fields. Mandatory\r
-\r
-$settings{'ACTION'} = '';              # add/edit/remove....\r
-$settings{'KEY1'} = '';                        # point record for ACTION\r
-\r
-# Define each field that can be used to sort columns\r
-my $sortstring='^IP|^COMMENT';\r
-my $errormessage = '';\r
-my $warnmessage = '';\r
-\r
-&Header::showhttpheaders();\r
-\r
-# Read needed Ipcop settings (exemple)\r
-my %mainsettings=();\r
-&General::readhash("${General::swroot}/main/settings", \%mainsettings);\r
-\r
-# Get GUI values\r
-&Header::getcgihash(\%settings);\r
-\r
-# Load multiline data. Do it before use in save action\r
-our $f = new Multilines (filename => $datafile,\r
-                        fields   => ['IP','CB','COMMENT'],\r
-                        comment  => 1\r
-                       );\r
-\r
-##\r
-## SAVE Settings1 \r
-##\r
-# Remove if no Settings1 needed\r
-if ($settings{'ACTION'} eq $Lang::tr{'save'}) {\r
-\r
-    #\r
-    #Validate static Settings1 here\r
-    #\r
-    if (($settings{"NAME"} ne "GOOD") &&\r
-       ($settings{"NAME"} ne "good"))    {\r
-       $errormessage = 'Enter good or GOOD in Name field';\r
-    }\r
-\r
-    unless ($errormessage) {                                   # Everything is ok, save settings\r
-       map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved\r
-       &General::writehash($setting, \%settings);              # Save good settings\r
-       $settings{'ACTION'} = $Lang::tr{'save'};                # Recreate  'ACTION'\r
-       map ($settings{$_}= '',(@nosaved,'KEY1'));              # and reinit var to empty\r
-\r
-       # Rebuild configuration file if needed\r
-       &BuildConfiguration;\r
-    }\r
-\r
-    ERROR:                                             # Leave the faulty field untouched\r
-} else {\r
-    &General::readhash($setting, \%settings);                  # Get saved settings and reset to good if needed\r
-}\r
-\r
-##\r
-## Now manipulate the multiline list with Settings2\r
-##\r
-\r
-# Basic actions are:\r
-#      toggle the check box\r
-#      add/update a new line\r
-#      begin editing a line\r
-#      remove a line\r
-# $KEY1 contains the index of the line manipulated\r
-\r
-##\r
-## Toggle CB field.\r
-##\r
-if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {\r
-\r
-    $f->togglebyfields($settings{'KEY1'},'CB');                # toggle checkbox\r
-    $settings{'KEY1'} = '';                            # End edit mode\r
-\r
-    &General::log($msg_modified);\r
-\r
-    # save changes\r
-    $f->savedata || die "$msg_datafileerror";\r
-\r
-    # Rebuild configuration file\r
-    &BuildConfiguration;\r
-}\r
-\r
-##\r
-## ADD/UPDATE a line of configuration from Settings2\r
-##\r
-if ($settings{'ACTION'} eq $Lang::tr{'add'}) {\r
-    # Validate inputs\r
-    if (! &General::validip($settings{'IP'})) {$errormessage = "Specify an IP value !"};\r
-    if (! $settings{'COMMENT'} ) {$warnmessage = "no comment specified"};\r
-\r
-    unless ($errormessage) {\r
-       if ($settings{'KEY1'} eq '') { #add or edit ?\r
-           # insert new data line\r
-           $f->writedata(-1, $settings{'IP'},$settings{'CB'},$settings{'COMMENT'});\r
-           &General::log($msg_added);\r
-       } else {\r
-           # modify data line\r
-           $f->writedata($settings{'KEY1'}, $settings{'IP'},$settings{'CB'},$settings{'COMMENT'});\r
-           $settings{'KEY1'} = '';       # End edit mode\r
-           &General::log($msg_modified);\r
-       }\r
-       # save changes\r
-       $f->savedata || die "$msg_datafileerror";\r
-\r
-       # Rebuild configuration file\r
-       &BuildConfiguration;\r
-\r
-       # if entering data line is a repetitive task, choose here to not erase fields between each addition\r
-       map ($settings{$_}='' ,@nosaved);\r
-    }\r
-}\r
-\r
-##\r
-## begin EDIT: move data fields to Settings2 controls\r
-##\r
-if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {\r
-    $f->readdata ($settings{'KEY1'},\r
-                 $settings{'IP'},\r
-                 $settings{'CB'},\r
-                 $settings{'COMMENT'});\r
-}\r
-##\r
-## REMOVE: remove selected line\r
-##\r
-if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {\r
-    $f->deleteline ($settings{'KEY1'});\r
-    $settings{'KEY1'} = '';                            # End remove mode\r
-    &General::log($msg_deleted);\r
-\r
-    # save changes\r
-    $f->savedata || die "$msg_datafileerror";\r
-\r
-    # Rebuild configuration file\r
-    &BuildConfiguration;\r
-}\r
-\r
-\r
-##\r
-## Check if sorting is asked\r
-##\r
-if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {\r
-    my $newsort=$ENV{'QUERY_STRING'};\r
-    my $actual=$settings{'SORT_XY'};\r
-\r
-    # Reverse actual sort or choose new column ?\r
-    if ($actual =~ $newsort) {\r
-       $f->setsortorder ($newsort ,rindex($actual,'Rev'));\r
-       $newsort .= rindex($actual,'Rev')==-1 ? 'Rev' : '';\r
-    } else {\r
-       $f->setsortorder ($newsort ,1);\r
-    }\r
-    $f->savedata;                                              # Synchronise file & display\r
-    $settings{'SORT_XY'} = $newsort;\r
-    map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));  # Must never be saved\r
-    &General::writehash($setting, \%settings);\r
-    $settings{'ACTION'} = 'SORT';                              # Recreate an 'ACTION'\r
-    map ($settings{$_}= '',(@nosaved,,'KEY1'));                        # and reinit var to empty\r
-}\r
-\r
-##\r
-## Remove if no Setting1 needed\r
-##\r
-if ($settings{'ACTION'} eq '' ) { # First launch from GUI\r
-    # Place here default value when nothing is initialized\r
-\r
-}\r
-\r
-&Header::openpage($Lang::tr{'XY title'}, 1, '');\r
-&Header::openbigbox('100%', 'left', '', $errormessage);\r
-my %checked =();     # Checkbox manipulations\r
-\r
-if ($errormessage) {\r
-    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
-    print "<font class='base'>$errormessage&nbsp;</font>";\r
-    &Header::closebox();\r
-}\r
-\r
-##\r
-## First box Settings1. Remove if not needed\r
-##\r
-$warnmessage = "<font color=${Header::colourred}><b>$Lang::tr{'capswarning'}</b></font>: $warnmessage" if ($warnmessage);\r
-\r
-&Header::openbox('100%', 'left', $Lang::tr{'XY settings'});\r
-print "<form method='post' action='$ENV{'SCRIPT_NAME'}'>";\r
-$checked{'IT'}{'RED'} = '';\r
-$checked{'IT'}{'GREEN'} = '';\r
-$checked{'IT'}{'ORANGE'} = '';\r
-$checked{'IT'}{'BLUE'} = '';\r
-$checked{'IT'}{$settings{'IT'}} = "checked='checked'";\r
-$checked{'TURBO'} = ($settings{'TURBO'} eq 'on') ? "checked='checked'" : '';\r
-\r
-print<<END\r
-<table width='100%'>\r
-<tr>\r
-    <td class='base'>Name:</td>\r
-    <td><input type='text' name='NAME' value='$settings{'NAME'}' /></td>\r
-    <td align='right'>INTERFACE</td>\r
-    <td align='right'>red<input type='radio' name='IT' value='RED' $checked{'IT'}{'RED'} /></td>\r
-</tr><tr>\r
-    <td>Turbo:</td>\r
-    <td><input type='checkbox' name='TURBO' $checked{'TURBO'}' /></td>\r
-    <td></td>\r
-    <td align='right'>green<input type='radio' name='IT' value='GREEN' $checked{'IT'}{'GREEN'} /></td>\r
-</tr><tr>\r
-    <td></td>\r
-    <td></td>\r
-    <td></td>\r
-    <td align='right'>blue<input type='radio' name='IT' value='BLUE' $checked{'IT'}{'BLUE'} /></td>\r
-</tr><tr>\r
-    <td></td>\r
-    <td></td>\r
-    <td></td>\r
-    <td align='right'>orange<input type='radio' name='IT' value='ORANGE' $checked{'IT'}{'ORANGE'} /></td>\r
-</tr>\r
-</table>\r
-<br />\r
-END\r
-;\r
-\r
-print<<END\r
-<table width='100%'>\r
-<hr />\r
-<tr>\r
-    <td class='base' width='25%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>\r
-    <td class='base' width='25%'>$warnmessage</td>\r
-    <td width='50%' align='center'><input type='submit' name='ACTION' value='$Lang::tr{'save'}' /></td>\r
-</tr>\r
-</table>\r
-</form>\r
-END\r
-;\r
-&Header::closebox();   # end of Settings1\r
-\r
-##\r
-## Second box is for editing the an item of the list\r
-##\r
-$checked{'CB'} = ($settings{'CB'} eq 'on') ? "checked='checked'" : '';\r
-\r
-my $buttontext = $Lang::tr{'add'};\r
-if ($settings{'KEY1'} ne '') {\r
-    $buttontext = $Lang::tr{'update'};\r
-    &Header::openbox('100%', 'left', $Lang::tr{'XY edit data'});\r
-} else {\r
-    &Header::openbox('100%', 'left', $Lang::tr{'XY add data'});\r
-}\r
-\r
-# Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'\r
-print <<END\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />\r
-<table width='100%'>\r
-<tr>\r
-    <td class='base'>$Lang::tr{'ip address'}:</td>\r
-    <td><input type='text' name='IP' value='$settings{'IP'}' /></td>\r
-    <td class='base'>$Lang::tr{'enabled'}</td>\r
-    <td><input type='checkbox' name='CB' $checked{'CB'} /></td>\r
-    <td class='base'>$Lang::tr{'remark'}:&nbsp;<img src='/blob.gif' alt='*' /></td>\r
-    <td><input type 'text' name='COMMENT' value='$settings{'COMMENT'}' /></td>\r
-</tr>\r
-</table>\r
-<hr />\r
-<table width='100%'>\r
-<tr>\r
-    <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>\r
-    <td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>\r
-</tr>\r
-</table>\r
-</form>\r
-END\r
-;\r
-&Header::closebox();\r
-\r
-##\r
-## Third box shows the list\r
-##\r
-\r
-# Columns headers may be a sort link. In this case it must be named in $sortstring\r
-&Header::openbox('100%', 'left', $Lang::tr{'XY data'});\r
-print <<END\r
-<table width='100%'>\r
-<tr>\r
-    <td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'ip address'}</b></a></td>\r
-    <td width='70%' align='center'><a href='$ENV{'SCRIPT_NAME'}?COMMENT'><b>$Lang::tr{'remark'}</b></a></td>\r
-    <td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>\r
-</tr>\r
-END\r
-;\r
-\r
-##\r
-## Print each line of @current list\r
-##\r
-my $key = 0;\r
-$f->readreset; # beginning of data\r
-for ($key=0; $key<$f->getnumberofline; $key++) {\r
-\r
-    my($cb,$comment,$ip) = $f->readbyfieldsseq($key,'CB','COMMENT','IP');\r
-\r
-    #Choose icon for checkbox\r
-    my $gif = '';\r
-    my $gdesc = '';\r
-    if ($cb eq "on") {\r
-       $gif = 'on.gif';\r
-       $gdesc = $Lang::tr{'click to disable'};\r
-    } else {\r
-       $gif = 'off.gif';\r
-       $gdesc = $Lang::tr{'click to enable'};\r
-    }\r
-\r
-    #Colorize each line\r
-    if ($settings{'KEY1'} eq $key) {\r
-       print "<tr bgcolor='${Header::colouryellow}'>";\r
-    } elsif ($key % 2) {\r
-       print "<tr bgcolor='${Header::table2colour}'>";\r
-    } else {\r
-       print "<tr bgcolor='${Header::table1colour}'>"; \r
-    }\r
-\r
-    print <<END\r
-<td align='center'>$ip</td>\r
-<td align='center'>$comment</td>\r
-\r
-<td align='center'>\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />\r
-<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />\r
-<input type='hidden' name='KEY1' value='$key' />\r
-</form>\r
-</td>\r
-\r
-<td align='center'>\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />\r
-<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />\r
-<input type='hidden' name='KEY1' value='$key' />\r
-</form>\r
-</td>\r
-\r
-<td align='center'>\r
-<form method='post' action='$ENV{'SCRIPT_NAME'}'>\r
-<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />\r
-<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />\r
-<input type='hidden' name='KEY1' value='$key' />\r
-</form>\r
-</td>\r
-</tr>\r
-END\r
-;\r
-} print "</table>";\r
-\r
-# If table contains entries, print 'Key to action icons'\r
-if ($key) {\r
-print <<END\r
-<table>\r
-<tr>\r
-    <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>\r
-    <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>\r
-    <td class='base'>$Lang::tr{'click to disable'}</td>\r
-    <td>&nbsp;&nbsp;</td>\r
-    <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>\r
-    <td class='base'>$Lang::tr{'click to enable'}</td>\r
-    <td>&nbsp;&nbsp;</td>\r
-    <td><img src='/images/edit.gif' alt='$Lang::tr{'edit'}' /></td>\r
-    <td class='base'>$Lang::tr{'edit'}</td>\r
-    <td>&nbsp;&nbsp;</td>\r
-    <td><img src='/images/delete.gif' alt='$Lang::tr{'remove'}' /></td>\r
-    <td class='base'>$Lang::tr{'remove'}</td>\r
-</tr>\r
-</table>\r
-END\r
-;\r
-}\r
-\r
-&Header::closebox();\r
-&Header::closebigbox();\r
-&Header::closepage();\r
-\r
-## Ouf it's the end !\r
-\r
-##\r
-## Build the configuration file for application XY\r
-##\r
-sub BuildConfiguration {\r
-    open(FILE, ">/$conffile") or die "$msg_configfileerror";\r
-    flock(FILE, 2);\r
-\r
-    #Global settings\r
-    print FILE "#\n#  Configuration file for application XY\n#\n\n";\r
-    print FILE "#     do not edit manually\n";\r
-    print FILE "#     build for Ipcop:$mainsettings{'HOSTNAME'}\n\n\n";\r
-    print FILE "service=$settings{'NAME'}\n";\r
-    print FILE "activate-turbo\n" if $settings{'TURBO'} eq 'on';\r
-    print FILE "interface=$settings{'IT'}\n\n\n";\r
-    #write data line\r
-    {\r
-       my ($IP,$CB,$COMMENT);\r
-       $f->readreset;\r
-       while (defined ($f->readdataseq($IP,$CB,$COMMENT))) {\r
-           if ($CB eq "on") {\r
-               print FILE "$IP\t\t\t\t\t#$COMMENT\n";\r
-           } else {\r
-               print FILE "#DISABLED $IP\t\t\t\t#$COMMENT\n";\r
-           }\r
-       }\r
-    }\r
-    close FILE;\r
-\r
-    # Restart service\r
-    #system '/usr/local/bin/restartyourhelper';\r
-}\r
+#!/usr/bin/perl
+#
+# IPCop CGI's - base.cgi
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) place a name here
+#
+# $Id: base.cgi,v 1.1.2.10 2005/11/03 19:20:50 franck78 Exp $
+#
+#
+
+
+# This file is a starting base for writting a new GUI screen using the three box model
+#      Box 1 : global settings for the application
+#      Box 2 : line editor for multiple data line
+#      Box 3 : the list of data line, with edit/remove buttons
+#
+#      This example do the following
+#      Read global settings:
+#              a NAME and an interface (IT)
+#      Lines of data composed of:
+#              an ipaddress (IP), an enabled/disabled options (CB), a comment (CO)
+#
+#
+# All you need to do is
+#      replace 'XY' with your app name
+#      define your global $settings{'var name'}
+#      define your strings
+#      write validation code for Settings1 and Settings2
+#      write HTML box Settings1 and Settings2
+#      adapt the sort function
+#      write the correct configuration file
+#
+#
+# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines
+# use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work
+# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help
+#use warnings;
+use strict;
+#use Carp ();
+#local $SIG{__WARN__} = \&Carp::cluck;
+
+require '/var/ipcop/general-functions.pl';     # Replace all occurences of </var/ipcop> with CONFIG_ROOT
+                                               # before updating cvs IPCop file.
+require "${General::swroot}/lang.pl";
+require "${General::swroot}/header.pl";
+
+# Files used
+our $setting  = "${General::swroot}/XY/settings";              # particular settings
+my  $datafile = "${General::swroot}/XY/data";                  # repeted settings (multilines)
+our $conffile = "${General::swroot}/XY/XY.conf";               # Config file for application XY
+
+# strings to add to languages databases or in addon language file
+$Lang::tr{'XY title'}     = 'XY service';
+$Lang::tr{'XY settings'}  = 'XY setup';
+$Lang::tr{'XY add data'}  = 'add data';
+$Lang::tr{'XY edit data'} = 'edit data';
+$Lang::tr{'XY data'}      = 'XY data';
+
+# informationnal & log strings, no translation required
+my  $msg_added           = 'XY added';
+my  $msg_modified        = 'XY modified';
+my  $msg_deleted         = 'XY removed';
+my  $msg_datafileerror   = 'XY data file error';
+our $msg_configfileerror = 'XY configuration file error';
+
+my %settings=();
+
+# Settings1
+$settings{'NAME'} = '';                # a string field than must be 'GOOD' or 'good'
+$settings{'IT'} = '';          # a 'choose' field for color interface
+$settings{'TURBO'} = 'off';    # a checkbox field to enable something
+
+# Settings2 for editing the multi-line list
+# Must not be saved by writehash !
+$settings{'IP'} = '';                  # datalines are: IPaddress,enable,comment 
+$settings{'CB'} = 'off';               # Every check box must be set to off
+$settings{'COMMENT'} = '';
+my @nosaved=('IP','CB','COMMENT');        # List here ALL setting2 fields. Mandatory
+
+$settings{'ACTION'} = '';              # add/edit/remove....
+$settings{'KEY1'} = '';                        # point record for ACTION
+
+# Define each field that can be used to sort columns
+my $sortstring='^IP|^COMMENT';
+my $errormessage = '';
+my $warnmessage = '';
+
+&Header::showhttpheaders();
+
+# Read needed Ipcop settings (exemple)
+my %mainsettings=();
+&General::readhash("${General::swroot}/main/settings", \%mainsettings);
+
+# Get GUI values
+&Header::getcgihash(\%settings);
+
+# Load multiline data. Do it before use in save action
+our $f = new Multilines (filename => $datafile,
+                        fields   => ['IP','CB','COMMENT'],
+                        comment  => 1
+                       );
+
+##
+## SAVE Settings1 
+##
+# Remove if no Settings1 needed
+if ($settings{'ACTION'} eq $Lang::tr{'save'}) {
+
+    #
+    #Validate static Settings1 here
+    #
+    if (($settings{"NAME"} ne "GOOD") &&
+       ($settings{"NAME"} ne "good"))    {
+       $errormessage = 'Enter good or GOOD in Name field';
+    }
+
+    unless ($errormessage) {                                   # Everything is ok, save settings
+       map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));# Must never be saved
+       &General::writehash($setting, \%settings);              # Save good settings
+       $settings{'ACTION'} = $Lang::tr{'save'};                # Recreate  'ACTION'
+       map ($settings{$_}= '',(@nosaved,'KEY1'));              # and reinit var to empty
+
+       # Rebuild configuration file if needed
+       &BuildConfiguration;
+    }
+
+    ERROR:                                             # Leave the faulty field untouched
+} else {
+    &General::readhash($setting, \%settings);                  # Get saved settings and reset to good if needed
+}
+
+##
+## Now manipulate the multiline list with Settings2
+##
+
+# Basic actions are:
+#      toggle the check box
+#      add/update a new line
+#      begin editing a line
+#      remove a line
+# $KEY1 contains the index of the line manipulated
+
+##
+## Toggle CB field.
+##
+if ($settings{'ACTION'} eq $Lang::tr{'toggle enable disable'}) {
+
+    $f->togglebyfields($settings{'KEY1'},'CB');                # toggle checkbox
+    $settings{'KEY1'} = '';                            # End edit mode
+
+    &General::log($msg_modified);
+
+    # save changes
+    $f->savedata || die "$msg_datafileerror";
+
+    # Rebuild configuration file
+    &BuildConfiguration;
+}
+
+##
+## ADD/UPDATE a line of configuration from Settings2
+##
+if ($settings{'ACTION'} eq $Lang::tr{'add'}) {
+    # Validate inputs
+    if (! &General::validip($settings{'IP'})) {$errormessage = "Specify an IP value !"};
+    if (! $settings{'COMMENT'} ) {$warnmessage = "no comment specified"};
+
+    unless ($errormessage) {
+       if ($settings{'KEY1'} eq '') { #add or edit ?
+           # insert new data line
+           $f->writedata(-1, $settings{'IP'},$settings{'CB'},$settings{'COMMENT'});
+           &General::log($msg_added);
+       } else {
+           # modify data line
+           $f->writedata($settings{'KEY1'}, $settings{'IP'},$settings{'CB'},$settings{'COMMENT'});
+           $settings{'KEY1'} = '';       # End edit mode
+           &General::log($msg_modified);
+       }
+       # save changes
+       $f->savedata || die "$msg_datafileerror";
+
+       # Rebuild configuration file
+       &BuildConfiguration;
+
+       # if entering data line is a repetitive task, choose here to not erase fields between each addition
+       map ($settings{$_}='' ,@nosaved);
+    }
+}
+
+##
+## begin EDIT: move data fields to Settings2 controls
+##
+if ($settings{'ACTION'} eq $Lang::tr{'edit'}) {
+    $f->readdata ($settings{'KEY1'},
+                 $settings{'IP'},
+                 $settings{'CB'},
+                 $settings{'COMMENT'});
+}
+##
+## REMOVE: remove selected line
+##
+if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {
+    $f->deleteline ($settings{'KEY1'});
+    $settings{'KEY1'} = '';                            # End remove mode
+    &General::log($msg_deleted);
+
+    # save changes
+    $f->savedata || die "$msg_datafileerror";
+
+    # Rebuild configuration file
+    &BuildConfiguration;
+}
+
+
+##
+## Check if sorting is asked
+##
+if ($ENV{'QUERY_STRING'} =~ /$sortstring/ ) {
+    my $newsort=$ENV{'QUERY_STRING'};
+    my $actual=$settings{'SORT_XY'};
+
+    # Reverse actual sort or choose new column ?
+    if ($actual =~ $newsort) {
+       $f->setsortorder ($newsort ,rindex($actual,'Rev'));
+       $newsort .= rindex($actual,'Rev')==-1 ? 'Rev' : '';
+    } else {
+       $f->setsortorder ($newsort ,1);
+    }
+    $f->savedata;                                              # Synchronise file & display
+    $settings{'SORT_XY'} = $newsort;
+    map (delete ($settings{$_}) ,(@nosaved,'ACTION','KEY1'));  # Must never be saved
+    &General::writehash($setting, \%settings);
+    $settings{'ACTION'} = 'SORT';                              # Recreate an 'ACTION'
+    map ($settings{$_}= '',(@nosaved,,'KEY1'));                        # and reinit var to empty
+}
+
+##
+## Remove if no Setting1 needed
+##
+if ($settings{'ACTION'} eq '' ) { # First launch from GUI
+    # Place here default value when nothing is initialized
+
+}
+
+&Header::openpage($Lang::tr{'XY title'}, 1, '');
+&Header::openbigbox('100%', 'left', '', $errormessage);
+my %checked =();     # Checkbox manipulations
+
+if ($errormessage) {
+    &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
+    print "<font class='base'>$errormessage&nbsp;</font>";
+    &Header::closebox();
+}
+
+##
+## First box Settings1. Remove if not needed
+##
+$warnmessage = "<font color=${Header::colourred}><b>$Lang::tr{'capswarning'}</b></font>: $warnmessage" if ($warnmessage);
+
+&Header::openbox('100%', 'left', $Lang::tr{'XY settings'});
+print "<form method='post' action='$ENV{'SCRIPT_NAME'}'>";
+$checked{'IT'}{'RED'} = '';
+$checked{'IT'}{'GREEN'} = '';
+$checked{'IT'}{'ORANGE'} = '';
+$checked{'IT'}{'BLUE'} = '';
+$checked{'IT'}{$settings{'IT'}} = "checked='checked'";
+$checked{'TURBO'} = ($settings{'TURBO'} eq 'on') ? "checked='checked'" : '';
+
+print<<END
+<table width='100%'>
+<tr>
+    <td class='base'>Name:</td>
+    <td><input type='text' name='NAME' value='$settings{'NAME'}' /></td>
+    <td align='right'>INTERFACE</td>
+    <td align='right'>red<input type='radio' name='IT' value='RED' $checked{'IT'}{'RED'} /></td>
+</tr><tr>
+    <td>Turbo:</td>
+    <td><input type='checkbox' name='TURBO' $checked{'TURBO'}' /></td>
+    <td></td>
+    <td align='right'>green<input type='radio' name='IT' value='GREEN' $checked{'IT'}{'GREEN'} /></td>
+</tr><tr>
+    <td></td>
+    <td></td>
+    <td></td>
+    <td align='right'>blue<input type='radio' name='IT' value='BLUE' $checked{'IT'}{'BLUE'} /></td>
+</tr><tr>
+    <td></td>
+    <td></td>
+    <td></td>
+    <td align='right'>orange<input type='radio' name='IT' value='ORANGE' $checked{'IT'}{'ORANGE'} /></td>
+</tr>
+</table>
+<br />
+END
+;
+
+print<<END
+<table width='100%'>
+<hr />
+<tr>
+    <td class='base' width='25%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>
+    <td class='base' width='25%'>$warnmessage</td>
+    <td width='50%' align='center'><input type='submit' name='ACTION' value='$Lang::tr{'save'}' /></td>
+</tr>
+</table>
+</form>
+END
+;
+&Header::closebox();   # end of Settings1
+
+##
+## Second box is for editing the an item of the list
+##
+$checked{'CB'} = ($settings{'CB'} eq 'on') ? "checked='checked'" : '';
+
+my $buttontext = $Lang::tr{'add'};
+if ($settings{'KEY1'} ne '') {
+    $buttontext = $Lang::tr{'update'};
+    &Header::openbox('100%', 'left', $Lang::tr{'XY edit data'});
+} else {
+    &Header::openbox('100%', 'left', $Lang::tr{'XY add data'});
+}
+
+# Edited line number (KEY1) passed until cleared by 'save' or 'remove' or 'new sort order'
+print <<END
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='KEY1' value='$settings{'KEY1'}' />
+<table width='100%'>
+<tr>
+    <td class='base'>$Lang::tr{'ip address'}:</td>
+    <td><input type='text' name='IP' value='$settings{'IP'}' /></td>
+    <td class='base'>$Lang::tr{'enabled'}</td>
+    <td><input type='checkbox' name='CB' $checked{'CB'} /></td>
+    <td class='base'>$Lang::tr{'remark'}:&nbsp;<img src='/blob.gif' alt='*' /></td>
+    <td><input type 'text' name='COMMENT' value='$settings{'COMMENT'}' /></td>
+</tr>
+</table>
+<hr />
+<table width='100%'>
+<tr>
+    <td class='base' width='50%'><img src='/blob.gif' align='top' alt='*' />&nbsp;$Lang::tr{'this field may be blank'}</td>
+    <td width='50%' align='center'><input type='hidden' name='ACTION' value='$Lang::tr{'add'}' /><input type='submit' name='SUBMIT' value='$buttontext' /></td>
+</tr>
+</table>
+</form>
+END
+;
+&Header::closebox();
+
+##
+## Third box shows the list
+##
+
+# Columns headers may be a sort link. In this case it must be named in $sortstring
+&Header::openbox('100%', 'left', $Lang::tr{'XY data'});
+print <<END
+<table width='100%'>
+<tr>
+    <td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IP'><b>$Lang::tr{'ip address'}</b></a></td>
+    <td width='70%' align='center'><a href='$ENV{'SCRIPT_NAME'}?COMMENT'><b>$Lang::tr{'remark'}</b></a></td>
+    <td width='10%' colspan='3' class='boldbase' align='center'><b>$Lang::tr{'action'}</b></td>
+</tr>
+END
+;
+
+##
+## Print each line of @current list
+##
+my $key = 0;
+$f->readreset; # beginning of data
+for ($key=0; $key<$f->getnumberofline; $key++) {
+
+    my($cb,$comment,$ip) = $f->readbyfieldsseq($key,'CB','COMMENT','IP');
+
+    #Choose icon for checkbox
+    my $gif = '';
+    my $gdesc = '';
+    if ($cb eq "on") {
+       $gif = 'on.gif';
+       $gdesc = $Lang::tr{'click to disable'};
+    } else {
+       $gif = 'off.gif';
+       $gdesc = $Lang::tr{'click to enable'};
+    }
+
+    #Colorize each line
+    if ($settings{'KEY1'} eq $key) {
+       print "<tr bgcolor='${Header::colouryellow}'>";
+    } elsif ($key % 2) {
+       print "<tr bgcolor='${Header::table2colour}'>";
+    } else {
+       print "<tr bgcolor='${Header::table1colour}'>"; 
+    }
+
+    print <<END
+<td align='center'>$ip</td>
+<td align='center'>$comment</td>
+
+<td align='center'>
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='ACTION' value='$Lang::tr{'toggle enable disable'}' />
+<input type='image' name='$Lang::tr{'toggle enable disable'}' src='/images/$gif' alt='$gdesc' title='$gdesc' />
+<input type='hidden' name='KEY1' value='$key' />
+</form>
+</td>
+
+<td align='center'>
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='ACTION' value='$Lang::tr{'edit'}' />
+<input type='image' name='$Lang::tr{'edit'}' src='/images/edit.gif' alt='$Lang::tr{'edit'}' title='$Lang::tr{'edit'}' />
+<input type='hidden' name='KEY1' value='$key' />
+</form>
+</td>
+
+<td align='center'>
+<form method='post' action='$ENV{'SCRIPT_NAME'}'>
+<input type='hidden' name='ACTION' value='$Lang::tr{'remove'}' />
+<input type='image' name='$Lang::tr{'remove'}' src='/images/delete.gif' alt='$Lang::tr{'remove'}' title='$Lang::tr{'remove'}' />
+<input type='hidden' name='KEY1' value='$key' />
+</form>
+</td>
+</tr>
+END
+;
+} print "</table>";
+
+# If table contains entries, print 'Key to action icons'
+if ($key) {
+print <<END
+<table>
+<tr>
+    <td class='boldbase'>&nbsp;<b>$Lang::tr{'legend'}:&nbsp;</b></td>
+    <td><img src='/images/on.gif' alt='$Lang::tr{'click to disable'}' /></td>
+    <td class='base'>$Lang::tr{'click to disable'}</td>
+    <td>&nbsp;&nbsp;</td>
+    <td><img src='/images/off.gif' alt='$Lang::tr{'click to enable'}' /></td>
+    <td class='base'>$Lang::tr{'click to enable'}</td>
+    <td&