initial commit of file from CVS for e-smith-manager on Mon 7 Aug 11:32:16 BST 2023

root/etc/e-smith/web/common/cgi-bin/login

@@ -0,0 +1,355 @@
+#!/usr/bin/perl -w
+#
+# mod_auth_tkt sample login script - runs as a vanilla CGI, under 
+#   mod_perl 1 via Apache::Registry, and under mod_perl2 via 
+#   ModPerl::Registry.
+#
+# This script can run in a few different modes, depending on how it is 
+#   named. Copy the script to a cgi-bin area, and create appropriately 
+#   named symlinks to access the different behaviours. 
+# Modes:
+#   - login mode (default): request a username and password and test via
+#     $validate_sub - if successful, issue an auth ticket and redirect to 
+#     the back location
+#   - guest mode ('guest.cgi'): automatically issues an auth ticket a 
+#     special username (as defined in $guest_sub, default 'guest'), and 
+#     redirect to the back location (now largely obsolete - use 
+#     TKTAuthGuestLogin instead)
+#   - autologin mode ('autologin.cgi'): [typically used to allow tickets 
+#     across multiple domains] if no valid auth ticket exists, redirect
+#     to the login (or guest) version; otherwise automatically redirect 
+#     to the back location passing the current auth ticket as a GET 
+#     argument. mod_auth_tkt (>= 1.3.8) will turn this new ticket into 
+#     an auth cookie for the new domain if none already exists.
+#
+
+use File::Basename;
+use lib dirname($ENV{SCRIPT_FILENAME});
+use Apache::AuthTkt 0.03;
+use CGI qw(:standard);
+use CGI::Cookie;
+use URI::Escape;
+use URI;
+use strict;
+
+# ------------------------------------------------------------------------
+# Configure this section to taste
+
+# CSS stylesheet to use (optional)
+my $STYLESHEET = '/server-common/css/tkt.css';
+# Page title (optional)
+my $TITLE = 'SME Server manager';
+# For autologin, mode to fallback to if autologin fails ('login' or 'guest')
+my $AUTOLOGIN_FALLBACK_MODE = 'login';
+# Boolean flag, whether to fallback to HTTP_REFERER for back link
+my $BACK_REFERER = 0;
+
+# For login mode (if used), setup username/password validation
+#   (modify or point $validate_sub somewhere appropriate).
+# The validation routine should return a true value (e.g. 1) if the 
+#   given username/password combination is valid, and a false value
+#   (e.g. 0) otherwise.
+# This version uses Apache::Htpasswd and a standard htpasswd file.
+sub validate
+{
+  my ($username, $password) = @_;
+  unless (open(PWAUTH, "|/usr/bin/pwauth"))
+  {
+    warn "Could not open pipe to pwauth: $!";
+    return 0;
+  }
+  print PWAUTH "$username\n";
+  print PWAUTH "$password\n";
+  return close(PWAUTH) ? 1 : 0;
+#require Apache::Htpasswd;
+#  my $ht = Apache::Htpasswd->new({ 
+#    passwdFile => '/etc/httpd/conf/htpasswd', ReadOnly => 1 });
+#  return $ht->htCheckPassword($username, $password);
+}
+my $validate_sub = \&validate;
+
+# For guest mode (if used), setup guest username
+#   Could use a counter or a random suffix etc.
+sub guest_user
+{
+  return 'guest';
+}
+my $guest_sub = \&guest_user;
+
+# ------------------------------------------------------------------------
+# Main code begins
+my $debug = 0;
+my $at = Apache::AuthTkt->new(conf => "/etc/e-smith/web/common/cgi-bin/AuthTKT.cfg");
+my $q = CGI->new;
+my $x_f = $q->http('X-Forwarded-Host');
+#warn "X-Forwarded-Host is $x_f\n" if $x_f;
+#warn "HTTP_HOST is $ENV{HTTP_HOST}\n" if $ENV{HTTP_HOST};
+my ($server_name, $server_port) = split /:/, $q->http('X-Forwarded-Host') || $ENV{HTTP_HOST};
+$server_name ||= $ENV{SERVER_NAME} if $ENV{SERVER_NAME};
+$server_port ||= $ENV{SERVER_PORT} if $ENV{SERVER_PORT};
+#my $AUTH_DOMAIN = $at->domain || $server_name;
+my $AUTH_DOMAIN = $server_name;
+#warn "AUTH_DOMAIN is $AUTH_DOMAIN\n";
+#warn "AuthTkt->domain was set\n" if $at->domain;
+my @auth_domain = $AUTH_DOMAIN && $AUTH_DOMAIN =~ /\./ ? ( -domain => $AUTH_DOMAIN ) : ();
+my $ticket = $q->cookie($at->cookie_name);
+my $probe = $q->cookie('auth_probe');
+my $back = $q->cookie($at->back_cookie_name) if $at->back_cookie_name;
+#warn "back from cookie is $back\n" if $back;
+my $have_cookies = $ticket || $probe || $back || '';
+$back ||= $q->param($at->back_arg_name) if $at->back_arg_name;
+#warn "back from cgi param is $back\n" if $back;
+$back ||= $ENV{HTTP_REFERER} if $ENV{HTTP_REFERER} && $BACK_REFERER;
+$back = uri_unescape($back) if $back && $back =~ m/^https?%3A%2F%2F/i;
+$back =~ s/^http:/https:/ if $server_name ne 'localhost' && defined($back);
+#warn "back is $back\n";
+if ($back && $back =~ m!^/!) {
+  my $hostname = $server_name;
+  my $port = $server_port;
+  $hostname .= ':' . $port if $port && $port != 80 && $port != 443;
+  $back = sprintf "http%s://%s%s", ($port == 443 ? 's' : ''), $hostname, $back;
+#warn "back is $back\n";
+} elsif ($back && $back !~ m/^http/i) {
+  $back = 'http://' . $back;
+#warn "back is $back\n";
+}
+
+#warn "back is $back\n";
+my $back_esc = uri_escape($back) if $back;
+my $back_html = escapeHTML($back) if $back;
+
+my ($fatal, @errors);
+my ($mode, $location, $suffix) = fileparse($ENV{SCRIPT_NAME}, '\.cgi', '\.pl');
+$mode = 'login' unless $mode eq 'guest' || $mode eq 'autologin';
+my $self_redirect = $q->param('redirect') || 0;
+my $username = lc($q->param('username')||'');
+my $password = $q->param('password');
+my $timeout = $q->param('timeout');
+my $unauth = $q->param('unauth');
+my $ip_addr = $at->ignore_ip ? undef : $ENV{REMOTE_ADDR};
+my $redirected = 0;
+
+my $b = URI->new($back);
+# If $back domain doesn't match $AUTH_DOMAIN, stop there do not give opportunity to log in
+my $domain = $AUTH_DOMAIN || $server_name;
+if (! defined($back)) {
+    $fatal="Missing redirection parameter: \"back\" <br />\nPlease manually enter the address you were trying to reach if you followed a link.<br />\n";
+}
+if (defined($back) && $b->host !~ m/\b$domain$/i) {
+    $fatal="Bad redirection parameter: \"$back\" is not an authorized redirection.<br />\nYou may be experiencing an attack.<br />\nLogin is not possible on the above URL for your own security.<br />\nPlease manually enter the address you were trying to reach if you followed a link.";
+  }
+
+# ------------------------------------------------------------------------
+# Set the auth cookie and redirect to $back
+my $set_cookie_redirect = sub {
+  my ($tkt, $back) = @_;
+  my @expires = $at->cookie_expires ? 
+    ( -expires => sprintf("+%ss", $at->cookie_expires) ) :
+    ();
+  my $cookie = CGI::Cookie->new(
+    -name => $at->cookie_name,
+    -value => $tkt, 
+    -path => '/',
+    -secure => $at->require_ssl,
+    @expires,
+    @auth_domain,
+  );
+
+  # If no $back, just set the auth cookie and hope for the best
+  if (! $back) {
+    print $q->header( -cookie => $cookie );
+    print $q->start_html, $q->p("Login successful"), $q->end_html;
+    return 0;
+  }
+
+  # Set (local) cookie, and redirect to $back
+  print $q->header( -cookie => $cookie );
+#return 0 if $debug;
+
+  # For some reason, using a Location: header doesn't seem to then see the 
+  #   cookie, but a meta refresh one does - weird
+  print $q->start_html(
+    -head => meta({ -http_equiv => 'refresh', -content => "0;URL=$back" }),
+    ), 
+    $q->end_html;
+  return 1;
+};
+
+# ------------------------------------------------------------------------
+# Actual processing
+
+# If no cookies found, first check whether cookies are supported
+if (! $have_cookies) {
+  # If this is a self redirect warn the user about cookie support
+  if ($self_redirect) {
+    $fatal = "Your browser does not appear to support cookies or has cookie support disabled.<br />\nThis site requires cookies - please turn cookie support on or try again using a different browser.";
+  }
+  # If no cookies and not a redirect, redirect to self to test cookies
+  else {
+    my $extra = '';
+    $extra .= 'timeout=1' if $timeout;
+    $extra .= 'unauth=1' if $unauth;
+    $extra = "&$extra" if $extra;
+    print $q->header(
+      -cookie => CGI::Cookie->new(-name => 'auth_probe', -value => 1, @auth_domain),
+    );
+    # For some reason, a Location: redirect doesn't seem to then see the cookie,
+    #   but a meta refresh one does - go figure
+    print $q->start_html(
+      -head => meta({
+        -http_equiv => 'refresh', -content => ("0;URL=" . sprintf("%s%s%s?redirect=%s&%s=%s%s",
+          $location, $mode, $suffix, $self_redirect + 1, $at->back_arg_name, 
+          $back_esc || '', $extra))
+    }));
+    $redirected = 1;
+  }
+}
+
+elsif ($mode eq 'autologin') {
+  # If we have a ticket, redirect to $back, including ticket as GET param
+  if ($ticket && $back && ! $timeout) {
+    my $b = URI->new($back);
+    $back .= $b->query ? '&' : '?';
+    $back .= $at->cookie_name . '=' . $ticket;
+    print $q->redirect($back);
+    $redirected = 1;
+  }
+  # Can't autologin - change mode to either guest or login
+  else {
+    $mode = $AUTOLOGIN_FALLBACK_MODE;
+  }
+}
+
+unless ($fatal || $redirected) {
+  if (! $at) {
+    $fatal = "AuthTkt error: " . $at->errstr;
+  }
+  elsif ($mode eq 'login') {
+    if ($username && $validate_sub->($username, $password)) {
+#     my $user_data = join(':', encrypt($password), time(), $ip_addr);
+      my $user_data = join(':', time(), $ip_addr || '');    # Optional
+      my $tkt = $at->ticket(uid => $username, data => $user_data, ip_addr => $ip_addr, debug => $debug);
+      if (! @errors) {
+        $redirected = $set_cookie_redirect->($tkt, $back);
+        $fatal = "Login successful.";
+      }
+    }
+    elsif ($username) {
+      push @errors, "Invalid username or password.";
+    }
+  }
+
+  elsif ($mode eq 'guest') {
+    # Generate a guest ticket and redirect to $back
+    my $tkt = $at->ticket(uid => $guest_sub->(), ip_addr => $ip_addr);
+    if (! @errors) {
+      $redirected = $set_cookie_redirect->($tkt, $back);
+      $fatal = "No back link found.";
+    }
+  }
+}
+
+my @style = $STYLESHEET ? ('-style' => { src => $STYLESHEET }) : ();
+$TITLE ||= "\u$mode Page";
+unless ($redirected) {
+  # If here, either some kind of error or a login page
+  if ($fatal) {
+    print $q->header,
+      $q->start_html(
+        -title => $TITLE,
+        @style,
+      );
+  }
+  else {
+    push @errors, qq(Your session has timed out.) if $timeout;
+    push @errors, qq(You are not authorised to access this area.) if $unauth;
+    print $q->header,
+      $q->start_html(
+        -title => $TITLE,
+        -onLoad => "getFocus()",
+        @style,
+        -script => qq(
+function getFocus() {
+  document.forms[0].elements[0].focus();
+  document.forms[0].elements[0].select();
+}));
+  }
+  print <<EOD;
+<div align="center">
+<p>&nbsp;</p>
+<p>&nbsp;</p>
+<p>&nbsp;</p>
+<h2>Welcome to SME server</h2>
+EOD
+
+  if ($debug) {
+    my $cookie_name = $at->cookie_name;
+    my $back_cookie_name = $at->back_cookie_name || '';
+    my $back_cookie_path = $q->cookie($at->back_cookie_name) || '';
+    my $back_arg_name = $at->back_arg_name || '';
+    my $cookie_expires = $at->cookie_expires || 0;
+    my $referer = $ENV{HTTP_REFERER};
+    print <<EOD;
+<pre>
+server_name: $server_name
+server_port: $server_port
+domain: $AUTH_DOMAIN
+mode: $mode
+suffix: $suffix
+cookie_name: $cookie_name
+cookie_expires: $cookie_expires
+back_cookie_name: $back_cookie_name
+back_cookie_path: $back_cookie_path
+back_arg_name: $back_arg_name
+referer: $referer
+back: $back
+back_esc: $back_esc
+back_html: $back_html
+have_cookies: $have_cookies
+ip_addr: $ip_addr
+</pre>
+EOD
+  }
+
+  if ($fatal) {
+    print qq(<p class="error">$fatal</p>\n);
+  }
+
+  else {
+    print qq(<p class="error">\n), join(qq(<br />\n), @errors), "</p>\n"
+      if @errors;
+    print <<EOD;
+<form name="login" method="post" action="$mode$suffix">
+<table border="0" cellpadding="5">
+<tr><th>Username:</th><td><input type="text" name="username" /></td></tr>
+<tr><th>Password:</th><td><input type="password" name="password" /></td></tr>
+<tr><td colspan="2" align="center"> 
+<input type="submit" value="Login" />
+</td></tr>
+</table>
+EOD
+    print qq(<input type="hidden" name="back" value="$back_html" />\n) if $back_html;
+    print qq(</form>\n);
+}
+
+#  print qq(<p><a href="$back_html">Previous Page</a></p>\n) if $back_html;
+  print <<EOD;
+<!-- Start Donate section -->
+<p>Remember that SME Server is <i>free to download</i> and use, but it is <i><b>not</b>
+free to build</i></p>
+<p>Please help the project</p>
+<p><a href="https://wiki.koozali.org/Donate" target="_blank"><img
+src="../btn_donateCC_LG.gif"
+alt="https://wiki.koozali.org/Donate" align="middle"></a>
+</p>
+<p>-- The SME Server Team --</p>
+<!-- Finish Donate section -->
+</div>
+</body>
+</html>
+EOD
+}
+
+# arch-tag: 1cac856d-534c-4c81-9e9a-34e39d26f4f2
+# vim:sw=2:sm:cin
+

root/etc/e-smith/web/common/cgi-bin/logout

@@ -0,0 +1,127 @@
+#!/usr/bin/perl -w
+#
+# mod_auth_tkt sample logout script
+# 
+# Note that this needs script needs to be available locally on all domains 
+#   if using multiple domains (unlike login.cgi, which only needs to exist
+#   on one domain).
+#
+
+use File::Basename;
+use lib dirname($ENV{SCRIPT_FILENAME});
+use Apache::AuthTkt 0.03;
+use CGI qw(:standard);
+use URI::Escape;
+use URI;
+use strict;
+
+# ------------------------------------------------------------------------
+# Configure this section to taste
+
+# CSS stylesheet to use (optional)
+my $STYLESHEET = '/server-common/css/tkt.css';
+# Page title (optional)
+my $TITLE = '';
+# Boolean flag, whether to fallback to HTTP_REFERER for back link
+my $BACK_REFERER = 1;
+# Additional cookies to clear on logout e.g. PHPSESSID
+my @NUKE_COOKIES = qw();
+
+# ------------------------------------------------------------------------
+# Main code begins
+my $debug = 0;
+my $at = Apache::AuthTkt->new(conf => "/etc/e-smith/web/common/cgi-bin/AuthTKT.cfg");
+my $q = CGI->new;
+my ($server_name, $server_port) = split /:/, $q->http('X-Forwarded-Host') || $ENV{HTTP_HOST};
+#warn "servername is $server_name; HOST is $ENV{HTTP_HOST}\n";
+$server_name ||= $ENV{SERVER_NAME};
+$server_port = ( $server_name eq 'localhost' ) ? '80' : '443';
+my $AUTH_DOMAIN = $server_name;
+my $back = $q->cookie($at->back_cookie_name) if $at->back_cookie_name;
+$back ||= $q->param($at->back_arg_name) if $at->back_arg_name;
+$back ||= $ENV{HTTP_REFERER} if $BACK_REFERER;
+$back = "/server-manager/";
+if ($back && $back =~ m!^/!) {
+  my $hostname = $server_name;
+  my $port = $server_port;
+  $hostname .= ':' . $port if $port && $port != 80 && $port != 443;
+  $back = sprintf "http%s://%s%s", ($port == 443 ? 's' : ''), $hostname, $back;
+} elsif ($back && $back !~ m/^http/i) {
+  $back = 'http://' . $back;
+}
+$back = uri_unescape($back) if $back =~ m/^https?%3A%2F%2F/;
+my $back_html = escapeHTML($back) if $back;
+
+# Logout by resetting the auth cookie
+my @cookies = cookie(-name => $at->cookie_name, -value => '', -expires => '-1h', 
+    ($AUTH_DOMAIN && $AUTH_DOMAIN =~ /\./ ? (-domain => $AUTH_DOMAIN) : ()));
+push @cookies, map { cookie(-name => $_, -value => '', -expires => '-1h') } @NUKE_COOKIES;
+
+my $redirected = 0;
+if ($back) {
+  my $b = URI->new($back);
+  # If $back domain doesn't match $AUTH_DOMAIN, add ticket reset to back
+  if ($b->host !~ m/\b$AUTH_DOMAIN$/i) {
+    $back .= $b->query ? '&' : '?';
+    $back .= $at->cookie_name . '=';
+  }
+
+  if ($debug) {
+    print $q->header(-cookie => \@cookies);
+  }
+
+  else {
+    # Set (local) cookie, and redirect to $back
+    print $q->header(
+      -cookie => \@cookies,
+#     -location => $back,
+    );
+    # For some reason, a Location: redirect doesn't seem to then see the cookie,
+    #   but a meta refresh one does - weird
+    print $q->start_html(
+      -head => meta({
+        -http_equiv => 'refresh', -content => "0;URL=$back"
+    }));
+    $redirected = 1;
+  }
+}
+
+# If no $back, just set the auth cookie and hope for the best
+else {
+  print $q->header(-cookie => \@cookies);
+}
+
+my @style = $STYLESHEET ? ('-style' => { src => $STYLESHEET }) : ();
+$TITLE ||= 'Logout Page';
+unless ($redirected) {
+  # If here, either some kind of error or no back ref found
+  print $q->start_html(
+      -title => $TITLE,
+      @style,
+    );
+  print <<EOD;
+<div align="center">
+<h1>$TITLE</h1>
+EOD
+  if ($debug) {
+    print <<EOD;
+<pre>
+back: $back
+back_html: $back_html
+</pre>
+EOD
+  }
+  print <<EOD;
+<p>You are now logged out.</p>
+EOD
+  print qq(<p><a href="$back_html">Return to server manager login</a></p>\n) if $back_html;
+  print <<EOD;
+</div>
+</body>
+</html>
+EOD
+}
+
+# arch-tag: 09c96fc6-5119-4c79-8086-6c6b24951f96
+# vim:sw=2:sm:cin
+

root/etc/e-smith/web/common/configuration_report.tmpl

@@ -0,0 +1,53 @@
+Configuration report created {$report_creation_time}
+
+==================
+Base configuration
+==================
+
+SME server version: 	  {$releaseversion}
+SME server mode:    	  {$systemmode}
+SME server previous mode: {$previoussystemmode }
+Running Kernel:     	  {$curkernel}
+
+
+===========================
+New RPMs not in base system
+===========================
+        
+{ foreach $i (@newrpms) {
+            $OUT .= "$i";
+          }    
+} 
+
+
+
+===========================
+Custom and modified templates
+===========================
+{ foreach $i (@templates) {
+            $OUT .= "$i";
+          }
+}
+
+
+
+===========================
+Modified events
+===========================
+{ foreach $i (@events) {
+            $OUT .= "$i";
+          }
+}
+
+
+
+=======================
+Additional repositories
+=======================
+
+{ foreach $r (@repositories) {
+            $OUT .= "$r";
+          }
+}   		
+
+DONE!

root/etc/e-smith/web/common/css/tkt.css

@@ -0,0 +1,32 @@
+/* mod_auth_tkt example css */
+
+BODY {background-image: url(../smeserver_logo.jpg);
+	background-repeat: no-repeat;
+	background-position: 600px 40px;
+	background-position: top;
+
+    font-family: arial, helvetica, sans-serif;
+    font-size: small;
+}
+
+P, TH, TD {
+    font-family: arial, helvetica, sans-serif;
+    font-size: small;
+}
+
+H1, H2, H3, H4, H5, H6 { color: #006; }
+H1 { font-size: x-large; }
+H2 { font-size: large; }
+H3 { font-size: medium; }
+
+.warning { color: #c00; font-size: medium; font-weight: bold; }
+
+TABLE {
+    background-color: #eee;
+    color: #666;
+    border: 1px solid #ccc;
+    padding: 20px;
+}
+
+
+/* arch-tag: ac35e093-c2c0-4994-bc18-2d25715b1192 */

root/etc/e-smith/web/functions/bugreport

@@ -0,0 +1,59 @@
+#!/usr/bin/perl -wT
+ 
+#----------------------------------------------------------------------
+# heading     : Miscellaneous
+# description : Report a bug
+# navigation  : 7000 7300
+#
+# This program 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.
+#
+#----------------------------------------------------------------------
+
+use strict;
+use warnings;
+use esmith::TestUtils;
+use esmith::FormMagick::Panel::bugreport;
+
+my $f = esmith::FormMagick::Panel::bugreport->new();
+$f->display() if $f;
+
+=pod
+
+=head1 NAME
+
+bugreport -- report a bug
+
+=head2 DESCRIPTION
+
+This screen helps the administrator to submit helpful bug reports
+
+=begin testing
+
+=end testing
+
+=cut
+
+__DATA__
+<form
+     title="FORM_TITLE"
+     header="/etc/e-smith/web/common/head.tmpl"
+     footer="/etc/e-smith/web/common/foot.tmpl">
+ 
+     <page name="First" pre-event="print_status_message()"
+         post-event="create_configuration_report">
+         
+    	<subroutine src="display_page()"/>    
+    
+    	<subroutine src="print_button('CREATE_REPORT')" />
+         
+    	<subroutine src="display_donation()"/>      
+     </page>
+     
+     <page name="ConfigReportPage" >
+         <subroutine src="show_config_report()" />
+         
+     </page>
+</form>

root/etc/e-smith/web/functions/index.cgi

@@ -0,0 +1,36 @@
+#!/usr/bin/perl -wT
+
+#----------------------------------------------------------------------
+# copyright (C) 1999-2006 Mitel Networks Corporation
+# 
+# This program 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.
+# 		
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
+# 
+#----------------------------------------------------------------------
+
+use strict;
+use esmith::FormMagick;
+
+my $fm = new esmith::FormMagick;
+$fm->display();
+
+exit 0;
+
+__DATA__
+<form title="FORM_TITLE" header="/etc/e-smith/web/common/noframes_head.tmpl" footer="/etc/e-smith/web/common/noframes_foot.tmpl">
+    <page name="First">
+        <description>NOFRAMES_BODY</description>
+    </page>
+ 
+</form>

root/etc/e-smith/web/functions/initial.cgi

@@ -0,0 +1,36 @@
+#!/usr/bin/perl -wT
+
+#----------------------------------------------------------------------
+# copyright (C) 1999-2006 Mitel Networks Corporation
+# 
+# This program 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.
+# 		
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
+# 
+#----------------------------------------------------------------------
+use strict;
+use esmith::FormMagick;
+
+my $fm = new esmith::FormMagick;
+
+$fm->display();
+
+exit 0;
+
+__DATA__
+<form title="FORM_TITLE" header="/etc/e-smith/web/common/head.tmpl" footer="/etc/e-smith/web/common/foot.tmpl">
+    <page name="First">
+        <description>FRAMES_BODY</description>
+    </page>
+  
+</form>

root/etc/e-smith/web/functions/navigation

@@ -0,0 +1,340 @@
+#!/usr/bin/perl -wT
+
+#----------------------------------------------------------------------
+# e-smith manager functions: navigation
+#
+# copyright (C) 2002 Mitel Networks Corporation
+# 
+# This program 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.
+# 		
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
+# 
+# Technical support for this program is available from Mitel Networks 
+# Please visit our web site www.e-smith.com for details.
+#----------------------------------------------------------------------
+package esmith;
+
+use strict;
+use CGI ':no_xhtml', ':all';
+use CGI::Carp qw(fatalsToBrowser);
+
+use esmith::cgi;
+use esmith::config;
+use esmith::NavigationDB;
+use esmith::util;
+use esmith::I18N;
+
+sub determineGroup;
+sub showNavigation ($);
+
+BEGIN
+{
+    # Clear PATH and related environment variables so that calls to
+    # external programs do not cause results to be tainted. See
+    # "perlsec" manual page for details.
+
+    $ENV {'PATH'} = '';
+    $ENV {'SHELL'} = '/bin/bash';
+    delete $ENV {'ENV'};
+}
+
+esmith::util::setRealToEffective ();
+
+$CGI::POST_MAX=1024 * 100;  # max 100K posts
+$CGI::DISABLE_UPLOADS = 1;  # no uploads
+
+# Use the one script for navigation and noframes
+my $NO_FRAMES = ($0 =~ /noframes/);
+
+my %conf;
+tie %conf, 'esmith::config';
+
+my $q = new CGI;
+
+showNavigation ($q);
+exit (0);
+
+
+#------------------------------------------------------
+# subroutine to determine which group a user belongs to
+#------------------------------------------------------
+
+sub determineGroup
+{
+	my ($user) = shift;
+
+	# Group file for authentication
+	my $group_file = '/etc/group';
+	open ( GF, $group_file )
+	    or die "Cannot open group file: $group_file: $!\n";
+
+	# list of groups this user belongs to
+	my @groupList;
+	while (<GF>) 
+	{
+		if (/[:,]$user\b/) 
+		{
+			my ($groupName, undef) = split(/:/);
+			push @groupList, $groupName;
+		}
+	}
+	close GF;	
+	return @groupList;
+}
+
+#------------------------------------------------------------
+# subroutine to display navigation bar
+#------------------------------------------------------------
+
+sub showNavigation ($)
+{
+    my $q = shift;
+ 
+    # enable utf8 binmode so new translations work
+    binmode STDOUT, ":utf8";
+
+    # Use this variable throughout to keep track of files
+    # list of just the files
+    my $c = "1";
+    my @files = ();
+    my %files_hash = ();
+    my @panel_group = $ENV{'REMOTE_USER'} eq "admin" ?
+	("admin") : determineGroup($ENV{'REMOTE_USER'});
+	
+    #-----------------------------------------------------
+    # Determine the directory where the functions are kept
+    #----------------------------------------------------- 
+	
+    my $navigation_ignore = 
+	"(\.\.?|navigation|noframes|online-manual|(internal|pleasewait)(-.*)?)";
+
+    my $cgidir = 'nowhere';
+    if ($panel_group[0] eq 'admin')
+    {
+	$cgidir = '/etc/e-smith/web/panels/manager/cgi-bin/';
+
+	if (opendir (DIR, $cgidir))
+	{
+	    @files = grep (!/^${navigation_ignore}$/,
+		readdir (DIR));
+	    closedir (DIR);
+	}
+	else
+	{
+	    warn "Can't open directory $cgidir\n";
+	}
+
+	foreach my $file (@files)
+	{
+	    next if (-d "$cgidir/$file");
+	    $files_hash{$file} = $cgidir;
+	}
+    }
+    else
+    {
+	foreach	my $panel (@panel_group)
+	{
+	    $cgidir = "/etc/e-smith/web/panels/manager/$panel/cgi-bin";
+
+	    if (opendir (DIR, $cgidir))
+	    {
+		@files = grep (!/^${navigation_ignore}$/,
+		    readdir (DIR));
+		closedir (DIR);
+		foreach my $file (@files)
+		{
+		    next if (-d "$cgidir/$file");
+		    $files_hash{$file} = $cgidir;
+		}
+	    }
+	    else
+	    {
+		warn "Can't open directory $cgidir\n";
+	    }
+	}
+    }
+
+    #-------------------------------------------------- 
+    # For each script, extract the description and category
+    # information. Build up an associative array mapping headings
+    # to heading structures. Each heading structure contains the
+    # total weight for the heading, the number of times the heading
+    # has been encountered, and another associative array mapping
+    # descriptions to description structures. Each description
+    # structure contains the filename of the particular cgi script
+    # and a weight.
+    #-------------------------------------------------- 
+    my %nav = ();
+
+    use constant NAVIGATIONDIR => '/home/e-smith/db/navigation';
+    use constant WEBFUNCTIONS  => '/etc/e-smith/web/functions';
+
+    my $i18n = new esmith::I18N;
+
+    my $language = $i18n->preferredLanguage( $ENV{HTTP_ACCEPT_LANGUAGE} );
+
+    my $navinfo = NAVIGATIONDIR . "/navigation.$language";
+
+    my $navdb = esmith::NavigationDB->open_ro( $navinfo ) or
+	die "Couldn't open $navinfo\n";
+
+    # Check the navdb for anything with a UrlPath, which means that it doesn't
+    # have a cgi file to be picked up by the above code. Ideally, only pages
+    # that exist should be in the db, but that's not the case. Anything
+    # without a cgi file will have to remove themselves on uninstall from the
+    # navigation dbs.
+    foreach my $rec ($navdb->get_all)
+    {
+	if ($rec->prop('UrlPath'))
+	{
+	    $files_hash{$rec->{key}} = $cgidir;
+	}
+    }
+
+    foreach my $file (keys %files_hash)
+    {
+	my $heading = 'Unknown';
+	my $description = $file;
+	my $headingWeight = 99999;
+	my $descriptionWeight = 99999;
+	my $urlpath = '';
+
+	my $rec = $navdb->get($file);
+
+	if (defined $rec)
+	{
+	    $heading = $rec->prop('Heading');
+	    $description = $rec->prop('Description');
+	    $headingWeight = $rec->prop('HeadingWeight');
+	    $descriptionWeight = $rec->prop('DescriptionWeight');
+	    $urlpath = $rec->prop('UrlPath') || '';
+	}
+
+	#-------------------------------------------------- 
+	# add heading, description and weight information to data structure
+	#-------------------------------------------------- 
+
+	unless (exists $nav {$heading})
+	{
+	    $nav {$heading} = { COUNT => 0, WEIGHT => 0, DESCRIPTIONS => [] };
+	}
+
+	$nav {$heading} {'COUNT'} ++;
+	$nav {$heading} {'WEIGHT'} += $headingWeight;
+
+	# Check for manager panel, and assign the appropriate
+	#  cgi-bin prefix for the links.
+	# Grab the last 2 directories by splitting for '/'s and
+	#  then concatenating the last 2
+	# probably a better way, but I don't know it.
+	my @filename = split /\//, $files_hash{$file};
+	my $path = ($cgidir eq '/etc/e-smith/web/panels/manager/cgi-bin/') ? 
+	    "/$filename[scalar @filename - 1]" : 
+	    "/$filename[scalar @filename - 2]/$filename[scalar @filename - 1]";
+	
+	push @{ $nav {$heading} {'DESCRIPTIONS'} },
+		{ DESCRIPTION => $description,
+		  WEIGHT => $descriptionWeight, 
+		  FILENAME => $urlpath ? $urlpath : "$path/$file",
+		  CGIPATH => $path
+		};
+    }
+
+    #-------------------------------------------------- 
+    # generate list of headings sorted by average weight
+    #-------------------------------------------------- 
+    if ( $NO_FRAMES )
+    {
+	esmith::cgi::genNoframesHeader ($q);
+    }
+    else
+    {
+        esmith::cgi::genNavigationHeader ($q, undef);
+	print "\n<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"0\">\n";
+    }
+
+  print '<script language="JavaScript" type="text/javascript">
+  <!-- Hide script
+  //This swap the class of the selected item.
+    function swapClass() {
+    var i,x,tB,j=0,tA=new Array(),arg=swapClass.arguments;
+    if(document.getElementsByTagName){for(i=4;i<arg.length;i++){tB=document.getElementsByTagName(arg[i]);
+    for(x=0;x<tB.length;x++){tA[j]=tB[x];j++;}}for(i=0;i<tA.length;i++){
+    if(tA[i].className){if(tA[i].id==arg[1]){if(arg[0]==1){
+    tA[i].className=(tA[i].className==arg[3])?arg[2]:arg[3];}else{tA[i].className=arg[2];}
+    }else if(arg[0]==1 && arg[1]==\'none\'){if(tA[i].className==arg[2] || tA[i].className==arg[3]){
+    tA[i].className=(tA[i].className==arg[3])?arg[2]:arg[3];}
+    }else if(tA[i].className==arg[2]){tA[i].className=arg[3];}}}}}
+    ';
+    print "
+  //This swap the class of the selected item.
+    function swapClasses() {
+    var arg=swapClasses.arguments;
+    swapClass(0,'none','item-current','item','a');
+    swapClass(0,'none','warn-current','warn','a');
+    swapClass(0,arg[0],'item-current','item','a');
+    }
+
+    // End script hiding -->
+    </script>
+    ";
+
+    foreach my $h (sort {
+	 ($nav{$a}{'WEIGHT'}/$nav{$a}{'COUNT'}) <=>
+	($nav{$b}{'WEIGHT'}/$nav{$b}{'COUNT'}) } keys %nav)
+    {
+        if ( $NO_FRAMES )
+	{
+	    print $q->h2 ($h);
+	}
+	else
+	{
+	    print "\n", $q->Tr ($q->td({class => "section"},$q->span({class => "section"}, $h)));
+	}
+
+	#-------------------------------------------------- 
+	# generate list of descriptions sorted by weight
+	#-------------------------------------------------- 
+        print "<ul>\n" if ( $NO_FRAMES );
+
+	foreach (sort { $a->{'WEIGHT'} <=> $b->{'WEIGHT'} }  @{$nav {$h}{'DESCRIPTIONS'}})
+	{
+	    my $href = "/server-manager" .  $_->{'FILENAME'};
+	    if ( $NO_FRAMES )
+	    {
+		print $q->li ($q->a ({href => "$href?noframes=1"}, $_->{'DESCRIPTION'}));
+	    }
+	    else
+  	    {
+		print "\n",$q->Tr(
+			     $q->td ({-class => "menu-cell"},
+				     $q->a ({-id => "sme$c",
+                                            -class => "item",
+                                            -onClick => "swapClasses('sme$c')",
+                                            href => $href, 
+                                            target => 'main'}, 
+                                        $_->{'DESCRIPTION'})
+				     ));
+                        }
+                        $c++;
+                        
+	}
+        print "</ul>\n" if ($NO_FRAMES);
+    }
+
+    unless ( $NO_FRAMES )
+    {
+	print "\n</TABLE>\n";
+        esmith::cgi::genNavigationFooter ($q);
+    }
+}

root/etc/e-smith/web/functions/noframes

@@ -0,0 +1 @@
+navigation