Difference between revisions of "Create server-manager panels by perl cgi (deprecated)"
Line 489: | Line 489: | ||
* examples | * examples | ||
− | /home/e-smith/configuration | + | /home/e-smith/configuration |
− | AccessType=dialup | + | AccessType=dialup |
− | sshd=service|InitscriptOrder|05|status|enabled | + | sshd=service|InitscriptOrder|05|status|enabled |
− | /home/e-smith/accounts | + | /home/e-smith/accounts |
− | jim=user|EmailForward|local|LastName|Morrison | + | jim=user|EmailForward|local|LastName|Morrison |
− | cdrom=system | + | cdrom=system |
− | cgi-bin=url | + | cgi-bin=url |
− | jim.morrison=pseudonym|account|jim | + | jim.morrison=pseudonym|account|jim |
− | $hash ; the file containing the variables | + | $hash ; the file containing the variables |
− | /home/e-smith/configuration | + | /home/e-smith/configuration |
− | or /home/e-smith/accounts | + | or /home/e-smith/accounts |
− | shown as /%conf or /%accounts in the panel perl code | + | shown as /%conf or /%accounts in the panel perl code |
− | key/value pairs | + | key/value pairs |
− | $key ; AccessType, cdrom, cgi-bin, jim.morrison | + | $key ; AccessType, cdrom, cgi-bin, jim.morrison |
− | $new_value ; dialup, system, url | + | $new_value ; dialup, system, url |
− | key/property|value sets | + | key/property|value sets |
− | $key ; sshd, jim, jim.morrison | + | $key ; sshd, jim, jim.morrison |
− | $type ;service, user, pseudonym | + | $type ;service, user, pseudonym |
− | $prop ;InitscriptOrder, EmailForward, account, status | + | $prop ;InitscriptOrder, EmailForward, account, status |
− | $new_value ; 05, local, Morrison, jim, enabled | + | $new_value ; 05, local, Morrison, jim, enabled |
− | $hashref ; see below for explanation | + | $hashref ; see below for explanation |
* explanations | * explanations | ||
Line 527: | Line 527: | ||
# It returns one on success and undef on failure. | # It returns one on success and undef on failure. | ||
#-------------------------------------------------------------------------- | #-------------------------------------------------------------------------- | ||
− | + | ||
sub db_set (%$$;$) | sub db_set (%$$;$) | ||
my ($hash, $key, $new_value, $hashref) | my ($hash, $key, $new_value, $hashref) | ||
Line 544: | Line 544: | ||
# suitable for assigning to a type and properties hash list) | # suitable for assigning to a type and properties hash list) | ||
# or undef if the key does not exist. | # or undef if the key does not exist. | ||
− | + | ||
sub db_get (%;$) | sub db_get (%;$) | ||
my ($hash, $key) | my ($hash, $key) | ||
Line 555: | Line 555: | ||
# Takes a reference to a hash and a scalar key and deletes the key. It | # 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. | # returns one on success and undef if the key does not exist. | ||
− | + | ||
sub db_delete (%$;) | sub db_delete (%$;) | ||
my ($hash, $key) | my ($hash, $key) | ||
Line 570: | Line 570: | ||
# Takes a reference to a hash, a scalar key and a scalar value and sets | # 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. | # the type for the key. It returns one on success and undef on failure. | ||
− | + | ||
sub db_set_type (%$$;) | sub db_set_type (%$$;) | ||
my ($hash, $key, $type) | my ($hash, $key, $type) | ||
Line 579: | Line 579: | ||
# Takes a reference to a hash and a scalar key and returns the 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. | # associated with the key. It returns undef if the key does not exist. | ||
− | + | ||
sub db_get_type (%$;) | sub db_get_type (%$;) | ||
my ($hash, $key) | my ($hash, $key) | ||
Line 599: | Line 599: | ||
# scalar value and sets the property from the value. It returns with | # 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. | # the return status of db_set or undef if the key does not exist. | ||
− | + | ||
sub db_set_prop (%$$$;) | sub db_set_prop (%$$$;) | ||
(( | (( | ||
Line 620: | Line 620: | ||
# hash of all properties for the key. It returns undef if the key or | # hash of all properties for the key. It returns undef if the key or | ||
# the property does not exist. | # the property does not exist. | ||
− | + | ||
sub db_get_prop (%$;$) | sub db_get_prop (%$;$) | ||
my ($hash, $key, $prop) | my ($hash, $key, $prop) | ||
Line 634: | Line 634: | ||
# deletes the property from the value. It returns with the return status | # 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. | # of db_set or undef if the key or the property do not exist. | ||
− | + | ||
sub db_delete_prop (%$$;) | sub db_delete_prop (%$$;) | ||
my ($hash, $key, $prop) | my ($hash, $key, $prop) | ||
Line 655: | Line 655: | ||
# the scalar key is provided, it prints key=value for that key. It | # 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. | # returns one on success or undef if the key does not exist. | ||
− | + | ||
sub db_print (%;$) | sub db_print (%;$) | ||
my ($hash, $key) | my ($hash, $key) | ||
Line 667: | Line 667: | ||
# that key. The value is expanded to show properties. It returns one | # that key. The value is expanded to show properties. It returns one | ||
# on success or undef if the key does not exist. | # on success or undef if the key does not exist. | ||
− | + | ||
sub db_show (%;$) | sub db_show (%;$) | ||
my ($hash, $key) | my ($hash, $key) | ||
Line 678: | Line 678: | ||
# the scalar key is provided, it prints key=type for that key. It | # 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. | # returns one on success or undef if the key does not exist. | ||
− | + | ||
sub db_print_type (%;$) | sub db_print_type (%;$) | ||
my ($hash, $key) | my ($hash, $key) | ||
Line 690: | Line 690: | ||
# provided, it prints prop=value for that key. It returns one on success | # provided, it prints prop=value for that key. It returns one on success | ||
# or undef if the key or property does not exist. | # or undef if the key or property does not exist. | ||
− | + | ||
sub db_print_prop (%$;$) | sub db_print_prop (%$;$) | ||
my ($hash, $key, $prop) | my ($hash, $key, $prop) |
Revision as of 15:57, 9 June 2015
Introduction
Writing a panel for an e-smith server need not be difficult. By choosing an existing panel that is similar to what you need you can get a head start. You need only a small background in any sort of programming, coding html or similar.
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
Preliminary
The 'Heading' is the section of the panel it goes in, the 'description is displayed in the left frame of the panel, and it's order in that section is determined by comparing numeric values.
#!/usr/bin/perl -wT #---------------------------------------------------------------------- # heading : Configuration # description : Email Retrival # navigation : 4000 4400 The 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 tie %conf is /home/e-smith/configuration a plain text file that stores our values. tie %accounts is making available a second file to store values.
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);
Web Pages
Here are some examples of coding the html for the panel. A longer list of esmith::cgi::(value) options are described in the next section, HTML elements.
#------------------------------------------------------------ # 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.
$q->p is ordinary text $q->b is bold $q->h4 is a heading
are these perl options ? where can i find more examples. (?sn)
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); }
Another example
This shows a sub table, an alternative method to enter a larger block of descriptive text and coding a check box. It shows how to get a value for a key and alter the way the page is displayed based on the result of a test of the key value. NOTE. the html version of the following example will appear odd as some of the code is not being escaped.
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 ;
Example to control flow
Open a sub page based on it's name/state
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<');
HTML Elements
esmith::cgi::(value) is the way to add html elements to the panel page. A more complete list of elements that you can add to you panel page follows an explanation of the types of parameters to be passed.
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)
Run Subroutines
Define local variables, set a second variable based on a first, test user input.
#------------------------------------------------------------ # 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; }
DB Commands
DB_ commands manipulate and quiry the e-smith configuration files.
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)
Basic Perl
A few samples that demonstrate correct coding practise. In areas of logic, Testing user input, and calling events and unix programs.
=Logic
"||" gives an answer if the first try didn't work.
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 }
Testing user input
Test for length of input data.
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;
Run command (event)
The point of using the panel is to make a change or make something happen. There are two ways to run a command, the full path is required as we reset the path in the preliminary section.
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");
References
Bugs
Syntax errors are common, a misplaced , or missed ) will result in a panel that will not run or compile. Look in /var/log/httpd/admin_error_log for errors or admin_access_log will report success. Check that httpd-admin is running as well as httpd, via a ps -A |grep httpd.
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 Links www.e-smth.org duh www.perl.org Thanks A big thank you to Gordon, Charlie and the e-smith team.
Stephen Noble April 2001 ver 0.1-2