The panel is perl code, logically broken into a few different sections. I'm making an arbitary decision here, Preliminary, Web pages and Subroutines. HTML Elements and DB commands explain the code the panel writer has available from the cgi modules esmith wrote to support the panel and template mechanism. The other sections of the howto explain a little perl where to find help.
This howto is draft quality, or am I supposed to call it a white paper? :-) Submissions and corrections welcome.
Stephen Noble, stephen7_at_bigfoot.com , April 2001 ver 0.1-2
#!/usr/bin/perl -wT #---------------------------------------------------------------------- # heading : Configuration # description : Email Retrival # navigation : 4000 4400The next is the short version of the GNU GPL
# # copyright (C) 1999, 2000 e-smith, inc. # # 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 e-smith, inc. # Please visit our web site www.e-smith.net for details. #----------------------------------------------------------------------Import/include the perl cgi modules written by e-smith.com. Large sections of this howto are taken from the esmith::cgi and db perl modules
package esmith; use strict; use CGI ':all'; use CGI::Carp qw(fatalsToBrowser); use esmith::cgi; use esmith::config; use esmith::util; use esmith::db;Declare the subroutines you are going to use
sub showInitial ($); sub performAndShowResult ($);The path is cleared, if your going to call a unix program use the full path eg /bin/echo
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';
tie %accounts, 'esmith::config', '/home/e-smith/accounts';
Examine the state parameter you leave a page with and direct you to the next page. Define all your subroutines.
#------------------------------------------------------------
# examine state parameter and display the appropriate form
#------------------------------------------------------------
my $q = new CGI;
if (! grep (/^state$/, $q->param))
{
showInitial ($q);
}
elsif ($q->param ('state') eq "perform")
{
performAndShowResult ($q);
}
else
{
esmith::cgi::genStateError ($q, \%conf);
}
exit (0);
#------------------------------------------------------------
# subroutine to display initial form
#------------------------------------------------------------
sub showInitial ($)
{
my ($q) = @_;
Page heading, larger and bold. Beginning of html code generation
esmith::cgi::genHeaderNonCacheable ($q, \%conf, 'Change workgroup settings');
print $q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
Variable names are short and in lower case, you can replace the text on popup buttons with something more descriptive or here more attractive
my %yesnoLabels = ('yes' => 'Yes please, sir !',
'no' => 'No thankyou, not today.');
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
Descriptive text explaining the page.
esmith::cgi::genTextRow
($q, $q->p ('Enter the name of the',
$q->b ('windows workgroup'),
'that the e-smith server should appear in.')),
Create a text entry field. It has three parameters, a test description, a name for the variable and a default value, the default in the example below is taken from the configuation file
esmith::cgi::genNameValueRow ($q,
"Windows workgroup",
"sambaWorkgroup",
$conf {'SambaWorkgroup'}),
esmith::cgi::genTextRow
($q, $q->p ('Enter the name that the e-smith server should use',
'for Windows and Macintosh file sharing.')),
esmith::cgi::genNameValueRow ($q,
"Server name",
"sambaServerName",
$conf {'SambaServerName'}),
esmith::cgi::genTextRow
($q, $q->p ('Should the e-smith server be the domain master for your 'Windows workgroup?',
'Typically the answer should be',
$q->b ('no'),
'if you are running a Windows NT server on this network, and,',
$q->b ('yes'),
'otherwise.') . ' ' .
$q->p ('If you enable e-smith server to be the domain master a',
'netlogon.bat script will be created in order to make netlogon', 'clients use the existing script. The script is harmless',
'for those who do not wish to use it. It is recommended that only',
'experienced users customize the netlogon.bat script.')),
Create a drop down button, here you have two choices, yes and no. popup_menu has a minimum or 2 parameters, name and value. Optionaly you can give a defaults or label the buttons
$q->Tr (esmith::cgi::genCell ($q, "Domain master:"),
esmith::cgi::genCell ($q, $q->popup_menu (-name => 'sambaDomainMaster',
-values => ['yes', 'no'],
-default => $conf {'SambaDomainMaster'},
-labels => \%yesnoLabels))),
Create a button to push, name and label it. End the html for the page.
esmith::cgi::genButtonRow ($q,
$q->submit (-name => 'action', -value => 'Save')));
print $q->hidden (-name => 'state', -override => 1, -default => 'perform');
print $q->endform;
esmith::cgi::genFooter ($q);
}
print '';
my $oldNTPServer = '';
$oldNTPServer = db_get_prop(\%conf, 'ntpd', 'NTPServer');
my $enabledChk = '';
if (db_get_prop(\%conf, 'ntpd', 'status') eq "enabled")
{
$enabledChk = "checked";
}
print $q->h4 ('Network Time Server');
#(sn?) >> should point otherway
$description = >>END_TEXT;
The e-smith server and gateway can periodically synchronize the system clock to a
network time protocol (NTP) server. If you would like to enable this service,
indicate so in the checkbox and enter the hostname or IP address of the
NTP server below. Otherwise, leave the checkbox unchecked.
END_TEXT
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
esmith::cgi::genTextRow
($q, $q->p ($description)),
esmith::cgi::genTextRow
($q, $q->p ("Enable NTP Service ',
'>input type=\"checkbox\" name=\"ntpdEnabled\"$enabledChk<")),
esmith::cgi::genNameValueRow ($q,
"NTP server",
"ntpServer",
$oldNTPServer),
esmith::cgi::genButtonRow ($q,
$q->submit (-name => 'action', -value => 'Save NTP Settings')));
print '';
print $q->p ($q->a ({href => $q->url (-absolute => 1) . "?state=create"},
'Click here'),
'to create a user group.');
Which we defined above
elsif ($q->param ('state') eq "create")
{
createGroup ($q);
}
This requires an alternative show initial section, note the two ($$). This is the type of intro needed if you test user input and give a reply.(?sn)
sub showInitial ($$)
{
my ($q, $msg) = @_;
#------------------------------------------------------------
# If there's a message, we just finished an operation so show the
# status report. If no message, this is a new list of accounts.
#------------------------------------------------------------
if ($msg eq '')
{
esmith::cgi::genHeaderNonCacheable
($q, \%conf, 'Create, remove, or change user groups');
}
else
{
esmith::cgi::genHeaderNonCacheable
($q, \%conf, 'Operation status report');
print $q->p ($msg);
print $q->hr;
}
To move about within a panel use standard html anchor code. whoops if you see this in a web browser i'm not escaping the <
#the link
Warning: If you have configured a network time server a href=#ntp> below>/a<, do NOT
manually set the time or date here.
#the destination
print $q->h4 ('>a name="ntp"< Network Time Server>/a<');
The three $ eg ($$$) in sub_genHeaderNonCacheable_($$$) indicate you must provide three variables, the first is always ($q, the others are chosen from the following list
$confref ; is usually \%conf (ie /home/e-smith/configuration)
$title ;a bold heading
$text ;describe what the user has to do or know
$button ;
$fieldlabel ;short description
$fieldname ;local variable name
$fieldvalue ;local variable value
$popup ;
$msg ;your message
$button and $popup contain sub elements.
see previous yes/no example
#------------------------------------------------------------
# subroutines to generate the web page header in various ways
#------------------------------------------------------------
sub genHeaderNonCacheable ($$$)
my ($q, $confref, $title)
((page header))
#------------------------------------------------------------
# subroutines to generate table rows and cells in various ways
#------------------------------------------------------------
sub genCell ($$)
my ($q, $text)
((you can fit four cells on a row,
print $q->Tr (esmith::cgi::genSmallRedCell ($q, $pseudonym),
esmith::cgi::genSmallCell ($q, $account),
$q->td (' '), #also works
esmith::cgi::genSmallCell ($q, " " ),
);
or you can have just one cell per row, for a genSmallRedCell warning? ))
sub genDoubleCell ($$)
my ($q, $text)
((double width, ie 1/2 a page width))
sub genSmallCell ($$)
my ($q, $text)
((smaller font size))
sub genSmallRedCell ($$)
my ($q, $text)
((small and in RED, eg for a warning))
sub genTextRow ($$)
my ($q, $text)
((text comment))
sub genButtonRow ($$)
my ($q, $button)
((one button to click eg, perform or save))
sub genNameValueRow ($$$$)
my ($q, $fieldlabel, $fieldname, $fieldvalue)
((a field for user to enter data))
sub genNamePasswdRow ($$$$)
my ($q, $fieldlabel, $fieldname, $fieldvalue)
((data is not displayed, eg *****
sub genWidgetRow ($$$)
my ($q, $fieldlabel, $popup)
((pop_up menu choices, using this avoids having to test uer input))
#------------------------------------------------------------
# subroutine to generate "status report" page (includes footer)
#------------------------------------------------------------
sub genResult ($$)
my ($q, $msg)
#------------------------------------------------------------
# subroutine to set the NTP server
#------------------------------------------------------------
sub performSetTimeserver ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Verify the arguments and untaint the variables (see Camel
# book, "Detecting and laundering tainted data", pg. 358)
#------------------------------------------------------------
my $newStatus = '';
my $ntpServer = '';
Logic test , see perl basics for more logic.
if (defined ($q->param ('ntpdEnabled')))
{
$newStatus = "on";
}
else
{
$newStatus = "off";
}
Test user input, see perl basics for more tests.
my $day = $q->param ('day');
if ($day =~ /^(.*)$/) {
$day = $1;
} else {
$day = "1";
}
if (($day < 1) || ($day > 31))
We have a result message, you need to set up your showinitial form to allow for this, see flow control in 'show initial' section.
{
esmith::cgi::genResult ($q, "Error: invalid day of month ($day). ',
'Please choose a day between 1 and 31.");
return;
}
The final part of the panel saves the key/values pair or key/prop|values sets and then calls an e-smith action or a unix command
#------------------------------------------------------------
# Looks good; go ahead and change the parameters.
#------------------------------------------------------------
if ($newStatus ne "on") # asking to have NTP disabled
{
# make sure that the parameters are set for disabled
my $old = $conf {'UnsavedChanges'};
db_set_prop(\%conf, 'ntpd', 'status', 'disabled');
db_set_prop(\%conf, 'ntpd', 'NTPServer', '');
$conf {'UnsavedChanges'} = $old;
system ("/sbin/e-smith/signal-event", "timeserver-update") == 0
or die ("Error occurred while updating system configuration.\n");
esmith::cgi::genHeaderNonCacheable
($q, \%conf, "Network time server disabled successfully");
esmith::cgi::genResult ($q, "You have disabled this service: The server will rely on its', 'internal clock, and will not try to synchronize from a time server.");
}
else # enable service and synch with ntpServer
{
if ($ntpServer =~ /^([a-zA-Z0-9\.\-]+)$/)
{
$ntpServer = $1;
}
elsif ($ntpServer =~ /^\s*$/)
{
$ntpServer = "";
}
else
{
esmith::cgi::genHeaderNonCacheable ($q, \%conf, "Error while changing network',
'time server setting");
esmith::cgi::genResult ($q, "Invalid NTP server address \"$ntpServer\".");
return;
}
}
return;
}
I give some examples to try and explain some terms, each db command is explained, and an example of the code.
#--------------------------------------------------------------------------
# subroutines to manipulate hashes for e-smith config files
#--------------------------------------------------------------------------
db_set
db_get
db_delete
db_set_type
db_get_type
db_get_prop
db_set_prop
db_delete_prop
db_print
db_show
db_print_type
db_print_prop
#examples
/home/e-smith/configuration
AccessType=dialup
sshd=service|InitscriptOrder|05|status|enabled
/home/e-smith/accounts
jim=user|EmailForward|local|LastName|Morrison
cdrom=system
cgi-bin=url
jim.morrison=pseudonym|account|jim
$hash ; the file containing the variables
/home/e-smith/configuration
or /home/e-smith/accounts
shown as /%conf or /%accounts in the panel perl code
key/value pairs
$key ; AccessType, cdrom, cgi-bin, jim.morrison
$new_value ; dialup, system, url
key/property|value sets
$key ; sshd, jim, jim.morrison
$type ;service, user, pseudonym
$prop ;InitscriptOrder, EmailForward, account, status
$new_value ; 05, local, Morrison, jim, enabled
$hashref ; see below for explanation
#explanations
# db_set
#
# Takes a reference to a hash, a scalar key and a scalar value and an
# optional hash reference. If the hash reference is provided, a new
# value is constructed from the scalar value and the referred to hash.
# It then sets the key/value pair.
#
# It returns one on success and undef on failure.
#--------------------------------------------------------------------------
sub db_set (%$$;$)
my ($hash, $key, $new_value, $hashref)
((
else
{
db_set(\%conf, 'DelegateMailServer', $delegate);
}
))
# db_get
#
# Takes a reference to a hash and an optional scalar key. If the scalar
# key is not provided, it returns a list of keys. If the scalar key is
# provided, it returns the value of that key (in array context, as a list
# suitable for assigning to a type and properties hash list)
# or undef if the key does not exist.
sub db_get (%;$)
my ($hash, $key)
((
my $old = db_get(\%conf, 'UnsavedChanges');
))
# db_delete
#
# Takes a reference to a hash and a scalar key and deletes the key. It
# returns one on success and undef if the key does not exist.
sub db_delete (%$;)
my ($hash, $key)
((
if ($delegate eq "")
{
db_delete(\%conf, 'DelegateMailServer');
}
))
# db_set_type
#
# Takes a reference to a hash, a scalar key and a scalar value and sets
# the type for the key. It returns one on success and undef on failure.
sub db_set_type (%$$;)
my ($hash, $key, $type)
# db_get_type
#
# Takes a reference to a hash and a scalar key and returns the type
# associated with the key. It returns undef if the key does not exist.
sub db_get_type (%$;)
my ($hash, $key)
((
if (db_get(\%accounts, $groupName))
{
my $type = db_get_type(\%accounts, $groupName);
if ($type eq "pseudonym")
{
my $acct = db_get_prop(\%accounts, $groupName, "Account");
))
# db_set_prop
#
# Takes a reference to a hash, a scalar key, a scalar property and a
# scalar value and sets the property from the value. It returns with
# the return status of db_set or undef if the key does not exist.
sub db_set_prop (%$$$;)
((
if ($specifyHeader eq 'on')
{
db_set_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope', $header);
}
else
{
db_delete_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope');
}
))
# db_get_prop
#
# Takes a reference to a hash, a scalar key and an optional scalar
# property. If the property is supplied, it returns the value associated
# with that property. If the property is not supplied, it returns a
# hash of all properties for the key. It returns undef if the key or
# the property does not exist.
sub db_get_prop (%$;$)
my ($hash, $key, $prop)
((
my $SecondaryMailServer =
db_get_prop(\%conf, "fetchmail", "SecondaryMailServer")
))
# db_delete_prop
#
# Takes a reference to a hash, a scalar key and a scalar property and
# deletes the property from the value. It returns with the return status
# of db_set or undef if the key or the property do not exist.
sub db_delete_prop (%$$;)
my ($hash, $key, $prop)
((
if ($specifyHeader eq 'on')
{
db_set_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope', $header);
}
else
{
db_delete_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope');
}
))
# db_print
#
# Takes a reference to a hash and an optional scalar key. If the scalar
# key is not provided, it prints key=value for each key in the hash. If
# the scalar key is provided, it prints key=value for that key. It
# returns one on success or undef if the key does not exist.
sub db_print (%;$)
my ($hash, $key)
# db_show
#
# Takes a reference to a hash and an optional scalar key. If the scalar
# key is not provided, it prints key/value pairs for each key in the
# hash. If the scalar key is provided, it prints the key/value for
# that key. The value is expanded to show properties. It returns one
# on success or undef if the key does not exist.
sub db_show (%;$)
my ($hash, $key)
# db_print_type
#
# Takes a reference to a hash and an optional scalar key. If the scalar
# key is not provided, it prints key=type for each key in the hash. If
# the scalar key is provided, it prints key=type for that key. It
# returns one on success or undef if the key does not exist.
sub db_print_type (%;$)
my ($hash, $key)
# db_print_prop
#
# Takes a reference to a hash, a scalar key and an optional scalar
# property. If the scalar property is not provided, it prints prop=value
# for each property associated with the key. If the scalar property is
# provided, it prints prop=value for that key. It returns one on success
# or undef if the key or property does not exist.
sub db_print_prop (%$;$)
my ($hash, $key, $prop)
my $FetchmailFreqOffice = db_get_prop(\%conf, "fetchmail", "FreqOffice")
|| 'every15min';
my $account = db_get_prop(\%accounts, $pseudonym, 'Account');
$account = "Administrator" if ($account eq "admin");
"(value eq 'something') ?" if first is true determine the second
my $FetchMethod =
(db_get_prop(\%conf, "fetchmail", "status") eq 'enabled') ?
(db_get_prop(\%conf, "fetchmail", "Method") || 'standard') :
'standard';
"if (defined $something)" if defined then first else second
my $SecondaryMailUseEnvelope;
if (defined $SecondaryMailEnvelope)
{
$SecondaryMailUseEnvelope = "on";
}
else
{
$SecondaryMailUseEnvelope = "off";
$SecondaryMailEnvelope = "";
}
"&&" if true twice continue
if (defined $backup_status && $backup_status eq "enabled")
{
print $q->p ("Tape backups are enabled.");
}
else
{
print $q->p ("Tape backups are disabled.");
}
db_set_prop(\%conf, "fetchmail", 'SecondaryMailServer', $server)
unless ($server eq '');;
db_set_prop(\%conf, "fetchmail", 'FreqOffice', $fetchmailFreqOffice);
"foreach"
foreach $pseudonym ("everyone", "mailer-daemon", "postmaster")
{
do something over
}
if (length $HostName > 32)
{
showInitial ($q,
"Error: account name \"$HostName\" is too long. The
maximum is 32 characters.");
return;
}
Input can be anything, except consecutive dots. The test is applied against the contents of the ()brackets,
my $password = $q->param ('password');
if ($password =~ /^(.*)$/)
{
$password = $1;
}
else
{
$password = "";
}
Group name, ie start with a lowercase letter then allow - , _ , .a-z0-9 ; the \ escapes the perl meaning of the character. \. checks for consecutive periods - e.g. foo..bar
my $groupName = $q->param ('groupName');
if ($groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/)
{
$groupName = $1;
}
else
{
showInitial ($q,
"Error: unexpected characters in group name: " .
"\"$groupName\". The group name should contain only " .
"lower-case letters, numbers, hyphens, periods, and underscores, and should start " .
"with a lower-case letter. For example \"sales\", \"beta5\", and \"reseller_partners\" are " .
"all valid group names, but \"3rd-event\", \"Marketing Team\" " .
"and \"order-status\" are not.");
return;
If you have a lot of tests you can define a set of expressions, describe them, and test for them
#define expression to test
my $REGEXPHostname = '([a-z0-9][a-z0-9-\.]*)';
my $REGEXPIPAddress = '(self|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})';
my $REGEXPMACAddress = '([0-9a-f][0-9a-f](:[0-9a-f][0-9a-f]){5})';
#advice to user
esmith::cgi::genTextRow ($q, $q->p ( 'The IP address displayed
is the IP address of the e-smith server. If this hostname
is another name for this e-smith server, you can accept
the default value. Otherwise, please enter a valid IP
address in the format "aaa.bbb.ccc.ddd"' )),
#get input
esmith::cgi::genNameValueRow ($q,
"Hostname",
"HostName",
""),
#test input
my $MACAddress = lc($q->param ('MACAddress'));
if ( length($MACAddress) == 0 )
{
# They don't want one
}
elsif ($MACAddress =~ /^$REGEXPMACAddress$/ )
{
$MACAddress = $1;
}
else
{
showInitial ($q,
"Error: Ethernet Address \"$MACAddress\"
is invalid. Ethernet addresses must be in the
form \"AA:BB:CC:DD:EE:FF\" and only contain the
numbers 0-9 and the letters A-F. Did not create
host entry.");
return;
system ("/sbin/e-smith/signal-event", "email-update") == 0
or die ("Error occurred while updating system configuration.\n");
esmith::cgi::genHeaderNonCacheable
($q,\%conf, "Email settings changed successfully");
esmith::cgi::genResult ($q, "The new email settings have been saved.");
BackgroundCommand allows you to delay the execution is seconds, below it's 1. Other than that i don't know the reason for choosing it, maybe it's the old way?
esmith::util::backgroundCommand (1,"/etc/rc.d/init.d/diald","restart");
esmith::cgi::genHeaderNonCacheable
($q, \%conf, "Dialup funtion performed - down");
esmith::cgi::genResult ($q, "The modem is going down");
Check you have correct permissions, and locate/link it the e-smith way
cd /etc/e-smith/web/functions/
chmod 750 thing, then chmod u+s thing (?sn)
cd /etc/e-smith/web/panel/manager/cgi-bin
ln -s ../../../thing thing
Stephen Noble April 2001 ver 0.1-2