smecontribs/smeserver-userpanel
7
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
537335bf32
smeserver-userpanel/root/usr/share/perl5/vendor_perl/esmith/cgi5.pm

565 lines
11 KiB
Perl
Raw Blame History

#!/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 = "&nbsp;"
}
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 = "&nbsp;"
}
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 = "&nbsp;"
}
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 = "&nbsp;"
}
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 = "&nbsp;"
}
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 = "&nbsp;"
}
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 = "&nbsp;"
}
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 ('&nbsp;'),
$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
View Git Blame Copy Permalink