initial commit of file from CVS for smeserver-userpanel on Sat Sep 7 21:12:39 AEST 2024
This commit is contained in:
8
root/etc/e-smith/events/actions/conf-linktotranslations
Normal file
8
root/etc/e-smith/events/actions/conf-linktotranslations
Normal file
@@ -0,0 +1,8 @@
|
||||
#!/bin/bash
|
||||
trad=`/usr/bin/ls /etc/e-smith/locale/`
|
||||
for lang in $trad
|
||||
do
|
||||
/bin/mkdir -p /etc/e-smith/locale/$lang/etc/e-smith/web/panels/user
|
||||
/bin/ln -sf /etc/e-smith/locale/$lang/etc/e-smith/web/functions /etc/e-smith/locale/$lang/etc/e-smith/web/panels/user/cgi-bin
|
||||
done
|
||||
|
86
root/etc/e-smith/events/actions/conf-userpanelsymlinks
Normal file
86
root/etc/e-smith/events/actions/conf-userpanelsymlinks
Normal file
@@ -0,0 +1,86 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
#
|
||||
# Copyright (c) 2001 Daniel van Raay
|
||||
#
|
||||
# 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
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package esmith;
|
||||
|
||||
use strict;
|
||||
use Errno;
|
||||
use esmith::config;
|
||||
use esmith::util;
|
||||
use esmith::db;
|
||||
|
||||
my %conf;
|
||||
tie %conf, 'esmith::config';
|
||||
|
||||
my %accounts;
|
||||
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
||||
|
||||
#---------------------------------------------------------------------------
|
||||
# clear and re-create all the user panel symlinks
|
||||
#---------------------------------------------------------------------------
|
||||
|
||||
#clear
|
||||
opendir (DIR, "/etc/e-smith/web/panels/user/cgi-bin/") or
|
||||
die "Can't open directory /etc/e-smith/web/panels/user/cgi-bin/\n";
|
||||
my @symlinks = grep (!/^\./, readdir (DIR));
|
||||
closedir (DIR);
|
||||
|
||||
foreach my $link (@symlinks)
|
||||
{
|
||||
-e "/etc/e-smith/web/panels/user/cgi-bin/$link" && unlink("/etc/e-smith/web/panels/user/cgi-bin/$link");
|
||||
}
|
||||
|
||||
#always link userpanels
|
||||
my %newsymlinks;
|
||||
opendir (DIR, "/etc/e-smith/web/functions/") or
|
||||
die "Can't open directory /etc/e-smith/web/functions/\n";
|
||||
foreach my $userpanels ( grep (/^(userpanel-initial|userpanel-navigation|userpanel-noframes|pleasewait)$/, readdir (DIR)) )
|
||||
{
|
||||
$newsymlinks{$userpanels} = 'Yes';
|
||||
}
|
||||
closedir (DIR);
|
||||
|
||||
#also add needed panels
|
||||
foreach my $user (sort keys %accounts)
|
||||
{
|
||||
my $userAdminPanels = db_get_prop(\%accounts, $user, "AdminPanels");
|
||||
$userAdminPanels = '' if ! defined ($userAdminPanels);
|
||||
|
||||
foreach my $panels (split (/,/, $userAdminPanels))
|
||||
{
|
||||
$newsymlinks{$panels} = 'Yes';
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $link ( sort keys %newsymlinks )
|
||||
{
|
||||
if ( -e "/etc/e-smith/web/functions/$link" &&
|
||||
! -e "/etc/e-smith/web/panels/user/cgi-bin/$link" )
|
||||
{
|
||||
symlink("../../../functions/wrapper", "/etc/e-smith/web/panels/user/cgi-bin/$link") ||
|
||||
#link("/etc/e-smith/web/functions/$link", "/etc/e-smith/web/panels/user/cgi-bin/$link") ||
|
||||
warn "Couldn't link('functions/$link' to '/etc/e-smith/web/panels/user/cgi-bin/$link'): $!\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
exit (0);
|
||||
|
@@ -0,0 +1,315 @@
|
||||
{
|
||||
$OUT =<<'HERE';
|
||||
/*------------------------------------------------------------
|
||||
* Default properties
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
body
|
||||
{
|
||||
background: #ffffff;
|
||||
color: #000000;
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
font-size: 10pt;
|
||||
border-width: 0
|
||||
}
|
||||
|
||||
/* Netscape 4 needs these basic settings in order to render default font properly */
|
||||
p
|
||||
{
|
||||
color: #000000;
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
}
|
||||
|
||||
table td
|
||||
{
|
||||
color: #000000;
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
font-size: 10pt;
|
||||
}
|
||||
|
||||
td {
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
font-size: 10pt;
|
||||
}
|
||||
table td div {
|
||||
background: transparent;
|
||||
font-size: 10pt;
|
||||
}
|
||||
|
||||
p.notsmall {
|
||||
font-size: 10pt;
|
||||
}
|
||||
|
||||
/* End Netscape-isms (for the moment <sigh>) */
|
||||
|
||||
.centerit
|
||||
{
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
div
|
||||
{
|
||||
margin-top: 10px;
|
||||
margin-bottom: 10px;
|
||||
}
|
||||
|
||||
.highlight
|
||||
{
|
||||
background: #ffc61e;
|
||||
}
|
||||
|
||||
.subheading
|
||||
{
|
||||
background: #ffffff;
|
||||
color: #1e385b;
|
||||
}
|
||||
/*------------------------------------------------------------
|
||||
* Properties for headings
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
|
||||
h1
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
color: #000099
|
||||
}
|
||||
|
||||
h2
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
color: #000099
|
||||
}
|
||||
|
||||
h3
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
color: #000099
|
||||
}
|
||||
|
||||
h4
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
font-style: italic
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for lists
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
ul
|
||||
{
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
list-style-type: square;
|
||||
|
||||
}
|
||||
|
||||
ol {
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
font-size: 80%;
|
||||
color: #1e385b;
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for list items
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
ol ul li
|
||||
{
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
font-size: 80%;
|
||||
font-weight: normal;
|
||||
color: #000000;
|
||||
}
|
||||
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for tables
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
/* Removed -- see default table font above... */
|
||||
/* td
|
||||
{
|
||||
font-family: Times
|
||||
}
|
||||
*/
|
||||
|
||||
table
|
||||
{
|
||||
margin-top: 0px;
|
||||
margin-bottom: 0px;
|
||||
margin-left: 0px;
|
||||
margin-right: 0px;
|
||||
}
|
||||
/* left margin and center [sic] table classes */
|
||||
|
||||
.banner
|
||||
{
|
||||
background: #000000;
|
||||
color: #ffffff;
|
||||
}
|
||||
|
||||
.banner-right
|
||||
{
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
background: #e17200;
|
||||
color: #ffffff;
|
||||
}
|
||||
|
||||
.border
|
||||
{
|
||||
background: #000000;
|
||||
color: #000000;
|
||||
border-color: #000000;
|
||||
}
|
||||
.sidebar
|
||||
{
|
||||
width: 200px;
|
||||
background: #ffffff;
|
||||
font-size: smaller;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
.sidebar-title
|
||||
{
|
||||
background: #1e385b;
|
||||
color: #ffffff;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.newsitem
|
||||
{
|
||||
background: #ffffff;
|
||||
font-color: #000000;
|
||||
font: arial,helvetica,sans-serif;
|
||||
margin-left: 5px;
|
||||
margin-right: 5px;
|
||||
margin-top: 5px;
|
||||
margin-bottom: 5px;
|
||||
}
|
||||
|
||||
.newsitem-title
|
||||
{
|
||||
background: #cccccc;
|
||||
font-color: #ffffff;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.newsitem-footer
|
||||
{
|
||||
background: #cccccc;
|
||||
color: #000000;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-size: smaller;
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
.newsitem-detail
|
||||
{
|
||||
font-size: smaller;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
.formlabel
|
||||
{
|
||||
background: #c0c0c0;
|
||||
color: #000000;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-size: small;
|
||||
font-weight: bold;
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for title tables
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
th
|
||||
{
|
||||
/* font-family: Helvetica,Arial; */
|
||||
background: #F7E0B5;
|
||||
color: #000000
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for the copyright notice on the bottom
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
.copyright
|
||||
{
|
||||
font-family: Times;
|
||||
font-size: smaller
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for the clickable links
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
/* Netscape 4 can't use these. Default ANCHOR setting follows... */
|
||||
a:link, A:visited, A:active
|
||||
{
|
||||
color: #00008b
|
||||
}
|
||||
|
||||
a
|
||||
{
|
||||
color: #00008b;
|
||||
}
|
||||
|
||||
/* link styles for index.php3 (i.e. welcome page) */
|
||||
.welcome-link
|
||||
{
|
||||
background: #ffffff;
|
||||
color: #1e385b;
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for the littlelinks
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
.littlelink
|
||||
{
|
||||
font-family: helvetica,arial,sans-serif;
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Style for positioning text
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
#textlayer
|
||||
{
|
||||
position: absolute;
|
||||
visibility: inherit;
|
||||
top: 160px;
|
||||
left: 50px;
|
||||
z-index: 2
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Style for bold paragraph text
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
#para
|
||||
{
|
||||
font-family: helvetica,arial,sans-serif;
|
||||
font-weight: bold;
|
||||
color: #000000
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
*
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
#title
|
||||
{
|
||||
font-family: helvetica,arial,sans-serif;
|
||||
font-weight: bold;
|
||||
padding: 7px 7px 7px 7px;
|
||||
color: #ffffff
|
||||
}
|
||||
|
||||
HERE
|
||||
}
|
@@ -0,0 +1 @@
|
||||
/* DO NOT MODIFY THIS FILE! It is updated automatically */
|
@@ -0,0 +1,10 @@
|
||||
|
||||
# Aliases for the e-smith-user panel:
|
||||
ScriptAlias /user-manager/cgi-bin /etc/e-smith/web/panels/user/cgi-bin
|
||||
Alias /user-manager /etc/e-smith/web/panels/user/html
|
||||
{
|
||||
my $UserAlias = ${UserPanelAlias} || 'user';
|
||||
$OUT .= " ScriptAlias /$UserAlias/cgi-bin /etc/e-smith/web/panels/user/cgi-bin\n";
|
||||
$OUT .= " Alias /$UserAlias /etc/e-smith/web/panels/user/html\n";
|
||||
}
|
||||
|
@@ -0,0 +1,92 @@
|
||||
|
||||
#------------------------------------------------------------
|
||||
# e-smith-user panel
|
||||
#------------------------------------------------------------
|
||||
{
|
||||
use esmith::db;
|
||||
|
||||
my %accounts;
|
||||
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
||||
|
||||
my %panelshash;
|
||||
opendir (DIR, "/etc/e-smith/web/panels/user/cgi-bin")
|
||||
|| die "Can't open /etc/e-smith/web/panels/user/cgi-bin directory.\n";
|
||||
|
||||
my @files = sort (grep (!/(^\.\.?$)|(^pleasewait$)|(^userpanel-[a-z][\-\_a-z0-9]*)/, readdir(DIR)));
|
||||
|
||||
closedir (DIR);
|
||||
|
||||
my $globalpanels = db_get_prop(\%accounts, 'globalUP', 'AdminPanels');
|
||||
$globalpanels = '' if ( ! defined ($globalpanels) );
|
||||
my @globalpanels = split (/,/, $globalpanels, -1);
|
||||
|
||||
my $key;
|
||||
my $value;
|
||||
my $require = "require user ";
|
||||
while (($key,$value) = each %accounts)
|
||||
{
|
||||
my ($type, %properties) = split (/\|/, $value, -1);
|
||||
if ($type eq 'user')
|
||||
{
|
||||
# Build the all-users require line:
|
||||
$require .= " $key";
|
||||
|
||||
foreach $file (@files)
|
||||
{
|
||||
next if ($globalpanels && grep (/^$file$/, @globalpanels));
|
||||
|
||||
my $adminpanels = db_get_prop(\%accounts, $key, 'AdminPanels');
|
||||
if ( defined $adminpanels )
|
||||
{
|
||||
my @adminpanels = split (/,/, $adminpanels, -1);
|
||||
if (grep (/^$file$/, @adminpanels))
|
||||
{
|
||||
# Build a files require line for each panel
|
||||
$panelshash{$file} .= " $key"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$OUT .= <<HERE;
|
||||
<Directory \"/etc/e-smith/web/panels/user/html\" >
|
||||
Options Includes Indexes FollowSymLinks
|
||||
AllowOverride None
|
||||
AuthName "SME User manager"
|
||||
AuthType Basic
|
||||
TKTAuthLoginURL /server-common/cgi-bin/login
|
||||
SetEnv IMGHDR_SRC \"/e-smith-common/server-manager.jpg\"
|
||||
<RequireAll>
|
||||
require valid-user
|
||||
Require ip $localAccess
|
||||
</RequireAll>
|
||||
</Directory>
|
||||
|
||||
<Directory \"/etc/e-smith/web/panels/user/cgi-bin\" >
|
||||
Options Includes Indexes FollowSymLinks
|
||||
AllowOverride None
|
||||
AuthName "SME User Manager"
|
||||
AuthType Basic
|
||||
TKTAuthLoginURL /server-common/cgi-bin/login
|
||||
SetEnv IMGHDR_SRC \"/e-smith-common/server-manager.jpg\"
|
||||
<RequireAll>
|
||||
require valid-user
|
||||
Require ip $localAccess
|
||||
</RequireAll>
|
||||
HERE
|
||||
|
||||
foreach $file (@files)
|
||||
{
|
||||
next unless ( defined ($panelshash{$file}) );
|
||||
$OUT .= "\n";
|
||||
$OUT .= " <Files $file>\n";
|
||||
$OUT .= " AuthName \"SME User manager\"\n";
|
||||
$OUT .= " AuthType Basic\n";
|
||||
$OUT .= " TKTAuthLoginURL /server-common/cgi-bin/login\n";
|
||||
$OUT .= " require user admin$panelshash{$file}\n";
|
||||
$OUT .= " </Files>\n";
|
||||
}
|
||||
|
||||
$OUT .= "</Directory>\n";
|
||||
}
|
@@ -0,0 +1,29 @@
|
||||
{
|
||||
# vim: ft=perl:
|
||||
|
||||
$haveSSL = (exists ${modSSL}{status} and ${modSSL}{status} eq "enabled") ? 'yes' : 'no';
|
||||
$plainTextAccess = ${'httpd-admin'}{PermitPlainTextAccess} || 'no';
|
||||
$UserAlias = ${UserPanelAlias} || 'user';
|
||||
|
||||
|
||||
$OUT = '';
|
||||
foreach $place ('user-manager',$UserAlias)
|
||||
{
|
||||
if (($port eq "80") && ($haveSSL eq 'yes') && ($plainTextAccess ne 'yes'))
|
||||
{
|
||||
$OUT .= " RewriteRule ^/$place(/.*|\$) https://%{HTTP_HOST}/$place\$1 [L,R]\n";
|
||||
} else {
|
||||
$OUT .= " ProxyPass /$place http://127.0.0.1:${'httpd-admin'}{TCPPort}/$place\n";
|
||||
$OUT .= " ProxyPassReverse /$place http://127.0.0.1:${'httpd-admin'}{TCPPort}/$place\n";
|
||||
}
|
||||
|
||||
$OUT .= " <Location /$place>\n";
|
||||
if (($haveSSL eq 'yes') && (($port eq "443") || ($plainTextAccess ne 'yes')))
|
||||
{
|
||||
$OUT .= " Require ip $localAccess $externalSSLAccess\n";
|
||||
} else {
|
||||
$OUT .= " Require ip $localAccess\n";
|
||||
}
|
||||
$OUT .= " </Location>\n";
|
||||
}
|
||||
}
|
128
root/etc/e-smith/web/common/cgi-bin/logout-user
Normal file
128
root/etc/e-smith/web/common/cgi-bin/logout-user
Normal file
@@ -0,0 +1,128 @@
|
||||
#!/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 ||= $ENV{SERVER_PORT};
|
||||
$server_port = '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 = "/user-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
|
||||
|
310
root/etc/e-smith/web/common/css/manager.css
Normal file
310
root/etc/e-smith/web/common/css/manager.css
Normal file
@@ -0,0 +1,310 @@
|
||||
/*------------------------------------------------------------
|
||||
* Default properties
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
body
|
||||
{
|
||||
background: #ffffff;
|
||||
color: #000000;
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
font-size: 10pt;
|
||||
border-width: 0
|
||||
}
|
||||
|
||||
/* Netscape 4 needs these basic settings in order to render default font properly */
|
||||
p
|
||||
{
|
||||
color: #000000;
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
}
|
||||
|
||||
table td
|
||||
{
|
||||
color: #000000;
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
font-size: 10pt;
|
||||
}
|
||||
|
||||
td {
|
||||
font-family: verdana,arial,helvetica,sans-serif;
|
||||
font-size: 10pt;
|
||||
}
|
||||
table td div {
|
||||
background: transparent;
|
||||
font-size: 10pt;
|
||||
}
|
||||
|
||||
p.notsmall {
|
||||
font-size: 10pt;
|
||||
}
|
||||
|
||||
/* End Netscape-isms (for the moment <sigh>) */
|
||||
|
||||
.centerit
|
||||
{
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
div
|
||||
{
|
||||
margin-top: 10px;
|
||||
margin-bottom: 10px;
|
||||
}
|
||||
|
||||
.highlight
|
||||
{
|
||||
background: #ffc61e;
|
||||
}
|
||||
|
||||
.subheading
|
||||
{
|
||||
background: #ffffff;
|
||||
color: #1e385b;
|
||||
}
|
||||
/*------------------------------------------------------------
|
||||
* Properties for headings
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
|
||||
h1
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
color: #000099
|
||||
}
|
||||
|
||||
h2
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
color: #000099
|
||||
}
|
||||
|
||||
h3
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
color: #000099
|
||||
}
|
||||
|
||||
h4
|
||||
{
|
||||
font-family: verdana,helvetica,arial,sans-serif;
|
||||
font-style: italic
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for lists
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
ul
|
||||
{
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
list-style-type: square;
|
||||
|
||||
}
|
||||
|
||||
ol {
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
font-size: 80%;
|
||||
color: #1e385b;
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for list items
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
ol ul li
|
||||
{
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
font-size: 80%;
|
||||
font-weight: normal;
|
||||
color: #000000;
|
||||
}
|
||||
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for tables
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
/* Removed -- see default table font above... */
|
||||
/* td
|
||||
{
|
||||
font-family: Times
|
||||
}
|
||||
*/
|
||||
|
||||
table
|
||||
{
|
||||
margin-top: 0px;
|
||||
margin-bottom: 0px;
|
||||
margin-left: 0px;
|
||||
margin-right: 0px;
|
||||
}
|
||||
/* left margin and center [sic] table classes */
|
||||
|
||||
.banner
|
||||
{
|
||||
background: #000000;
|
||||
color: #ffffff;
|
||||
}
|
||||
|
||||
.banner-right
|
||||
{
|
||||
font-family: arial,helvetica,sans-serif;
|
||||
background: #e17200;
|
||||
color: #ffffff;
|
||||
}
|
||||
|
||||
.border
|
||||
{
|
||||
background: #000000;
|
||||
color: #000000;
|
||||
border-color: #000000;
|
||||
}
|
||||
.sidebar
|
||||
{
|
||||
width: 200px;
|
||||
background: #ffffff;
|
||||
font-size: smaller;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
.sidebar-title
|
||||
{
|
||||
background: #1e385b;
|
||||
color: #ffffff;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.newsitem
|
||||
{
|
||||
background: #ffffff;
|
||||
font-color: #000000;
|
||||
font: arial,helvetica,sans-serif;
|
||||
margin-left: 5px;
|
||||
margin-right: 5px;
|
||||
margin-top: 5px;
|
||||
margin-bottom: 5px;
|
||||
}
|
||||
|
||||
.newsitem-title
|
||||
{
|
||||
background: #cccccc;
|
||||
font-color: #ffffff;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.newsitem-footer
|
||||
{
|
||||
background: #cccccc;
|
||||
color: #000000;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-size: smaller;
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
.newsitem-detail
|
||||
{
|
||||
font-size: smaller;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
.formlabel
|
||||
{
|
||||
background: #c0c0c0;
|
||||
color: #000000;
|
||||
font: arial,helvetica,sans-serif;
|
||||
font-size: small;
|
||||
font-weight: bold;
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for title tables
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
th
|
||||
{
|
||||
/* font-family: Helvetica,Arial; */
|
||||
background: #F7E0B5;
|
||||
color: #000000
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for the copyright notice on the bottom
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
.copyright
|
||||
{
|
||||
font-family: Times;
|
||||
font-size: smaller
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for the clickable links
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
/* Netscape 4 can't use these. Default ANCHOR setting follows... */
|
||||
a:link, A:visited, A:active
|
||||
{
|
||||
color: #00008b
|
||||
}
|
||||
|
||||
a
|
||||
{
|
||||
color: #00008b;
|
||||
}
|
||||
|
||||
/* link styles for index.php3 (i.e. welcome page) */
|
||||
.welcome-link
|
||||
{
|
||||
background: #ffffff;
|
||||
color: #1e385b;
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Properties for the littlelinks
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
.littlelink
|
||||
{
|
||||
font-family: helvetica,arial,sans-serif;
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Style for positioning text
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
#textlayer
|
||||
{
|
||||
position: absolute;
|
||||
visibility: inherit;
|
||||
top: 160px;
|
||||
left: 50px;
|
||||
z-index: 2
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
* Style for bold paragraph text
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
#para
|
||||
{
|
||||
font-family: helvetica,arial,sans-serif;
|
||||
font-weight: bold;
|
||||
color: #000000
|
||||
}
|
||||
|
||||
/*------------------------------------------------------------
|
||||
*
|
||||
*------------------------------------------------------------*/
|
||||
|
||||
#title
|
||||
{
|
||||
font-family: helvetica,arial,sans-serif;
|
||||
font-weight: bold;
|
||||
padding: 7px 7px 7px 7px;
|
||||
color: #ffffff
|
||||
}
|
135
root/etc/e-smith/web/functions/userpanel-initial
Normal file
135
root/etc/e-smith/web/functions/userpanel-initial
Normal file
@@ -0,0 +1,135 @@
|
||||
#!/usr/bin/perl -wT
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
# user manager functions: initial
|
||||
#
|
||||
# Copyright (c) 2001 Daniel van Raay <danielvr@caa.org.au>
|
||||
#
|
||||
# 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
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package esmith;
|
||||
|
||||
use strict;
|
||||
use CGI ':all';
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
|
||||
use esmith::cgi;
|
||||
use esmith::config;
|
||||
use esmith::util;
|
||||
use esmith::db;
|
||||
|
||||
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
|
||||
|
||||
my %conf;
|
||||
tie %conf, 'esmith::config';
|
||||
|
||||
my %accounts;
|
||||
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
||||
|
||||
my $q = new CGI;
|
||||
|
||||
esmith::cgi::genHeaderNonCacheable ($q, \%conf, 'Smeserver User Manager');
|
||||
|
||||
print <<EOF;
|
||||
|
||||
<P>To perform a user administration function, click one of the
|
||||
links in the menu on the left of your screen. If your admin allows it,
|
||||
you can:
|
||||
|
||||
<ul>
|
||||
EOF
|
||||
|
||||
my $user = $ENV{'REMOTE_USER'};
|
||||
|
||||
my $userAdminPanels = db_get_prop(\%accounts, $user, 'AdminPanels');
|
||||
$userAdminPanels = '' if ! defined ($userAdminPanels);
|
||||
|
||||
my $globalAdminPanels = db_get_prop(\%accounts, 'globalUP', 'AdminPanels');
|
||||
$globalAdminPanels = '' if ! defined ($globalAdminPanels);
|
||||
|
||||
my @adminpanels;
|
||||
if ( defined ($userAdminPanels) )
|
||||
{
|
||||
@adminpanels = grep (/^userpanel-/, ((split (/,/, $userAdminPanels, -1)),(split (/,/, $globalAdminPanels, -1))));
|
||||
}
|
||||
|
||||
my $panel;
|
||||
my %panelhash = ();
|
||||
my $desc;
|
||||
my $longdesc;
|
||||
foreach $panel (@adminpanels)
|
||||
{
|
||||
unless (open (RD, "/etc/e-smith/web/panels/user/cgi-bin/$panel"))
|
||||
{
|
||||
warn "Can't open file /etc/e-smith/web/panels/user/cgi-bin/$panel: $!\n";
|
||||
next;
|
||||
}
|
||||
|
||||
$desc = "";
|
||||
$longdesc = "";
|
||||
while (<RD>)
|
||||
{
|
||||
if (/^\s*#\s*description\s*:\s*(.+?)\s*$/)
|
||||
{
|
||||
$desc = $1;
|
||||
}
|
||||
if (/^\s*#\s*longdesc\s*:\s*(.+?)\s*$/)
|
||||
{
|
||||
$longdesc = $1;
|
||||
}
|
||||
|
||||
last if ( $desc && $longdesc );
|
||||
}
|
||||
close RD;
|
||||
|
||||
if ($desc && $longdesc)
|
||||
{
|
||||
$panelhash{$desc} = $longdesc;
|
||||
}
|
||||
}
|
||||
|
||||
foreach $panel (sort keys %panelhash)
|
||||
{
|
||||
print "<li><b>$panel</b> - <i>$panelhash{$panel}</i></li>\n";
|
||||
}
|
||||
|
||||
print <<EOF;
|
||||
</ul>
|
||||
|
||||
<P>This software comes with ABSOLUTELY NO WARRANTY. As part of our
|
||||
commitment to open-source software, you are welcome to copy and
|
||||
redistribute this software.
|
||||
|
||||
EOF
|
||||
|
||||
print $q->endform;
|
||||
|
||||
esmith::cgi::genFooter ($q);
|
||||
|
371
root/etc/e-smith/web/functions/userpanel-navigation
Normal file
371
root/etc/e-smith/web/functions/userpanel-navigation
Normal file
@@ -0,0 +1,371 @@
|
||||
#!/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::ConfigDB;
|
||||
use esmith::util;
|
||||
use esmith::I18N;
|
||||
use esmith::db;
|
||||
|
||||
sub determineGroup;
|
||||
sub showNavigation;
|
||||
sub logmeout;
|
||||
sub byweight;
|
||||
|
||||
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 %accounts;
|
||||
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
||||
|
||||
my $q = new CGI;
|
||||
|
||||
showNavigation ($q);
|
||||
logmeout($q);
|
||||
|
||||
exit (0);
|
||||
|
||||
#------------------------------------------------------
|
||||
# subroutine to print logout
|
||||
#------------------------------------------------------
|
||||
sub logmeout
|
||||
{
|
||||
my $user = $ENV{'REMOTE_USER'};
|
||||
|
||||
print <<EOF;
|
||||
<table width="100%" border="0" cellspacing="0" cellpadding="0">
|
||||
<tr>
|
||||
<td align=left nowrap class="infobar">
|
||||
<img src="/server-common/spacer.gif" height="14" width="1" align="left">
|
||||
</td>
|
||||
<td align=left nowrap class="infobar">
|
||||
$user
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td align=left nowrap class="infobar">
|
||||
<img src="/server-common/spacer.gif" height="14" width="1" align="left">
|
||||
</td>
|
||||
<td align=left nowrap class="infobar">
|
||||
<a target="_parent" href="/server-common/cgi-bin/logout-user"><b>Logout</b></a></td>
|
||||
|
||||
</tr>
|
||||
</table>
|
||||
EOF
|
||||
|
||||
|
||||
}
|
||||
|
||||
#------------------------------------------------------
|
||||
# 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;
|
||||
|
||||
my $acctName = $ENV{'REMOTE_USER'};
|
||||
my @adminpanels;
|
||||
|
||||
my $UserAlias = $conf{UserPanelAlias} || 'user';
|
||||
|
||||
my $availablePanels = db_get_prop(\%accounts, $acctName, 'AdminPanels') || '';
|
||||
push (@adminpanels, split (/,/, $availablePanels, -1));
|
||||
|
||||
my $globalPanels = db_get_prop(\%accounts, 'globalUP', 'AdminPanels') || '';
|
||||
push (@adminpanels, split (/,/, $globalPanels, -1));
|
||||
|
||||
foreach (determineGroup($acctName), 'shared')
|
||||
{
|
||||
my $gpanel = db_get_prop(\%accounts, $_, 'AdminPanels') || '';
|
||||
push (@adminpanels, split (/,/, $gpanel, -1));
|
||||
}
|
||||
|
||||
# Use this variable throughout to keep track of files
|
||||
# list of just the files
|
||||
my $c = "1";
|
||||
my @files = ();
|
||||
my %files_hash = ();
|
||||
|
||||
#-----------------------------------------------------
|
||||
# Determine the directory where the functions are kept
|
||||
#-----------------------------------------------------
|
||||
|
||||
my $navigation_ignore =
|
||||
"(\.\.?|navigation|noframes|online-manual|(internal|pleasewait)(-.*)?)";
|
||||
|
||||
my $cgidir = '/etc/e-smith/web/panels/user/cgi-bin/';
|
||||
|
||||
if (opendir (DIR, $cgidir))
|
||||
{
|
||||
@files = grep (!/^(\..*|userpanel-navigation|userpanel-noframes|userpanel-initial|pleasewait)$/,
|
||||
readdir (DIR));
|
||||
closedir (DIR);
|
||||
}
|
||||
else
|
||||
{
|
||||
warn "Can't open directory $cgidir\n";
|
||||
}
|
||||
|
||||
foreach my $file (@files)
|
||||
{
|
||||
foreach my $adminpanel (@adminpanels)
|
||||
{
|
||||
if ( $file eq $adminpanel )
|
||||
{
|
||||
$files_hash{$file} = $cgidir;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#--------------------------------------------------
|
||||
# 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::ConfigDB->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;
|
||||
|
||||
my @filename = split /\//, $files_hash{$file};
|
||||
my $path = "/$UserAlias/$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
|
||||
#--------------------------------------------------
|
||||
|
||||
my @unsortedheadings = keys %nav;
|
||||
|
||||
my $h;
|
||||
local @esmith::weights = ();
|
||||
foreach $h (@unsortedheadings)
|
||||
{
|
||||
push (@esmith::weights, ($nav {$h} {'WEIGHT'} / $nav {$h} {'COUNT'}));
|
||||
}
|
||||
|
||||
my @sortedheadings = @unsortedheadings [sort byweight $[..$#unsortedheadings];
|
||||
|
||||
if ( $NO_FRAMES )
|
||||
{
|
||||
esmith::cgi::genNoframesHeader ($q);
|
||||
}
|
||||
else
|
||||
{
|
||||
esmith::cgi::genNavigationHeader ($q, $#sortedheadings);
|
||||
print "\n<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"0\">\n";
|
||||
}
|
||||
|
||||
foreach $h (@sortedheadings)
|
||||
{
|
||||
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
|
||||
#--------------------------------------------------
|
||||
|
||||
my @unsorteddescriptions = @{ $nav {$h} {'DESCRIPTIONS'} };
|
||||
|
||||
my $d;
|
||||
@esmith::weights = ();
|
||||
foreach $d (@unsorteddescriptions)
|
||||
{
|
||||
push (@esmith::weights, $d->{'WEIGHT'});
|
||||
}
|
||||
|
||||
my @indices = sort byweight $[..$#unsorteddescriptions;
|
||||
|
||||
print "<ul>\n" if ( $NO_FRAMES );
|
||||
|
||||
my $i;
|
||||
foreach $i (@indices)
|
||||
{
|
||||
if ( $NO_FRAMES )
|
||||
{
|
||||
my $href = "/$UserAlias" .
|
||||
$unsorteddescriptions [$i]->{'FILENAME'};
|
||||
print $q->li ($q->a ({href => "$href?noframes=1"}, $unsorteddescriptions [$i]->{'DESCRIPTION'}));
|
||||
}
|
||||
else
|
||||
{
|
||||
my $_class_root_base = "item";
|
||||
my $_class_root_warn = "warn";
|
||||
my $_class = "$_class_root_base";
|
||||
my $_class_selected = "$_class_root_base"."-current";
|
||||
my $_class2 = "$_class_root_warn";
|
||||
my $_class2_selected = "$_class_root_warn"."-current";
|
||||
|
||||
my $href =
|
||||
$unsorteddescriptions [$i]->{'FILENAME'};
|
||||
print "\n",$q->Tr($q->td ({-class => "menu-cell"},
|
||||
$q->a ({-id => "sme$c",
|
||||
-class => "$_class",
|
||||
-onClick => "swapClass(0,'none','$_class_selected','$_class','a');swapClass(0,'none','$_class2_selected','$_class2','a');swapClass(0,'sme$c','$_class_selected','$_class','a')",
|
||||
href => $href,
|
||||
target => 'main'},
|
||||
$unsorteddescriptions [$i]->{'DESCRIPTION'})));
|
||||
}
|
||||
$c++;
|
||||
|
||||
}
|
||||
print "</ul>\n" if ($NO_FRAMES);
|
||||
}
|
||||
|
||||
unless ( $NO_FRAMES )
|
||||
{
|
||||
print "\n</TABLE>\n";
|
||||
esmith::cgi::genNavigationFooter ($q);
|
||||
}
|
||||
}
|
||||
|
||||
sub byweight
|
||||
{
|
||||
$esmith::weights [$a] <=> $esmith::weights [$b];
|
||||
}
|
259
root/etc/e-smith/web/functions/userpanel-noframes
Normal file
259
root/etc/e-smith/web/functions/userpanel-noframes
Normal file
@@ -0,0 +1,259 @@
|
||||
#!/usr/bin/perl -wT
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
# user manager functions: noframes
|
||||
#
|
||||
# Copyright (c) 2001 Daniel van Raay <danielvr@caa.org.au>
|
||||
#
|
||||
# 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
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package esmith;
|
||||
|
||||
use strict;
|
||||
use CGI ':all';
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
|
||||
use esmith::cgi;
|
||||
use esmith::config;
|
||||
use esmith::util;
|
||||
use esmith::db;
|
||||
|
||||
sub showNavigation ($);
|
||||
sub byweight;
|
||||
|
||||
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
|
||||
|
||||
my %conf;
|
||||
tie %conf, 'esmith::config';
|
||||
|
||||
my %accounts;
|
||||
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
||||
|
||||
my $q = new CGI;
|
||||
|
||||
showNavigation ($q);
|
||||
exit (0);
|
||||
|
||||
|
||||
#------------------------------------------------------------
|
||||
# subroutine to display navigation bar
|
||||
#------------------------------------------------------------
|
||||
|
||||
sub showNavigation ($)
|
||||
{
|
||||
my $q = shift;
|
||||
|
||||
esmith::cgi::genNoframesHeader ($q);
|
||||
|
||||
my $acctName = $ENV{'REMOTE_USER'};
|
||||
my $availablePanels = db_get_prop(\%accounts, $acctName, 'AdminPanels');
|
||||
my $globalPanels = db_get_prop(\%accounts, 'globalUP', 'AdminPanels');
|
||||
|
||||
my @adminpanels;
|
||||
if ( defined ($availablePanels) && defined ($globalPanels) )
|
||||
{
|
||||
@adminpanels = ((split (/,/, $availablePanels, -1)),(split (/,/, $globalPanels, -1)));
|
||||
}
|
||||
elsif ( defined ($globalPanels) )
|
||||
{
|
||||
@adminpanels = split (/,/, $globalPanels, -1);
|
||||
}
|
||||
elsif ( defined ($availablePanels) )
|
||||
{
|
||||
@adminpanels = split (/,/, $availablePanels, -1);
|
||||
}
|
||||
|
||||
# Use this variable throughout to keep track of files
|
||||
# list of just the files
|
||||
my @files = ();
|
||||
my %files_hash = ();
|
||||
|
||||
#-----------------------------------------------------
|
||||
# Determine the directory where the functions are kept
|
||||
# match available panels with delegated panels to this user
|
||||
#-----------------------------------------------------
|
||||
|
||||
my $cgidir = '/etc/e-smith/web/panels/user/cgi-bin/';
|
||||
|
||||
if (opendir (DIR, $cgidir))
|
||||
{
|
||||
@files = grep (!/^(\..*|userpanel-navigation|userpanel-noframes|userpanel-initial|pleasewait)$/,
|
||||
readdir (DIR));
|
||||
closedir (DIR);
|
||||
}
|
||||
else
|
||||
{
|
||||
warn "Can't open directory $cgidir\n";
|
||||
}
|
||||
|
||||
foreach my $file (@files)
|
||||
{
|
||||
foreach my $adminpanel (@adminpanels)
|
||||
{
|
||||
if ( $file eq $adminpanel )
|
||||
{
|
||||
$files_hash{$file} = $cgidir;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#--------------------------------------------------
|
||||
# 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 = ();
|
||||
|
||||
foreach my $file (keys %files_hash)
|
||||
{
|
||||
#--------------------------------------------------
|
||||
# extract heading, description and weight information
|
||||
# from CGI script
|
||||
#--------------------------------------------------
|
||||
my $heading = "Unknown";
|
||||
my $headingWeight = 0;
|
||||
|
||||
my $description = "Unknown";
|
||||
my $descriptionWeight = 0;
|
||||
|
||||
unless (open (RD, "$files_hash{$file}/$file"))
|
||||
{
|
||||
warn "Can't open file $files_hash{$file}/$file: $!\n";
|
||||
next;
|
||||
}
|
||||
|
||||
while (<RD>)
|
||||
{
|
||||
if (/^\s*#\s*heading\s*:\s*(.+?)\s*$/)
|
||||
{
|
||||
$heading = $1;
|
||||
}
|
||||
|
||||
if (/^\s*#\s*description\s*:\s*(.+?)\s*$/)
|
||||
{
|
||||
$description = $1;
|
||||
}
|
||||
|
||||
if (/^\s*#\s*navigation\s*:\s*(\d+?)\s+(\d+?)\s*$/)
|
||||
{
|
||||
$headingWeight = $1;
|
||||
$descriptionWeight = $2;
|
||||
}
|
||||
last if ($heading ne "Unknown" && $headingWeight && $description ne "Unknown" && $descriptionWeight);
|
||||
}
|
||||
close RD;
|
||||
|
||||
#--------------------------------------------------
|
||||
# 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 = "/user-manager/$filename[scalar @filename - 1]";
|
||||
|
||||
push @{ $nav {$heading} {'DESCRIPTIONS'} },
|
||||
{ DESCRIPTION => $description,
|
||||
WEIGHT => $descriptionWeight,
|
||||
FILENAME => "$path/$file",
|
||||
CGIPATH => $path
|
||||
};
|
||||
}
|
||||
|
||||
#--------------------------------------------------
|
||||
# generate list of headings sorted by average weight
|
||||
#--------------------------------------------------
|
||||
|
||||
my @unsortedheadings = keys %nav;
|
||||
|
||||
my $h;
|
||||
local @esmith::weights = ();
|
||||
foreach $h (@unsortedheadings)
|
||||
{
|
||||
push (@esmith::weights, ($nav {$h} {'WEIGHT'} / $nav {$h} {'COUNT'}));
|
||||
}
|
||||
|
||||
my @sortedheadings = @unsortedheadings [sort byweight $[..$#unsortedheadings];
|
||||
|
||||
foreach $h (@sortedheadings)
|
||||
{
|
||||
print $q->h2 ($h);
|
||||
|
||||
#--------------------------------------------------
|
||||
# generate list of descriptions sorted by weight
|
||||
#--------------------------------------------------
|
||||
|
||||
my @unsorteddescriptions = @{ $nav {$h} {'DESCRIPTIONS'} };
|
||||
|
||||
my $d;
|
||||
@esmith::weights = ();
|
||||
foreach $d (@unsorteddescriptions)
|
||||
{
|
||||
push (@esmith::weights, $d->{'WEIGHT'});
|
||||
}
|
||||
|
||||
my @indices = sort byweight $[..$#unsorteddescriptions;
|
||||
|
||||
print "<ul>\n";
|
||||
|
||||
my $i;
|
||||
foreach $i (@indices)
|
||||
{
|
||||
my $href = $unsorteddescriptions [$i]->{'FILENAME'};
|
||||
print $q->li ($q->a ({href => $href}, $unsorteddescriptions [$i]->{'DESCRIPTION'}));
|
||||
|
||||
}
|
||||
print "</ul>\n";
|
||||
}
|
||||
|
||||
esmith::cgi::genNavigationFooter ($q);
|
||||
}
|
||||
|
||||
sub byweight
|
||||
{
|
||||
$esmith::weights [$a] <=> $esmith::weights [$b];
|
||||
}
|
411
root/etc/e-smith/web/functions/userpanelaccess
Normal file
411
root/etc/e-smith/web/functions/userpanelaccess
Normal file
@@ -0,0 +1,411 @@
|
||||
#!/usr/bin/perl -wT
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
# heading : Security
|
||||
# description : User Panel Access
|
||||
# navigation : 1000 1300
|
||||
#
|
||||
# Copyright (c) 2001 Daniel van Raay <danielvr@caa.org.au>
|
||||
# Modified (c) 2002 Stephen Noble <stephen@dungog.net>
|
||||
# Modified (c) 2002 Shad L. Lords <slords@mail.com>
|
||||
#
|
||||
# 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
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package esmith;
|
||||
|
||||
use strict;
|
||||
use CGI ':all';
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
|
||||
use esmith::cgi;
|
||||
use esmith::config;
|
||||
use esmith::util;
|
||||
use esmith::db;
|
||||
use esmith::event;
|
||||
|
||||
sub showInitial ($$);
|
||||
sub genPanels ($$);
|
||||
sub modifyAccess ($);
|
||||
sub performModifyAccess ($);
|
||||
|
||||
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
|
||||
|
||||
my %conf;
|
||||
tie %conf, 'esmith::config';
|
||||
|
||||
my %accounts;
|
||||
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
||||
|
||||
#------------------------------------------------------------
|
||||
# examine state parameter and display the appropriate form
|
||||
#------------------------------------------------------------
|
||||
|
||||
my $q = new CGI;
|
||||
|
||||
if (! grep (/^state$/, $q->param))
|
||||
{
|
||||
showInitial ($q, '');
|
||||
}
|
||||
|
||||
elsif ($q->param ('state') eq "modifyAccess")
|
||||
{
|
||||
modifyAccess ($q);
|
||||
}
|
||||
|
||||
elsif ($q->param ('state') eq "performModifyAccess")
|
||||
{
|
||||
performModifyAccess ($q);
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
esmith::cgi::genStateError ($q, \%conf);
|
||||
}
|
||||
|
||||
exit (0);
|
||||
|
||||
#------------------------------------------------------------
|
||||
# subroutine to display initial form
|
||||
#------------------------------------------------------------
|
||||
|
||||
sub showInitial ($$)
|
||||
{
|
||||
my ($q, $msg) = @_;
|
||||
|
||||
if ($msg eq '')
|
||||
{
|
||||
esmith::cgi::genHeaderNonCacheable
|
||||
($q, \%conf, 'Change access to server-manager panels for user accounts');
|
||||
}
|
||||
else
|
||||
{
|
||||
esmith::cgi::genHeaderNonCacheable
|
||||
($q, \%conf, 'Operation status report');
|
||||
|
||||
print $q->p ($msg);
|
||||
print $q->hr;
|
||||
}
|
||||
|
||||
my @userAccounts = ('admin');
|
||||
|
||||
foreach (sort keys %accounts)
|
||||
{
|
||||
push (@userAccounts, $_) if (db_get_type(\%accounts, $_) eq "user");
|
||||
}
|
||||
|
||||
foreach (sort keys %accounts)
|
||||
{
|
||||
push (@userAccounts, $_) if (db_get_type(\%accounts, $_) eq "group");
|
||||
}
|
||||
|
||||
unless (scalar @userAccounts)
|
||||
{
|
||||
print $q->p ($q->b ('There are no user accounts in the system.'));
|
||||
}
|
||||
else
|
||||
{
|
||||
my $description = <<END_TEXT;
|
||||
You can modify individual users access to the server-manager
|
||||
panels below by clicking on the link next the account. You can assign
|
||||
panels to the members of a group with their link. Users or Groups
|
||||
in red have some form of extra access. You can globally assign
|
||||
a panel by editing the global account
|
||||
END_TEXT
|
||||
|
||||
print $q->p ($description);
|
||||
|
||||
print $q->p ($q->b ('Current List of User Accounts'));
|
||||
|
||||
print "<table border=1 cellspacing=1 cellpadding=4>";
|
||||
|
||||
print $q->Tr (esmith::cgi::genSmallCell ($q, $q->b ('Account')),
|
||||
esmith::cgi::genSmallCell ($q, $q->b ('Name/Description')),
|
||||
$q->td (' '));
|
||||
|
||||
my $user;
|
||||
|
||||
foreach $user (@userAccounts)
|
||||
{
|
||||
my $name = '';
|
||||
if (db_get_type(\%accounts, $user) eq "group")
|
||||
{
|
||||
$name =db_get_prop(\%accounts, $user, "Description");
|
||||
}
|
||||
else
|
||||
{
|
||||
$name =db_get_prop(\%accounts, $user, "FirstName")." ". db_get_prop(\%accounts, $user, "LastName");
|
||||
}
|
||||
|
||||
my $AdminPanels = db_get_prop(\%accounts, $user, "AdminPanels");
|
||||
$AdminPanels = '' if ! defined ($AdminPanels);
|
||||
|
||||
if ( ! $AdminPanels )
|
||||
{
|
||||
print $q->Tr (esmith::cgi::genSmallCell ($q, $user),
|
||||
esmith::cgi::genSmallCell ($q, $name),
|
||||
esmith::cgi::genSmallCell ($q,
|
||||
$q->a ({href => $q->url (-absolute => 1)
|
||||
. "?state=modifyAccess&acct="
|
||||
. $user}, 'Change Access...')));
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
print $q->Tr (esmith::cgi::genSmallRedCell ($q, $user),
|
||||
esmith::cgi::genSmallRedCell ($q, $name),
|
||||
esmith::cgi::genSmallCell ($q,
|
||||
$q->a ({href => $q->url (-absolute => 1)
|
||||
. "?state=modifyAccess&acct="
|
||||
. $user}, 'Change Access...')));
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#global setting
|
||||
if ( ! db_get( \%accounts, 'globalUP') )
|
||||
{
|
||||
db_set(\%accounts, 'globalUP', 'userpanelglobal', { FirstName => 'global user', LastName => 'panel access' });
|
||||
}
|
||||
|
||||
my $AdminPanels = db_get_prop(\%accounts, 'globalUP', "AdminPanels");
|
||||
$AdminPanels = '' if ! defined ($AdminPanels);
|
||||
|
||||
if ( ! $AdminPanels )
|
||||
{
|
||||
print $q->Tr (esmith::cgi::genSmallCell ($q, 'Global'),
|
||||
esmith::cgi::genSmallCell ($q, 'every user'),
|
||||
esmith::cgi::genSmallCell ($q,
|
||||
$q->a ({href => $q->url (-absolute => 1)
|
||||
. "?state=modifyAccess&acct="
|
||||
. 'globalUP'}, 'Change Access...')));
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
print $q->Tr (esmith::cgi::genSmallRedCell ($q, 'Global'),
|
||||
esmith::cgi::genSmallRedCell ($q, 'every user'),
|
||||
esmith::cgi::genSmallCell ($q,
|
||||
$q->a ({href => $q->url (-absolute => 1)
|
||||
. "?state=modifyAccess&acct="
|
||||
. 'globalUP'}, 'Change Access...')));
|
||||
|
||||
}
|
||||
|
||||
print '</table>';
|
||||
}
|
||||
|
||||
esmith::cgi::genFooter ($q);
|
||||
}
|
||||
|
||||
sub genPanels ($$)
|
||||
{
|
||||
my ($q, $user) = @_;
|
||||
|
||||
my %panelshash = ();
|
||||
my @selected = ();
|
||||
my @globalselected = ();
|
||||
|
||||
my @panels;
|
||||
opendir (DIR, "/etc/e-smith/web/functions")
|
||||
|| die "Can't open /etc/e-smith/web/functions directory.\n";
|
||||
push (@panels, sort (grep (!/^(\.|userpanel-initial|userpanel-navigation|userpanel-noframes|pleasewait|index\.cgi|initial\.cgi|navigation|noframes|userpassword)/, readdir(DIR))));
|
||||
closedir (DIR);
|
||||
|
||||
my $panel;
|
||||
foreach $panel (@panels)
|
||||
{
|
||||
$panelshash{$panel} = "Unknown";
|
||||
|
||||
unless (open (RD, "/etc/e-smith/web/functions/$panel"))
|
||||
{
|
||||
warn "Can't open file /etc/e-smith/web/functions/$panel: $!\n";
|
||||
next;
|
||||
}
|
||||
|
||||
while (<RD>)
|
||||
{
|
||||
if (/^\s*#\s*description\s*:\s*(.+?)\s*$/)
|
||||
{
|
||||
$panelshash{$panel} = $1;
|
||||
}
|
||||
|
||||
last if ( $panelshash{$panel} ne "Unknown" );
|
||||
}
|
||||
close RD;
|
||||
}
|
||||
|
||||
my $userAdminPanels = db_get_prop(\%accounts, $user, 'AdminPanels');
|
||||
$userAdminPanels = '' if ! defined ($userAdminPanels);
|
||||
@selected = split (/,/, $userAdminPanels);
|
||||
|
||||
my $globalAdminPanels = db_get_prop(\%accounts, 'globalUP', 'AdminPanels');
|
||||
$globalAdminPanels = '' if ! defined ($globalAdminPanels);
|
||||
@globalselected = split (/,/, $globalAdminPanels);
|
||||
|
||||
@panels = sort @panels;
|
||||
my $count = scalar @panels;
|
||||
|
||||
my $out = '';
|
||||
|
||||
if ($count > 0)
|
||||
{
|
||||
$out .= '<table border=1 cellspacing=1 cellpadding=4>';
|
||||
|
||||
$out .= $q->Tr ($q->td (' '),
|
||||
esmith::cgi::genSmallCell ($q, $q->b ('Panel')),
|
||||
esmith::cgi::genSmallCell ($q, $q->b ('Description')));
|
||||
|
||||
my $panel;
|
||||
foreach $panel (@panels)
|
||||
{
|
||||
my $checked = "";
|
||||
if (grep (/^$panel$/, @selected) || grep (/^$panel$/, @globalselected))
|
||||
{
|
||||
$checked = "checked";
|
||||
}
|
||||
|
||||
if (grep (/^$panel$/, @globalselected) && ($user ne 'globalUP'))
|
||||
{
|
||||
$out .=
|
||||
$q->Tr (
|
||||
$q->td (
|
||||
"<input type=\"checkbox\""
|
||||
. " name=\"panelAccess\""
|
||||
. " $checked value=\"$panel\">"
|
||||
),
|
||||
esmith::cgi::genSmallRedCell ($q, $panel),
|
||||
esmith::cgi::genSmallRedCell (
|
||||
$q, $panelshash{$panel} . ' (Global)'));
|
||||
} else {
|
||||
$out .=
|
||||
$q->Tr (
|
||||
$q->td (
|
||||
"<input type=\"checkbox\""
|
||||
. " name=\"panelAccess\""
|
||||
. " $checked value=\"$panel\">"
|
||||
),
|
||||
esmith::cgi::genSmallCell ($q, $panel),
|
||||
esmith::cgi::genSmallCell (
|
||||
$q, $panelshash{$panel}));
|
||||
}
|
||||
}
|
||||
|
||||
$out .= '</table>';
|
||||
}
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
|
||||
sub modifyAccess ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
esmith::cgi::genHeaderNonCacheable ($q, \%conf, 'Modify user-manager access');
|
||||
|
||||
print
|
||||
$q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
|
||||
|
||||
my $acct = $q->param ('acct');
|
||||
|
||||
my $username = '';
|
||||
if (db_get_type(\%accounts, $acct) eq "group")
|
||||
{
|
||||
$username =db_get_prop(\%accounts, $acct, "Description");
|
||||
}
|
||||
else
|
||||
{
|
||||
$username =db_get_prop(\%accounts, $acct, "FirstName")." ". db_get_prop(\%accounts, $acct, "LastName");
|
||||
}
|
||||
|
||||
if (db_get(\%accounts, $acct))
|
||||
{
|
||||
|
||||
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
|
||||
|
||||
$q->Tr (esmith::cgi::genCell ($q, "Account name:"),
|
||||
esmith::cgi::genCell ($q, $acct)),
|
||||
|
||||
$q->Tr (esmith::cgi::genCell ($q, "Name/Description:"),
|
||||
esmith::cgi::genCell ($q, "$username")),
|
||||
|
||||
$q->Tr (esmith::cgi::genCell ($q, "Accessible Panels:"),
|
||||
esmith::cgi::genCell ($q, genPanels ($q, $acct))),
|
||||
|
||||
esmith::cgi::genButtonRow ($q,
|
||||
$q->submit (-name => 'action',
|
||||
-value => 'Modify')));
|
||||
|
||||
print $q->hidden (-name => 'acct',
|
||||
-override => 1,
|
||||
-default => $acct);
|
||||
|
||||
print $q->hidden (-name => 'state',
|
||||
-override => 1,
|
||||
-default => 'performModifyAccess');
|
||||
|
||||
}
|
||||
|
||||
print $q->endform;
|
||||
esmith::cgi::genFooter ($q);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub performModifyAccess ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
my $acct = $q->param ('acct');
|
||||
|
||||
my @adminPanels = $q->param ('panelAccess');
|
||||
my @userPanels = ();
|
||||
|
||||
my $globalAdminPanels = db_get_prop(\%accounts, 'globalUP', 'AdminPanels');
|
||||
$globalAdminPanels = '' if ! defined ($globalAdminPanels);
|
||||
my @globalselected = split (/,/, $globalAdminPanels);
|
||||
|
||||
foreach my $panel (@adminPanels)
|
||||
{
|
||||
if ( ! grep (/^$panel$/, @globalselected) || ($acct eq 'globalUP'))
|
||||
{
|
||||
push(@userPanels, $panel);
|
||||
}
|
||||
}
|
||||
|
||||
my $adminPanels = join (',', @userPanels);
|
||||
|
||||
db_set_prop(\%accounts, $acct, 'AdminPanels', $adminPanels);
|
||||
|
||||
system ("/sbin/e-smith/signal-event", "conf-userpanel") == 0
|
||||
or die ("Error occurred while updating userpanel configuration.\n");
|
||||
|
||||
showInitial ($q, "Successfully modified user account $acct.");
|
||||
}
|
3
root/etc/e-smith/web/panels/user/access.incl
Normal file
3
root/etc/e-smith/web/panels/user/access.incl
Normal file
@@ -0,0 +1,3 @@
|
||||
{
|
||||
}
|
||||
|
35
root/etc/e-smith/web/panels/user/html/index.html
Normal file
35
root/etc/e-smith/web/panels/user/html/index.html
Normal file
@@ -0,0 +1,35 @@
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
|
||||
<HTML>
|
||||
|
||||
<HEAD>
|
||||
<TITLE>SME Server / user </TITLE>
|
||||
</HEAD>
|
||||
|
||||
<FRAMESET FRAMESPACING="0" COLS="170,*" FRAMEBORDER="0" BORDER="0">
|
||||
|
||||
<FRAME NAME="navigation" RESIZE="auto" MARGINHEIGHT="0" SRC="/user-manager/cgi-bin/userpanel-navigation"
|
||||
FRAMEBORDER="no" SCROLLING="auto" MARGINWIDTH="0" BORDER="0">
|
||||
|
||||
<FRAME NAME="main" RESIZE="auto" MARGINHEIGHT="0" SRC="/user-manager/cgi-bin/userpanel-initial"
|
||||
FRAMEBORDER="no" SCROLLING="auto" MARGINWIDTH="0" BORDER="0">
|
||||
|
||||
</FRAMESET>
|
||||
|
||||
<NOFRAMES>
|
||||
<BODY>
|
||||
|
||||
<H1>Welcome to the user manager panel</H1>
|
||||
|
||||
<P><A HREF="/user-manager/cgi-bin/userpanel-noframes">Click here</A> for a
|
||||
list of available functions.
|
||||
|
||||
<P>As part of our commitment to open-source software, you are welcome
|
||||
to copy and redistribute this software.
|
||||
|
||||
<P>
|
||||
<HR>
|
||||
|
||||
</BODY>
|
||||
</NOFRAMES>
|
||||
|
||||
</HTML>
|
564
root/usr/share/perl5/vendor_perl/esmith/cgi5.pm
Normal file
564
root/usr/share/perl5/vendor_perl/esmith/cgi5.pm
Normal file
@@ -0,0 +1,564 @@
|
||||
#!/usr/bin/perl -wT
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
# 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.mitel.com/sme/ for details.
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package esmith::cgi5;
|
||||
|
||||
use strict;
|
||||
use esmith::config;
|
||||
use esmith::db;
|
||||
use esmith::util;
|
||||
|
||||
BEGIN
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
esmith::cgi - Useful CGI routines for e-smith server and gateway
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
This file documents C<esmith::cgi> version B<1.4.0>
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::cgi;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains a collection of useful routines for working with
|
||||
the e-smith manager's CGI interface.
|
||||
|
||||
=head1 WEB PAGE HEADER GENERATION ROUTINES
|
||||
|
||||
=head2 genHeaderNonCacheable($q, $confref, $title)
|
||||
|
||||
=cut
|
||||
|
||||
sub genHeaderNonCacheable ($$$)
|
||||
{
|
||||
my ($q, $confref, $title) = @_;
|
||||
genHeader ($q, $confref, $title, '-20y', 1);
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genHeaderCacheableNoPasswordCheck($q, $confref, $title)
|
||||
|
||||
=cut
|
||||
|
||||
sub genHeaderCacheableNoPasswordCheck ($$$)
|
||||
{
|
||||
my ($q, $confref, $title) = @_;
|
||||
genHeader ($q, $confref, $title, '+1d', 0);
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genHeaderCacheableNoPasswordCheck($q, $confref, $title)
|
||||
|
||||
=cut
|
||||
|
||||
sub genHeaderNonCacheableNoPasswordCheck ($$$)
|
||||
{
|
||||
my ($q, $confref, $title) = @_;
|
||||
genHeader ($q, $confref, $title, '-20y', 0);
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genHeader($q, $confref, $title, $expiry, $checkpassword)
|
||||
|
||||
=cut
|
||||
|
||||
sub genHeader ($$$$$)
|
||||
{
|
||||
my ($q, $confref, $title, $expiry, $checkpassword) = @_;
|
||||
|
||||
print $q->header (-EXPIRES => $expiry);
|
||||
|
||||
genHeaderStartHTML ($q);
|
||||
|
||||
print $q->table ({-BORDER => "0",
|
||||
-CELLSPACING => "0",
|
||||
-CELLPADDING => "1",
|
||||
-WIDTH => "100%",
|
||||
-ALIGN => "LEFT"},
|
||||
$q->Tr ({-VALIGN => "BOTTOM"},
|
||||
$q->td ({-BACKGROUND
|
||||
=> "/server-common/banner-shim.gif",},
|
||||
)));
|
||||
print $q->br ({-CLEAR => 'ALL'});
|
||||
print $q->div ({-STYLE =>
|
||||
'position: absolute; visibility: inherit; top: 10px; left:' .
|
||||
' 16px; width: 85%; z-index: 2'});
|
||||
|
||||
|
||||
print '<FONT FACE="Helvetica,Arial">';
|
||||
|
||||
if ($checkpassword)
|
||||
{
|
||||
if (defined db_get($confref ,'PasswordSet') &&
|
||||
db_get($confref ,'PasswordSet') ne 'yes')
|
||||
{
|
||||
print $q->div ({-STYLE => 'color: #FF3E00'},
|
||||
$q->h5 ('Warning: you have not yet changed the default system password.'));
|
||||
}
|
||||
|
||||
my $TelnetAccess = db_get_prop($confref, 'telnet', 'access') ||'';
|
||||
my $TelnetMode = db_get_prop($confref, 'telnet', 'status') || '';
|
||||
if ($TelnetAccess eq 'public' && $TelnetMode eq 'enabled')
|
||||
{
|
||||
print $q->div ({-STYLE => 'color: #FF3E00'},
|
||||
$q->h5 ('Warning: the current security settings permit public telnet access.'));
|
||||
}
|
||||
}
|
||||
|
||||
print $q->h2 ($title);
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genNavigationHeader($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genNavigationHeader ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
print $q->header (-EXPIRES => '-20y');
|
||||
|
||||
genHeaderStartHTML ($q);
|
||||
|
||||
print $q->a ({-HREF => 'http://www.mitel.com/', -TARGET => '_top'},
|
||||
$q->img ({-BORDER => '0',
|
||||
-ALT => 'Mitel Networks Logo',
|
||||
-ALIGN => 'top',
|
||||
-SRC => '/server-common/mitel_logo.jpg'}));
|
||||
print $q->div ({-STYLE => 'position: absolute; visibility: inherit; top: 100px; left: 10px; z-index: 2'});
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genNoframesHeader($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genNoframesHeader ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
print $q->header (-EXPIRES => '-20y');
|
||||
genHeaderStartHTML ($q);
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genHeaderStartHTML($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genHeaderStartHTML ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
print $q->start_html (-TITLE => 'SME Server manager',
|
||||
-AUTHOR => 'bugs@e-smith.com',
|
||||
-META => {'copyright' => 'Copyright 2002 Mitel Networks Corporation'},
|
||||
-STYLE =>
|
||||
{-src => '/server-common/css/manager.css'},
|
||||
-BGCOLOR => '#FFFFFF',
|
||||
-LINK => '#707070',
|
||||
-VLINK => '#707070',
|
||||
-ALINK => '#707070',
|
||||
-TEXT => '#000000',
|
||||
-MARGINWIDTH => '0',
|
||||
-MARGINHEIGHT => '0',
|
||||
-LEFTMARGIN => '0',
|
||||
-TOPMARGIN => '0');
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head1 WEB PAGE FOOTER GENERATION ROUTINES
|
||||
|
||||
=head2 genFooter($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genFooter ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
my $release = esmith::util::determineRelease();
|
||||
|
||||
print $q->p ($q->hr, $q->font ({size => "-1"},
|
||||
"SME Server V${release}<BR>" .
|
||||
"All rights reserved by their respective owners. ")
|
||||
);
|
||||
|
||||
print '</FONT>';
|
||||
print '</DIV>';
|
||||
print $q->end_html;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genFooterNoCopyright($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genFooterNoCopyright ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
print $q->p ($q->hr);
|
||||
|
||||
print '</FONT>';
|
||||
print '</DIV>';
|
||||
print $q->end_html;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genNavigationFooter($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genNavigationFooter ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
print '</DIV>';
|
||||
print $q->end_html;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genNoframesFooter($q)
|
||||
|
||||
=cut
|
||||
|
||||
sub genNoframesFooter ($)
|
||||
{
|
||||
my ($q) = @_;
|
||||
|
||||
print $q->end_html;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head1 FONT ROUTINES
|
||||
|
||||
=head2 curFont()
|
||||
|
||||
Returns the preferred font faces eg. "Helvetica,Arial".
|
||||
|
||||
=cut
|
||||
|
||||
sub curFont ()
|
||||
{
|
||||
return "Helvetica,Arial";
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head1 TABLE GENERATION ROUTINES
|
||||
|
||||
=head2 genCell($q, $text)
|
||||
|
||||
=cut
|
||||
|
||||
sub genCell ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->td ($q->font ({face => "Helvetica,Arial"}, $text));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genDoubleCell($q, $text);
|
||||
|
||||
Generates a cell which spans two columns, containing the text specified.
|
||||
|
||||
=cut
|
||||
|
||||
sub genDoubleCell ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->td ({colspan => 2}, $q->font ({face => "Helvetica,Arial"}, $text));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genSmallCell($q, $text)
|
||||
|
||||
Generates a cell with "small" text (font size -1).
|
||||
|
||||
=cut
|
||||
|
||||
sub genSmallCell ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->td ($q->font ({size => -1, face => "Helvetica,Arial"}, $text));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genSmallCellCentered($q, $text)
|
||||
|
||||
Generates a cell with "small" text (font size -1).
|
||||
Center the contents.
|
||||
|
||||
=cut
|
||||
|
||||
sub genSmallCellCentered ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->td ({ align => 'center' },
|
||||
$q->font ({size => -1, face => "Helvetica,Arial"}, $text));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genSmallCellRightJustified($q, $text)
|
||||
|
||||
Generates a cell with "small" text (font size -1).
|
||||
Right justify the contents.
|
||||
|
||||
=cut
|
||||
|
||||
sub genSmallCellRightJustified ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->td ({ align => 'right' },
|
||||
$q->font ({size => -1, face => "Helvetica,Arial"}, $text));
|
||||
}
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genSmallRedCell($q, $text)
|
||||
|
||||
Generates a cell with "small" (font size -1) red text.
|
||||
|
||||
=cut
|
||||
|
||||
sub genSmallRedCell ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->td
|
||||
($q->font ({size => -1, face => "Helvetica,Arial", color => "Red"},
|
||||
$q->i ($text)));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genTextRow($q, $text)
|
||||
|
||||
Returns a table row containing a two-column cell containing $text.
|
||||
|
||||
=cut
|
||||
|
||||
sub genTextRow ($$)
|
||||
{
|
||||
my ($q, $text) = @_;
|
||||
|
||||
if ($text =~ /^\s*$/)
|
||||
{
|
||||
$text = " "
|
||||
}
|
||||
|
||||
return $q->Tr ($q->td ({colspan => 2}, $q->font ({face => "Helvetica,Arial"}, $text)));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genButtonRow($q, $button)
|
||||
|
||||
Returns a table row containing an empty first cell and a second cell
|
||||
containing a button with the value $button.
|
||||
|
||||
=cut
|
||||
|
||||
sub genButtonRow ($$)
|
||||
{
|
||||
my ($q, $button) = @_;
|
||||
|
||||
return $q->Tr ($q->td (' '),
|
||||
$q->td ($q->font ({face => "Helvetica,Arial"}, $q->b ($button))));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genNameValueRow($q, $fieldlabel, $fieldname, $fieldvalue)
|
||||
|
||||
Returns a table row with two cells. The first has the text
|
||||
"$fieldlabel:" in it, and the second has a text field with the default
|
||||
value $fieldvalue and the name $fieldname.
|
||||
|
||||
=cut
|
||||
|
||||
sub genNameValueRow ($$$$)
|
||||
{
|
||||
my ($q, $fieldlabel, $fieldname, $fieldvalue) = @_;
|
||||
|
||||
return $q->Tr ($q->td ($q->font ({face => "Helvetica,Arial"}, "$fieldlabel:")),
|
||||
$q->td ($q->font ({face => "Helvetica,Arial"}, $q->textfield (-name => $fieldname,
|
||||
-override => 1,
|
||||
-default => $fieldvalue,
|
||||
-size => 32))));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genNamePasswordRow($q, $fieldlabel, $fieldname, $fieldvalue)
|
||||
|
||||
As for C<genNameValueRow()> above, but instead of a text field it
|
||||
generates a password field so that user input is obscured.
|
||||
|
||||
Possible buglet: if $fieldvalue is given, the password field defaults to
|
||||
this value, so the number of stars may indicate to the end-user what the
|
||||
previous value was.
|
||||
|
||||
=cut
|
||||
|
||||
sub genNamePasswdRow ($$$$)
|
||||
{
|
||||
my ($q, $fieldlabel, $fieldname, $fieldvalue) = @_;
|
||||
|
||||
return $q->Tr ($q->td ($q->font ({face => "Helvetica,Arial"}, "$fieldlabel:")),
|
||||
$q->td ($q->font ({face => "Helvetica,Arial"}, $q->password_field (-name => $fieldname,
|
||||
-override => 1,
|
||||
-default => $fieldvalue,
|
||||
-size => 32))));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
sub genWidgetRow($q, $fieldlabel, $popup)
|
||||
|
||||
=cut
|
||||
|
||||
sub genWidgetRow ($$$)
|
||||
{
|
||||
my ($q, $fieldlabel, $popup) = @_;
|
||||
|
||||
return $q->Tr ($q->td ($q->font ({face => "Helvetica,Arial"}, "$fieldlabel:")),
|
||||
$q->td ($q->font ({face => "Helvetica,Arial"}, $popup)));
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head1 STATUS AND ERROR REPORT GENERATION ROUTINES
|
||||
|
||||
=head2 genResult($q, $msg)
|
||||
|
||||
Generates a "status report" page, including the footer
|
||||
|
||||
=cut
|
||||
|
||||
sub genResult ($$)
|
||||
{
|
||||
my ($q, $msg) = @_;
|
||||
|
||||
print $q->p ($msg);
|
||||
genFooter ($q);
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 genStateError($q, $confref)
|
||||
|
||||
Subroutine to generate "unknown state" error message.
|
||||
|
||||
=cut
|
||||
|
||||
sub genStateError ($$)
|
||||
{
|
||||
my ($q, $confref) = @_;
|
||||
|
||||
genHeaderNonCacheable ($q, $confref, "Internal error");
|
||||
genResult ($q, "Internal error! Unknown state: " . $q->param ("state") . ".");
|
||||
}
|
||||
|
||||
END
|
||||
{
|
||||
}
|
||||
|
||||
#------------------------------------------------------------
|
||||
# return "1" to make the import process return success
|
||||
#------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mitel Networks Corporation
|
||||
|
||||
For more information, see http://e-smith.org/
|
||||
|
||||
=cut
|
||||
|
Reference in New Issue
Block a user