projects / people / pmueller / ipfire-2.x.git / blame
| Commit | Line | Data |
|---|---|---|
| cd1a2927 MT |
1 | # SmoothWall CGIs\r |
| 2 | #\r | |
| 3 | # This code is distributed under the terms of the GPL\r | |
| 4 | #\r | |
| 5 | # (c) The SmoothWall Team\r | |
| 6 | # Copyright (C) 2002 Alex Hudson - getcgihash() rewrite\r | |
| 7 | # Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()\r | |
| 8 | # Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions\r | |
| 9 | # Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()\r | |
| 10 | # Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()\r | |
| 11 | #\r | |
| 12 | # $Id: header.pl,v 1.34.2.67 2005/10/03 20:01:05 gespinasse Exp $\r | |
| 13 | #\r | |
| 14 | \r | |
| 15 | package Header;\r | |
| 16 | \r | |
| 17 | use strict;\r | |
| 18 | use CGI();\r | |
| 19 | use Time::Local;\r | |
| 20 | \r | |
| 21 | # enable only the following on debugging purpose\r | |
| 22 | #use warnings;\r | |
| 23 | #use CGI::Carp 'fatalsToBrowser';\r | |
| 24 | \r | |
| 25 | \r | |
| 26 | $Header::pagecolour = '#ffffff'; # never used, will be removed\r | |
| 27 | $Header::tablecolour = '#FFFFFF'; # never used, will be removed\r | |
| 28 | $Header::bigboxcolour = '#F6F4F4'; # never used, will be removed\r | |
| 29 | $Header::boxcolour = '#EAE9EE'; # only header.pl, ? move in css ?\r | |
| 30 | $Header::bordercolour = '#000000'; # never used, will be removed\r | |
| 31 | $Header::table1colour = '#C0C0C0';\r | |
| 32 | $Header::table2colour = '#F2F2F2';\r | |
| 33 | $Header::colourred = '#993333';\r | |
| 34 | $Header::colourorange = '#FF9933';\r | |
| 35 | $Header::colouryellow = '#FFFF00';\r | |
| 36 | $Header::colourgreen = '#339933';\r | |
| 37 | $Header::colourblue = '#333399';\r | |
| 38 | $Header::colourfw = '#000000'; # only connections.cgi\r | |
| 39 | $Header::colourvpn = '#990099'; # only connections.cgi\r | |
| 40 | $Header::colourerr = '#FF0000'; # only header.pl, many scripts use colourred for warnings messages\r | |
| 41 | $Header::viewsize = 150;\r | |
| 42 | my %menu = ();\r | |
| 43 | my $hostnameintitle = 0;\r | |
| 44 | our $javascript = 1;\r | |
| 45 | \r | |
| 46 | ### Initialize menu\r | |
| 47 | sub genmenu\r | |
| 48 | {\r | |
| 49 | ### Initialize environment\r | |
| 50 | my %ethsettings = ();\r | |
| 51 | &General::readhash("${General::swroot}/ethernet/settings", \%ethsettings);\r | |
| 52 | \r | |
| 53 | %{$menu{'1.system'}}=(\r | |
| 54 | 'contents' => $Lang::tr{'alt system'},\r | |
| 55 | 'uri' => '',\r | |
| 56 | 'statusText' => "IPCop $Lang::tr{'alt system'}",\r | |
| 57 | 'subMenu' => [[ $Lang::tr{'alt home'} , '/cgi-bin/index.cgi', "IPCop $Lang::tr{'alt home'}" ],\r | |
| 58 | [ $Lang::tr{'updates'} , '/cgi-bin/updates.cgi', "IPCop $Lang::tr{'updates'}" ],\r | |
| 59 | [ $Lang::tr{'sspasswords'} , '/cgi-bin/changepw.cgi', "IPCop $Lang::tr{'sspasswords'}" ],\r | |
| 60 | [ $Lang::tr{'ssh access'} , '/cgi-bin/remote.cgi', "IPCop $Lang::tr{'ssh access'}" ],\r | |
| 61 | [ $Lang::tr{'gui settings'} , '/cgi-bin/gui.cgi', "IPCop $Lang::tr{'gui settings'}" ],\r | |
| 62 | [ $Lang::tr{'backup'} , '/cgi-bin/backup.cgi', "IPCop $Lang::tr{'backup'} / $Lang::tr{'restore'}" ],\r | |
| 63 | [ $Lang::tr{'shutdown'} , '/cgi-bin/shutdown.cgi', "IPCop $Lang::tr{'shutdown'} / $Lang::tr{'reboot'}" ],\r | |
| 64 | [ $Lang::tr{'credits'} , '/cgi-bin/credits.cgi', "IPCop $Lang::tr{'credits'}" ]]\r | |
| 65 | );\r | |
| 66 | %{$menu{'2.status'}}=(\r | |
| 67 | 'contents' => $Lang::tr{'status'},\r | |
| 68 | 'uri' => '',\r | |
| 69 | 'statusText' => "IPCop $Lang::tr{'status information'}",\r | |
| 70 | 'subMenu' => [[ $Lang::tr{'sssystem status'} , '/cgi-bin/status.cgi', "IPCop $Lang::tr{'system status information'}" ],\r | |
| 71 | [ $Lang::tr{'ssnetwork status'} , '/cgi-bin/netstatus.cgi', "IPCop $Lang::tr{'network status information'}" ],\r | |
| 72 | [ $Lang::tr{'system graphs'} , '/cgi-bin/graphs.cgi', "IPCop $Lang::tr{'system graphs'}" ],\r | |
| 73 | [ $Lang::tr{'sstraffic graphs'} , '/cgi-bin/graphs.cgi?graph=network', "IPCop $Lang::tr{'network traffic graphs'}" ],\r | |
| 74 | [ $Lang::tr{'ssproxy graphs'} , '/cgi-bin/proxygraphs.cgi', "IPCop $Lang::tr{'proxy access graphs'}" ],\r | |
| 75 | [ $Lang::tr{'connections'} , '/cgi-bin/connections.cgi', "IPCop $Lang::tr{'connections'}" ]]\r | |
| 76 | );\r | |
| 77 | %{$menu{'3.network'}}=(\r | |
| 78 | 'contents' => $Lang::tr{'network'},\r | |
| 79 | 'uri' => '',\r | |
| 80 | 'statusText' => "IPCop $Lang::tr{'network configuration'}",\r | |
| 81 | 'subMenu' => [[ $Lang::tr{'alt dialup'} , '/cgi-bin/pppsetup.cgi', "IPCop $Lang::tr{'dialup settings'}" ],\r | |
| 82 | [ $Lang::tr{'upload'} , '/cgi-bin/upload.cgi', $Lang::tr{'firmware upload'} ],\r | |
| 83 | [ $Lang::tr{'modem'} , '/cgi-bin/modem.cgi', "IPCop $Lang::tr{'modem configuration'}" ],\r | |
| 84 | [ $Lang::tr{'aliases'} , '/cgi-bin/aliases.cgi', "IPCop $Lang::tr{'external aliases configuration'}" ]]\r | |
| 85 | );\r | |
| 86 | %{$menu{'4.services'}}=(\r | |
| 87 | 'contents' => $Lang::tr{'alt services'},\r | |
| 88 | 'uri' => '',\r | |
| 89 | 'statusText' => "IPCop $Lang::tr{'alt services'}",\r | |
| 90 | 'subMenu' => [[ $Lang::tr{'proxy'} , '/cgi-bin/proxy.cgi', "IPCop $Lang::tr{'web proxy configuration'}" ],\r | |
| 91 | [ $Lang::tr{'dhcp server'} , '/cgi-bin/dhcp.cgi', "IPCop $Lang::tr{'dhcp configuration'}" ],\r | |
| 92 | [ $Lang::tr{'dynamic dns'} , '/cgi-bin/ddns.cgi', "IPCop $Lang::tr{'dynamic dns client'}" ],\r | |
| 93 | [ $Lang::tr{'edit hosts'} , '/cgi-bin/hosts.cgi', "IPCop $Lang::tr{'host configuration'}" ],\r | |
| 94 | [ $Lang::tr{'time server'} , '/cgi-bin/time.cgi', "IPCop $Lang::tr{'time server'}" ],\r | |
| 95 | [ $Lang::tr{'traffic shaping'} , '/cgi-bin/shaping.cgi', "IPCop $Lang::tr{'traffic shaping settings'}" ],\r | |
| 96 | [ $Lang::tr{'intrusion detection'} , '/cgi-bin/ids.cgi', "IPCop $Lang::tr{'intrusion detection system'} (Snort)" ]]\r | |
| 97 | );\r | |
| 98 | %{$menu{'5.firewall'}}=(\r | |
| 99 | 'contents' => $Lang::tr{'firewall'},\r | |
| 100 | 'uri' => '',\r | |
| 101 | 'statusText' => "IPCop $Lang::tr{'firewall'}",\r | |
| 102 | 'subMenu' => [[ $Lang::tr{'ssport forwarding'} , '/cgi-bin/portfw.cgi', "IPCop $Lang::tr{'port forwarding configuration'}" ],\r | |
| 103 | [ $Lang::tr{'external access'} , '/cgi-bin/xtaccess.cgi', "IPCop $Lang::tr{'external access configuration'}" ],\r | |
| 104 | [ $Lang::tr{'ssdmz pinholes'} , '/cgi-bin/dmzholes.cgi', "IPCop $Lang::tr{'dmz pinhole configuration'}" ],\r | |
| 105 | [ $Lang::tr{'blue access'} , '/cgi-bin/wireless.cgi', "IPCop $Lang::tr{'blue access'}" ]\r | |
| 106 | ,[ $Lang::tr{'options fw'} , '/cgi-bin/optionsfw.cgi', "IPCop $Lang::tr{'options fw'}" ]\r | |
| 107 | ]\r | |
| 108 | );\r | |
| 109 | %{$menu{'6.vpns'}}=(\r | |
| 110 | 'contents' => $Lang::tr{'alt vpn'},\r | |
| 111 | 'uri' => '',\r | |
| 112 | 'statusText' => "IPCop $Lang::tr{'virtual private networking'}",\r | |
| 113 | 'subMenu' => [[ $Lang::tr{'alt vpn'} , '/cgi-bin/vpnmain.cgi', "IPCop $Lang::tr{'virtual private networking'}"]]\r | |
| 114 | );\r | |
| 115 | %{$menu{'7.mainlogs'}}=(\r | |
| 116 | 'contents' => $Lang::tr{'alt logs'},\r | |
| 117 | 'uri' => '',\r | |
| 118 | 'statusText' => "IPCop $Lang::tr{'alt logs'}",\r | |
| 119 | 'subMenu' => [[ $Lang::tr{'log settings'} , '/cgi-bin/logs.cgi/config.dat', "IPCop $Lang::tr{'log settings'}" ],\r | |
| 120 | [ $Lang::tr{'log summary'} , '/cgi-bin/logs.cgi/summary.dat', "IPCop $Lang::tr{'log summary'}" ],\r | |
| 121 | [ $Lang::tr{'proxy logs'} , '/cgi-bin/logs.cgi/proxylog.dat', "IPCop $Lang::tr{'proxy log viewer'}" ],\r | |
| 122 | [ $Lang::tr{'firewall logs'} , '/cgi-bin/logs.cgi/firewalllog.dat', "IPCop $Lang::tr{'firewall log viewer'}" ],\r | |
| 123 | [ $Lang::tr{'ids logs'} , '/cgi-bin/logs.cgi/ids.dat', "IPCop $Lang::tr{'intrusion detection system log viewer'}" ],\r | |
| 124 | [ $Lang::tr{'system logs'} , '/cgi-bin/logs.cgi/log.dat', "IPCop $Lang::tr{'system log viewer'}" ]]\r | |
| 125 | );\r | |
| 126 | if (! $ethsettings{'BLUE_DEV'}) {\r | |
| 127 | splice (@{$menu{'5.firewall'}{'subMenu'}}, 3, 1);\r | |
| 128 | }\r | |
| 129 | if (! $ethsettings{'BLUE_DEV'} && ! $ethsettings{'ORANGE_DEV'}) {\r | |
| 130 | splice (@{$menu{'5.firewall'}{'subMenu'}}, 2, 1);\r | |
| 131 | }\r | |
| 132 | unless ( $ethsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $ethsettings{'RED_TYPE'} eq 'STATIC' ) {\r | |
| 133 | splice (@{$menu{'3.network'}{'subMenu'}}, 3, 1);\r | |
| 134 | }\r | |
| 135 | if ( ! -e "${General::swroot}/snort/enable" && ! -e "${General::swroot}/snort/enable_blue" &&\r | |
| 136 | ! -e "${General::swroot}/snort/enable_green" && ! -e "${General::swroot}/snort/enable_orange") {\r | |
| 137 | splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 4, 1);\r | |
| 138 | }\r | |
| 139 | if ( ! -e "${General::swroot}/proxy/enable" && ! -e "${General::swroot}/proxy/enable_blue" ) {\r | |
| 140 | splice (@{$menu{'2.status'}{'subMenu'}}, 4, 1);\r | |
| 141 | splice (@{$menu{'7.mainlogs'}{'subMenu'}}, 2, 1);\r | |
| 142 | }\r | |
| 143 | }\r | |
| 144 | \r | |
| 145 | sub showhttpheaders\r | |
| 146 | {\r | |
| 147 | ### Make sure this is an SSL request\r | |
| 148 | if ($ENV{'SERVER_ADDR'} && $ENV{'HTTPS'} ne 'on') {\r | |
| 149 | print "Status: 302 Moved\r\n";\r | |
| 150 | print "Location: https://$ENV{'SERVER_ADDR'}:445/$ENV{'PATH_INFO'}\r\n\r\n";\r | |
| 151 | exit 0;\r | |
| 152 | } else {\r | |
| 153 | print "Pragma: no-cache\n";\r | |
| 154 | print "Cache-control: no-cache\n";\r | |
| 155 | print "Connection: close\n";\r | |
| 156 | print "Content-type: text/html\n\n";\r | |
| 157 | }\r | |
| 158 | }\r | |
| 159 | \r | |
| 160 | sub showjsmenu\r | |
| 161 | {\r | |
| 162 | my $c1 = 1;\r | |
| 163 | \r | |
| 164 | print " <script type='text/javascript'>\n";\r | |
| 165 | print " domMenu_data.setItem('domMenu_main', new domMenu_Hash(\n";\r | |
| 166 | \r | |
| 167 | foreach my $k1 ( sort keys %menu ) {\r | |
| 168 | my $c2 = 1;\r | |
| 169 | if ($c1 > 1) {\r | |
| 170 | print " ),\n";\r | |
| 171 | }\r | |
| 172 | print " $c1, new domMenu_Hash(\n";\r | |
| 173 | print "\t'contents', '" . &cleanhtml($menu{$k1}{'contents'}) . "',\n";\r | |
| 174 | print "\t'uri', '$menu{$k1}{'uri'}',\n";\r | |
| 175 | $menu{$k1}{'statusText'} =~ s/'/\\\'/g;\r | |
| 176 | print "\t'statusText', '$menu{$k1}{'statusText'}',\n";\r | |
| 177 | foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {\r | |
| 178 | print "\t $c2, new domMenu_Hash(\n";\r | |
| 179 | print "\t\t'contents', '" . &cleanhtml(@{$k2}[0]) . "',\n";\r | |
| 180 | print "\t\t'uri', '@{$k2}[1]',\n";\r | |
| 181 | @{$k2}[2] =~ s/'/\\\'/g;\r | |
| 182 | print "\t\t'statusText', '@{$k2}[2]'\n";\r | |
| 183 | if ( $c2 <= $#{$menu{$k1}{'subMenu'}} ) {\r | |
| 184 | print "\t ),\n";\r | |
| 185 | } else {\r | |
| 186 | print "\t )\n";\r | |
| 187 | }\r | |
| 188 | $c2++;\r | |
| 189 | }\r | |
| 190 | $c1++;\r | |
| 191 | }\r | |
| 192 | print " )\n";\r | |
| 193 | print " ));\n\n";\r | |
| 194 | \r | |
| 195 | print <<EOF\r | |
| 196 | domMenu_settings.setItem('domMenu_main', new domMenu_Hash(\r | |
| 197 | 'menuBarWidth', '0%',\r | |
| 198 | 'menuBarClass', 'ipcop_menuBar',\r | |
| 199 | 'menuElementClass', 'ipcop_menuElement',\r | |
| 200 | 'menuElementHoverClass', 'ipcop_menuElementHover',\r | |
| 201 | 'menuElementActiveClass', 'ipcop_menuElementHover',\r | |
| 202 | 'subMenuBarClass', 'ipcop_subMenuBar',\r | |
| 203 | 'subMenuElementClass', 'ipcop_subMenuElement',\r | |
| 204 | 'subMenuElementHoverClass', 'ipcop_subMenuElementHover',\r | |
| 205 | 'subMenuElementActiveClass', 'ipcop_subMenuElementHover',\r | |
| 206 | 'subMenuMinWidth', 'auto',\r | |
| 207 | 'distributeSpace', false,\r | |
| 208 | 'openMouseoverMenuDelay', 0,\r | |
| 209 | 'openMousedownMenuDelay', 0,\r | |
| 210 | 'closeClickMenuDelay', 0,\r | |
| 211 | 'closeMouseoutMenuDelay', -1\r | |
| 212 | ));\r | |
| 213 | </script>\r | |
| 214 | EOF\r | |
| 215 | ;\r | |
| 216 | }\r | |
| 217 | \r | |
| 218 | sub showmenu\r | |
| 219 | {\r | |
| 220 | if ($javascript) {print "<noscript>";}\r | |
| 221 | print "<table cellpadding='0' cellspacing='0' border='0'>\n";\r | |
| 222 | print "<tr>\n";\r | |
| 223 | \r | |
| 224 | foreach my $k1 ( sort keys %menu ) {\r | |
| 225 | print "<td class='ipcop_menuElementTD'><a href='" . @{@{$menu{$k1}{'subMenu'}}[0]}[1] . "' class='ipcop_menuElementNoJS'>";\r | |
| 226 | print $menu{$k1}{'contents'} . "</a></td>\n";\r | |
| 227 | }\r | |
| 228 | print "</tr></table>\n";\r | |
| 229 | if ($javascript) {print "</noscript>";}\r | |
| 230 | }\r | |
| 231 | \r | |
| 232 | sub showsubsection\r | |
| 233 | {\r | |
| 234 | my $location = $_[0];\r | |
| 235 | my $c1 = 0;\r | |
| 236 | \r | |
| 237 | if ($javascript) {print "<noscript>";}\r | |
| 238 | print "<table width='100%' cellspacing='0' cellpadding='5' border='0'>\n";\r | |
| 239 | print "<tr><td style='background-color: $Header::boxcolour;' width='53'><img src='/images/null.gif' width='43' height='1' alt='' /></td>\n";\r | |
| 240 | print "<td style='background-color: $Header::boxcolour;' align='left' width='100%'>";\r | |
| 241 | my @URI=split ('\?', $ENV{'REQUEST_URI'} );\r | |
| 242 | \r | |
| 243 | foreach my $k1 ( keys %menu ) {\r | |
| 244 | \r | |
| 245 | if ($menu{$k1}{'contents'} eq $location) {\r | |
| 246 | foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {\r | |
| 247 | if ($c1 > 0) {\r | |
| 248 | print " | ";\r | |
| 249 | }\r | |
| 250 | if (@{$k2}[1] eq "$URI[0]\?$URI[1]" || (@{$k2}[1] eq $URI[0] && length($URI[1]) == 0)) {\r | |
| 251 | #if (@{$k2}[1] eq "$URI[0]") {\r | |
| 252 | print "<b>@{$k2}[0]</b>";\r | |
| 253 | } else {\r | |
| 254 | print "<a href='@{$k2}[1]'>@{$k2}[0]</a>";\r | |
| 255 | }\r | |
| 256 | $c1++;\r | |
| 257 | }\r | |
| 258 | }\r | |
| 259 | }\r | |
| 260 | print "</td></tr></table>\n";\r | |
| 261 | if ($javascript) { print "</noscript>";}\r | |
| 262 | }\r | |
| 263 | \r | |
| 264 | sub openpage\r | |
| 265 | {\r | |
| 266 | my $title = $_[0];\r | |
| 267 | my $menu = $_[1];\r | |
| 268 | my $extrahead = $_[2];\r | |
| 269 | \r | |
| 270 | ### Initialize environment\r | |
| 271 | my %settings = ();\r | |
| 272 | &General::readhash("${General::swroot}/main/settings", \%settings);\r | |
| 273 | \r | |
| 274 | if ($settings{'JAVASCRIPT'} eq 'off') {\r | |
| 275 | $javascript = 0;\r | |
| 276 | } else {\r | |
| 277 | $javascript = 1;\r | |
| 278 | }\r | |
| 279 | \r | |
| 280 | if ($settings{'WINDOWWITHHOSTNAME'} eq 'on') {\r | |
| 281 | $hostnameintitle = 1;\r | |
| 282 | } else {\r | |
| 283 | $hostnameintitle = 0;\r | |
| 284 | }\r | |
| 285 | \r | |
| 286 | print <<END\r | |
| 287 | <!DOCTYPE html \r | |
| 288 | PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\r | |
| 289 | "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\r | |
| 290 | \r | |
| 291 | <html><head>\r | |
| 292 | END\r | |
| 293 | ;\r | |
| 294 | print " <title>";\r | |
| 295 | if ($hostnameintitle) {\r | |
| 296 | print "$settings{'HOSTNAME'}.$settings{'DOMAINNAME'} - $title"; \r | |
| 297 | } else {\r | |
| 298 | print "IPCop - $title";\r | |
| 299 | }\r | |
| 300 | print "</title>\n";\r | |
| 301 | \r | |
| 302 | print <<END\r | |
| 303 | $extrahead\r | |
| 304 | <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />\r | |
| 305 | <link rel="shortcut icon" href="/favicon.ico" />\r | |
| 306 | <style type="text/css">\@import url(/include/ipcop.css);</style>\r | |
| 307 | END\r | |
| 308 | ;\r | |
| 309 | if ($javascript) {\r | |
| 310 | print "<script type='text/javascript' src='/include/domMenu.js'></script>\n";\r | |
| 311 | &genmenu();\r | |
| 312 | &showjsmenu();\r | |
| 313 | } else {\r | |
| 314 | &genmenu();\r | |
| 315 | }\r | |
| 316 | \r | |
| 317 | my $location = '';\r | |
| 318 | my $sublocation = '';\r | |
| 319 | my @URI=split ('\?', $ENV{'REQUEST_URI'} );\r | |
| 320 | foreach my $k1 ( keys %menu ) {\r | |
| 321 | my $temp = $menu{$k1}{'contents'};\r | |
| 322 | foreach my $k2 ( @{$menu{$k1}{'subMenu'}} ) {\r | |
| 323 | if ( @{$k2}[1] eq $URI[0] ) {\r | |
| 324 | $location = $temp;\r | |
| 325 | $sublocation = @{$k2}[0];\r | |
| 326 | }\r | |
| 327 | }\r | |
| 328 | }\r | |
| 329 | \r | |
| 330 | my @cgigraphs = split(/graph=/,$ENV{'QUERY_STRING'});\r | |
| 331 | if (defined ($cgigraphs[1])){ \r | |
| 332 | if ($cgigraphs[1] =~ /(GREEN|BLUE|ORANGE|RED|network)/) {\r | |
| 333 | $location = $Lang::tr{'status'};\r | |
| 334 | $sublocation = $Lang::tr{'sstraffic graphs'};\r | |
| 335 | }\r | |
| 336 | if ($cgigraphs[1] =~ /(cpu|memory|swap|disk)/) {\r | |
| 337 | $location = $Lang::tr{'status'};\r | |
| 338 | $sublocation = $Lang::tr{'system graphs'};\r | |
| 339 | }\r | |
| 340 | }\r | |
| 341 | if ($ENV{'QUERY_STRING'} =~ /(ip)/) {\r | |
| 342 | $location = $Lang::tr{'alt logs'};\r | |
| 343 | $sublocation = "WHOIS";\r | |
| 344 | }\r | |
| 345 | \r | |
| 346 | if ($javascript) {\r | |
| 347 | print <<END\r | |
| 348 | <script type="text/javascript">\r | |
| 349 | document.onmouseup = function()\r | |
| 350 | {\r | |
| 351 | domMenu_deactivate('domMenu_main');\r | |
| 352 | }\r | |
| 353 | </script>\r | |
| 354 | </head>\r | |
| 355 | \r | |
| 356 | <body onload="domMenu_activate('domMenu_main');">\r | |
| 357 | END\r | |
| 358 | ;\r | |
| 359 | } else {\r | |
| 360 | print "</head>\n\n<body>\n";\r | |
| 361 | }\r | |
| 362 | \r | |
| 363 | print <<END\r | |
| 364 | <!-- IPCOP HEADER -->\r | |
| 365 | <table width='100%' cellpadding='0' cellspacing='0'>\r | |
| 366 | <col width='53' />\r | |
| 367 | <col />\r | |
| 368 | <tr><td><img src='/images/null.gif' width='53' height='27' alt='' /></td>\r | |
| 369 | <td valign='bottom'><table width='100%' cellspacing='0' border='0'>\r | |
| 370 | <col width='5' />\r | |
| 371 | <col width='175' />\r | |
| 372 | <col />\r | |
| 373 | <tr><td><img src='/images/null.gif' width='5' height='1' alt='' /></td>\r | |
| 374 | <td class="ipcop_menuLocationMain" valign='bottom'>$location</td>\r | |
| 375 | <td class="ipcop_menuLocationSub" valign='bottom'>$sublocation</td>\r | |
| 376 | </tr></table>\r | |
| 377 | </td></tr>\r | |
| 378 | <tr><td valign='bottom' class='ipcop_Version'>\r | |
| 379 | <img src='/images/null.gif' width='1' height='29' alt='' />${General::version}</td>\r | |
| 380 | <td valign='bottom'>\r | |
| 381 | END\r | |
| 382 | ;\r | |
| 383 | if ($menu == 1) {\r | |
| 384 | if ($javascript) {\r | |
| 385 | print "<div id='domMenu_main'></div>\n";\r | |
| 386 | }\r | |
| 387 | &showmenu();\r | |
| 388 | }\r | |
| 389 | print " </td></tr></table>\n";\r | |
| 390 | &showsubsection($location);\r | |
| 391 | print "<!-- IPCOP CONTENT -->\n";\r | |
| 392 | }\r | |
| 393 | \r | |
| 394 | sub closepage\r | |
| 395 | {\r | |
| 396 | print <<END\r | |
| 397 | <!-- IPCOP FOOTER -->\r | |
| 398 | <table width='100%' border='0'>\r | |
| 399 | <tr><td valign='bottom'><img src='/images/bounceback.png' width='248' height='80' alt='' /></td>\r | |
| 400 | <td align='center' valign='bottom'>\r | |
| 401 | END\r | |
| 402 | ;\r | |
| 403 | my $status = &connectionstatus();\r | |
| 404 | print "$status<br />\n"; \r | |
| 405 | print `/usr/bin/uptime`;\r | |
| 406 | \r | |
| 407 | print <<END\r | |
| 408 | </td>\r | |
| 409 | <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 | |
| 410 | </tr></table>\r | |
| 411 | </body></html>\r | |
| 412 | END\r | |
| 413 | ;\r | |
| 414 | }\r | |
| 415 | \r | |
| 416 | sub openbigbox\r | |
| 417 | {\r | |
| 418 | my $width = $_[0];\r | |
| 419 | my $align = $_[1];\r | |
| 420 | my $sideimg = $_[2];\r | |
| 421 | my $errormessage = $_[3];\r | |
| 422 | my $bgcolor;\r | |
| 423 | \r | |
| 424 | if ($errormessage) {\r | |
| 425 | $bgcolor = "style='background-color: $Header::colourerr;'";\r | |
| 426 | } else {\r | |
| 427 | $bgcolor = '';\r | |
| 428 | }\r | |
| 429 | \r | |
| 430 | print "<table width='100%' border='0'>\n";\r | |
| 431 | if ($sideimg) {\r | |
| 432 | print "<tr><td valign='top'><img src='/images/$sideimg' width='65' height='345' alt='' /></td>\n";\r | |
| 433 | } else {\r | |
| 434 | print "<tr>\n";\r | |
| 435 | }\r | |
| 436 | print "<td valign='top' align='center'><table width='$width' $bgcolor cellspacing='0' cellpadding='10' border='0'>\n";\r | |
| 437 | print "<tr><td><img src='/images/null.gif' width='1' height='365' alt='' /></td>\n";\r | |
| 438 | print "<td align='$align' valign='top'>\n";\r | |
| 439 | }\r | |
| 440 | \r | |
| 441 | sub closebigbox\r | |
| 442 | {\r | |
| 443 | print "</td></tr></table></td></tr></table>\n" \r | |
| 444 | }\r | |
| 445 | \r | |
| 446 | sub openbox\r | |
| 447 | {\r | |
| 448 | my $width = $_[0];\r | |
| 449 | my $align = $_[1];\r | |
| 450 | my $caption = $_[2];\r | |
| 451 | \r | |
| 452 | print <<END\r | |
| 453 | <table cellspacing="0" cellpadding="0" width="$width" border="0">\r | |
| 454 | <col width='12' />\r | |
| 455 | <col width='18' />\r | |
| 456 | <col width='100%' />\r | |
| 457 | <col width='152' />\r | |
| 458 | <col width='11' />\r | |
| 459 | \r | |
| 460 | <tr><td width='12' ><img src='/images/null.gif' width='12' height='1' alt='' /></td>\r | |
| 461 | <td width='18' ><img src='/images/null.gif' width='18' height='1' alt='' /></td>\r | |
| 462 | <td width='100%'><img src='/images/null.gif' width='400' height='1' alt='' /></td>\r | |
| 463 | <td width='152' ><img src='/images/null.gif' width='152' height='1' alt='' /></td>\r | |
| 464 | <td width='11' ><img src='/images/null.gif' width='11' height='1' alt='' /></td></tr>\r | |
| 465 | <tr><td colspan='2' ><img src='/images/boxtop1.png' width='30' height='53' alt='' /></td>\r | |
| 466 | <td style='background: url(/images/boxtop2.png);'>\r | |
| 467 | END\r | |
| 468 | ;\r | |
| 469 | if ($caption) { print "<b>$caption</b>\n"; } else { print " "; }\r | |
| 470 | print <<END\r | |
| 471 | </td>\r | |
| 472 | <td colspan='2'><img src='/images/boxtop3.png' width='163' height='53' alt='' /></td></tr>\r | |
| 473 | <tr><td style='background: url(/images/boxleft.png);'><img src='/images/null.gif' width='12' height='1' alt='' /></td>\r | |
| 474 | <td colspan='3' style='background-color: $Header::boxcolour;'>\r | |
| 475 | <table width='100%' cellpadding='5'><tr><td align="$align" valign='top'>\r | |
| 476 | END\r | |
| 477 | ;\r | |
| 478 | }\r | |
| 479 | \r | |
| 480 | sub closebox\r | |
| 481 | {\r | |
| 482 | print <<END\r | |
| 483 | </td></tr></table></td>\r | |
| 484 | <td style='background: url(/images/boxright.png);'><img src='/images/null.gif' width='11' height='1' alt='' /></td></tr>\r | |
| 485 | <tr><td style='background: url(/images/boxbottom1.png);background-repeat:no-repeat;'><img src='/images/null.gif' width='12' height='14' alt='' /></td>\r | |
| 486 | <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 | |
| 487 | <td style='background: url(/images/boxbottom3.png);background-repeat:no-repeat;'><img src='/images/null.gif' width='11' height='14' alt='' /></td></tr>\r | |
| 488 | </table>\r | |
| 489 | END\r | |
| 490 | ;\r | |
| 491 | }\r | |
| 492 | \r | |
| 493 | sub getcgihash {\r | |
| 494 | my ($hash, $params) = @_;\r | |
| 495 | my $cgi = CGI->new ();\r | |
| 496 | return if ($ENV{'REQUEST_METHOD'} ne 'POST');\r | |
| 497 | if (!$params->{'wantfile'}) {\r | |
| 498 | $CGI::DISABLE_UPLOADS = 1;\r | |
| 499 | $CGI::POST_MAX = 512 * 1024;\r | |
| 500 | } else {\r | |
| 501 | $CGI::POST_MAX = 10 * 1024 * 1024;\r | |
| 502 | }\r | |
| 503 | \r | |
| 504 | $cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;\r | |
| 505 | my $referer = $1;\r | |
| 506 | $cgi->url() =~ m/^https?\:\/\/([^\/]+)/;\r | |
| 507 | my $servername = $1;\r | |
| 508 | return if ($referer ne $servername);\r | |
| 509 | \r | |
| 510 | ### Modified for getting multi-vars, split by |\r | |
| 511 | my %temp = $cgi->Vars();\r | |
| 512 | foreach my $key (keys %temp) {\r | |
| 513 | $hash->{$key} = $temp{$key};\r | |
| 514 | $hash->{$key} =~ s/\0/|/g;\r | |
| 515 | $hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;\r | |
| 516 | }\r | |
| 517 | \r | |
| 518 | if (($params->{'wantfile'})&&($params->{'filevar'})) {\r | |
| 519 | $hash->{$params->{'filevar'}} = $cgi->upload\r | |
| 520 | ($params->{'filevar'});\r | |
| 521 | }\r | |
| 522 | return;\r | |
| 523 | }\r | |
| 524 | \r | |
| 525 | sub cleanhtml\r | |
| 526 | {\r | |
| 527 | my $outstring =$_[0];\r | |
| 528 | $outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';\r | |
| 529 | $outstring =~ s/&/&/g;\r | |
| 530 | $outstring =~ s/\'/'/g;\r | |
| 531 | $outstring =~ s/\"/"/g;\r | |
| 532 | $outstring =~ s/</</g;\r | |
| 533 | $outstring =~ s/>/>/g;\r | |
| 534 | return $outstring;\r | |
| 535 | }\r | |
| 536 | \r | |
| 537 | sub connectionstatus\r | |
| 538 | {\r | |
| 539 | my %pppsettings = ();\r | |
| 540 | my %netsettings = ();\r | |
| 541 | my $iface='';\r | |
| 542 | \r | |
| 543 | $pppsettings{'PROFILENAME'} = 'None';\r | |
| 544 | &General::readhash("${General::swroot}/ppp/settings", \%pppsettings);\r | |
| 545 | &General::readhash("${General::swroot}/ethernet/settings", \%netsettings);\r | |
| 546 | \r | |
| 547 | my $profileused='';\r | |
| 548 | if ( ! ( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {\r | |
| 549 | $profileused="- $pppsettings{'PROFILENAME'}";\r | |
| 550 | }\r | |
| 551 | \r | |
| 552 | if ( ( $pppsettings{'METHOD'} eq 'DHCP' && $netsettings{'RED_TYPE'} ne 'PPTP') \r | |
| 553 | || $netsettings{'RED_TYPE'} eq 'DHCP' ) {\r | |
| 554 | if (open(IFACE, "${General::swroot}/red/iface")) {\r | |
| 555 | $iface = <IFACE>;\r | |
| 556 | close IFACE;\r | |
| 557 | chomp ($iface);\r | |
| 558 | $iface =~ /([a-zA-Z0-9]*)/; $iface = $1;\r | |
| 559 | }\r | |
| 560 | }\r | |
| 561 | \r | |
| 562 | my ($timestr, $connstate);\r | |
| 563 | if ($netsettings{'CONFIG_TYPE'} =~ /^(0|1|4|5)$/ && $pppsettings{'TYPE'} =~ /^isdn/) {\r | |
| 564 | # Count ISDN channels\r | |
| 565 | my ($idmap, $chmap, $drmap, $usage, $flags, $phone);\r | |
| 566 | my @phonenumbers;\r | |
| 567 | my $count=0;\r | |
| 568 | \r | |
| 569 | open (FILE, "/dev/isdninfo");\r | |
| 570 | \r | |
| 571 | $idmap = <FILE>; chop $idmap;\r | |
| 572 | $chmap = <FILE>; chop $chmap;\r | |
| 573 | $drmap = <FILE>; chop $drmap;\r | |
| 574 | $usage = <FILE>; chop $usage;\r | |
| 575 | $flags = <FILE>; chop $flags;\r | |
| 576 | $phone = <FILE>; chop $phone;\r | |
| 577 | \r | |
| 578 | $phone =~ s/^phone(\s*):(\s*)//;\r | |
| 579 | \r | |
| 580 | @phonenumbers = split / /, $phone;\r | |
| 581 | \r | |
| 582 | foreach (@phonenumbers) {\r | |
| 583 | if ($_ ne '???') {\r | |
| 584 | $count++;\r | |
| 585 | }\r | |
| 586 | }\r | |
| 587 | close (FILE);\r | |
| 588 | \r | |
| 589 | ## Connection status\r | |
| 590 | my $number;\r | |
| 591 | if ($count == 0) {\r | |
| 592 | $number = 'none!';\r | |
| 593 | } elsif ($count == 1) {\r | |
| 594 | $number = 'single';\r | |
| 595 | } else {\r | |
| 596 | $number = 'dual';\r | |
| 597 | }\r | |
| 598 | \r | |
| 599 | if (-e "${General::swroot}/red/active") {\r | |
| 600 | $timestr = &General::age("${General::swroot}/red/active");\r | |
| 601 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} - $number channel (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";\r | |
| 602 | } else {\r | |
| 603 | if ($count == 0) {\r | |
| 604 | if (-e "${General::swroot}/red/dial-on-demand") {\r | |
| 605 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";\r | |
| 606 | } else {\r | |
| 607 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";\r | |
| 608 | }\r | |
| 609 | } else {\r | |
| 610 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";\r | |
| 611 | }\r | |
| 612 | }\r | |
| 613 | } elsif ($netsettings{'RED_TYPE'} eq "STATIC" || $pppsettings {'METHOD'} eq 'STATIC') {\r | |
| 614 | if (-e "${General::swroot}/red/active") {\r | |
| 615 | $timestr = &General::age("${General::swroot}/red/active");\r | |
| 616 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";\r | |
| 617 | } else {\r | |
| 618 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";\r | |
| 619 | }\r | |
| 620 | } elsif ( ( (-e "${General::swroot}/dhcpc/dhcpcd-$iface.pid") && $netsettings{'RED_TYPE'} ne 'PPTP' ) || \r | |
| 621 | !system("/bin/ps -ef | /bin/grep -q '[p]ppd'") || !system("/bin/ps -ef | /bin/grep -q '[c]onnectioncheck'")) {\r | |
| 622 | if (-e "${General::swroot}/red/active") {\r | |
| 623 | $timestr = &General::age("${General::swroot}/red/active");\r | |
| 624 | if ($pppsettings{'TYPE'} =~ /^(modem|bewanadsl|conexantpciadsl|eagleusbadsl)$/) {\r | |
| 625 | my $speed;\r | |
| 626 | if ($pppsettings{'TYPE'} eq 'modem') {\r | |
| 627 | open(CONNECTLOG, "/var/log/connect.log");\r | |
| 628 | while (<CONNECTLOG>) {\r | |
| 629 | if (/CONNECT/) {\r | |
| 630 | $speed = (split / /)[6];\r | |
| 631 | }\r | |
| 632 | }\r | |
| 633 | close (CONNECTLOG);\r | |
| 634 | } elsif ($pppsettings{'TYPE'} eq 'bewanadsl') {\r | |
| 635 | $speed = `/usr/bin/unicorn_status | /bin/grep Rate | /usr/bin/cut -f2 -d ':'`;\r | |
| 636 | } elsif ($pppsettings{'TYPE'} eq 'conexantpciadsl') {\r | |
| 637 | $speed = `/bin/cat /proc/net/atm/CnxAdsl:* | /bin/grep 'Line Rates' | /bin/sed -e 's+Line Rates: Receive+Rx+' -e 's+Transmit+Tx+'`;\r | |
| 638 | } elsif ($pppsettings{'TYPE'} eq 'eagleusbadsl') {\r | |
| 639 | $speed = `/usr/sbin/eaglestat | /bin/grep Rate`;\r | |
| 640 | }\r | |
| 641 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused (\@$speed)</span>";\r | |
| 642 | } else {\r | |
| 643 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";\r | |
| 644 | }\r | |
| 645 | } else {\r | |
| 646 | if (-e "${General::swroot}/red/dial-on-demand") {\r | |
| 647 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";\r | |
| 648 | } else {\r | |
| 649 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";\r | |
| 650 | }\r | |
| 651 | }\r | |
| 652 | } else {\r | |
| 653 | $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";\r | |
| 654 | }\r | |
| 655 | return $connstate;\r | |
| 656 | }\r | |
| 657 | \r | |
| 658 | sub speedtouchversion\r | |
| 659 | {\r | |
| 660 | my $speedtouch;\r | |
| 661 | if (-f "/proc/bus/usb/devices")\r | |
| 662 | {\r | |
| 663 | $speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;\r | |
| 664 | if ($speedtouch eq '') {\r | |
| 665 | $speedtouch= $Lang::tr{'connect the modem'};\r | |
| 666 | }\r | |
| 667 | } else {\r | |
| 668 | $speedtouch='USB '.$Lang::tr{'not running'};\r | |
| 669 | }\r | |
| 670 | return $speedtouch\r | |
| 671 | }\r | |
| 672 | \r | |
| 673 | #Sorting of allocated leases\r | |
| 674 | sub CheckSortOrder {\r | |
| 675 | my %dhcpsettings = ();\r | |
| 676 | &General::readhash("${General::swroot}/dhcp/settings", \%dhcpsettings);\r | |
| 677 | \r | |
| 678 | if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {\r | |
| 679 | my $newsort=$ENV{'QUERY_STRING'};\r | |
| 680 | my $act=$dhcpsettings{'SORT_LEASELIST'};\r | |
| 681 | #Default sort if unspecified \r | |
| 682 | $act='IPADDRRev' if !defined ($act); \r | |
| 683 | #Reverse actual ?\r | |
| 684 | if ($act =~ $newsort) {\r | |
| 685 | my $Rev='';\r | |
| 686 | if ($act !~ 'Rev') {$Rev='Rev'};\r | |
| 687 | $newsort.=$Rev\r | |
| 688 | };\r | |
| 689 | \r | |
| 690 | $dhcpsettings{'SORT_LEASELIST'}=$newsort;\r | |
| 691 | &General::writehash("${General::swroot}/dhcp/settings", \%dhcpsettings);\r | |
| 692 | }\r | |
| 693 | }\r | |
| 694 | \r | |
| 695 | sub PrintActualLeases\r | |
| 696 | {\r | |
| 697 | our %dhcpsettings = ();\r | |
| 698 | our %entries = (); \r | |
| 699 | \r | |
| 700 | sub leasesort {\r | |
| 701 | my $qs ='';\r | |
| 702 | if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)\r | |
| 703 | {\r | |
| 704 | $qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);\r | |
| 705 | if ($qs eq 'IPADDR') {\r | |
| 706 | my @a = split(/\./,$entries{$a}->{$qs});\r | |
| 707 | my @b = split(/\./,$entries{$b}->{$qs});\r | |
| 708 | ($b[0]<=>$a[0]) ||\r | |
| 709 | ($b[1]<=>$a[1]) ||\r | |
| 710 | ($b[2]<=>$a[2]) ||\r | |
| 711 | ($b[3]<=>$a[3]);\r | |
| 712 | }else {\r | |
| 713 | $entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r | |
| 714 | }\r | |
| 715 | }\r | |
| 716 | else #not reverse\r | |
| 717 | {\r | |
| 718 | $qs=$dhcpsettings{'SORT_LEASELIST'};\r | |
| 719 | if ($qs eq 'IPADDR') {\r | |
| 720 | my @a = split(/\./,$entries{$a}->{$qs});\r | |
| 721 | my @b = split(/\./,$entries{$b}->{$qs});\r | |
| 722 | ($a[0]<=>$b[0]) ||\r | |
| 723 | ($a[1]<=>$b[1]) ||\r | |
| 724 | ($a[2]<=>$b[2]) ||\r | |
| 725 | ($a[3]<=>$b[3]);\r | |
| 726 | }else {\r | |
| 727 | $entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r | |
| 728 | }\r | |
| 729 | }\r | |
| 730 | }\r | |
| 731 | \r | |
| 732 | &Header::openbox('100%', 'left', $Lang::tr{'current dynamic leases'});\r | |
| 733 | print <<END\r | |
| 734 | <table width='100%'>\r | |
| 735 | <tr>\r | |
| 736 | <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$Lang::tr{'ip address'}</b></a></td>\r | |
| 737 | <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$Lang::tr{'mac address'}</b></a></td>\r | |
| 738 | <td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$Lang::tr{'hostname'}</b></a></td>\r | |
| 739 | <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 | |
| 740 | </tr>\r | |
| 741 | END\r | |
| 742 | ;\r | |
| 743 | \r | |
| 744 | my ($ip, $endtime, $ether, $hostname, @record, $record);\r | |
| 745 | open(LEASES,"/var/state/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";\r | |
| 746 | while (my $line = <LEASES>) {\r | |
| 747 | next if( $line =~ /^\s*#/ );\r | |
| 748 | chomp($line);\r | |
| 749 | my @temp = split (' ', $line);\r | |
| 750 | \r | |
| 751 | if ($line =~ /^\s*lease/) {\r | |
| 752 | $ip = $temp[1];\r | |
| 753 | #All field are not necessarily read. Clear everything\r | |
| 754 | $endtime = 0;\r | |
| 755 | $ether = "";\r | |
| 756 | $hostname = "";\r | |
| 757 | } elsif ($line =~ /^\s*ends never;/) {\r | |
| 758 | $endtime = 'never';\r | |
| 759 | } elsif ($line =~ /^\s*ends/) {\r | |
| 760 | $line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;\r | |
| 761 | $endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);\r | |
| 762 | } elsif ($line =~ /^\s*hardware ethernet/) {\r | |
| 763 | $ether = $temp[2];\r | |
| 764 | $ether =~ s/;//g;\r | |
| 765 | } elsif ($line =~ /^\s*client-hostname/) {\r | |
| 766 | shift (@temp);\r | |
| 767 | $hostname = join (' ',@temp);\r | |
| 768 | $hostname =~ s/;//g;\r | |
| 769 | $hostname =~ s/\"//g;\r | |
| 770 | } elsif ($line eq "}") {\r | |
| 771 | @record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);\r | |
| 772 | $record = {}; # create a reference to empty hash\r | |
| 773 | %{$record} = @record; # populate that hash with @record\r | |
| 774 | $entries{$record->{'IPADDR'}} = $record; # add this to a hash of hashes\r | |
| 775 | } #unknown format line...\r | |
| 776 | }\r | |
| 777 | close(LEASES);\r | |
| 778 | \r | |
| 779 | #Get sort method\r | |
| 780 | $dhcpsettings{'SORT_LEASELIST'}='IPADDR'; #default\r | |
| 781 | &General::readhash("${General::swroot}/dhcp/settings", \%dhcpsettings); #or maybe saved !\r | |
| 782 | my $id = 0;\r | |
| 783 | foreach my $key (sort leasesort keys %entries) {\r | |
| 784 | \r | |
| 785 | my $hostname = &Header::cleanhtml($entries{$key}->{HOSTNAME},"y");\r | |
| 786 | \r | |
| 787 | if ($id % 2) {\r | |
| 788 | print "<tr bgcolor='$Header::table1colour'>";\r | |
| 789 | }\r | |
| 790 | else {\r | |
| 791 | print "<tr bgcolor='$Header::table2colour'>";\r | |
| 792 | }\r | |
| 793 | \r | |
| 794 | print <<END\r | |
| 795 | <td align='center'>$entries{$key}->{IPADDR}</td>\r | |
| 796 | <td align='center'>$entries{$key}->{ETHER}</td>\r | |
| 797 | <td align='center'> $hostname </td>\r | |
| 798 | <td align='center'>\r | |
| 799 | END\r | |
| 800 | ;\r | |
| 801 | \r | |
| 802 | if ($entries{$key}->{ENDTIME} eq 'never') {\r | |
| 803 | print "$Lang::tr{'no time limit'}";\r | |
| 804 | } else {\r | |
| 805 | my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst);\r | |
| 806 | ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});\r | |
| 807 | my $enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);\r | |
| 808 | \r | |
| 809 | if ($entries{$key}->{ENDTIME} < time() ){\r | |
| 810 | print "<strike>$enddate</strike>";\r | |
| 811 | } else {\r | |
| 812 | print "$enddate";\r | |
| 813 | }\r | |
| 814 | }\r | |
| 815 | print "</td></tr>";\r | |
| 816 | $id++;\r | |
| 817 | }\r | |
| 818 | \r | |
| 819 | print "</table>";\r | |
| 820 | &Header::closebox();\r | |
| 821 | }\r | |
| 822 | \r | |
| 823 | 1;\r |