Line 1: |
Line 1: |
| {{Level|Developer}} | | {{Level|Developer}} |
| | | |
− | {{warning bow|msg= This documentation on how to build a panel in the server-manager is completely deprecated but it can bring to the developers some trick to understand what it occurs in an old contrib. Please if you intend to build a panel you should use formagick instead of the perl cgi}} | + | {{warning box|msg= '''This documentation on how to build a panel in the server-manager is completely deprecated''' but it can bring to the developers some tricks to understand what is occurring in old contribs. Please if you intend to build a panel you should use formagick instead of the perl cgi}} |
| + | [http://dungog.net/wiki/Main_Page original Author] <br /> |
| + | |
| + | [http://www.sme-server.de/download/Howtos/e-smith_panel_howto.html original link] |
| ===Introduction=== | | ===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. | | 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. |
Line 72: |
Line 75: |
| # external programs do not cause results to be tainted. See | | # external programs do not cause results to be tainted. See |
| # "perlsec" manual page for details. | | # "perlsec" manual page for details. |
− | | + | |
| $ENV {'PATH'} = ''; | | $ENV {'PATH'} = ''; |
| $ENV {'SHELL'} = '/bin/bash'; | | $ENV {'SHELL'} = '/bin/bash'; |
Line 138: |
Line 141: |
| Descriptive text explaining the page. | | Descriptive text explaining the page. |
| $q->p is ordinary text | | $q->p is ordinary text |
− | $q->is bold | + | $q->b is bold |
| $q->h4 is a heading | | $q->h4 is a heading |
| are these perl options ? where can i find more examples. (?sn) | | are these perl options ? where can i find more examples. (?sn) |
Line 144: |
Line 147: |
| esmith::cgi::genTextRow | | esmith::cgi::genTextRow |
| ($q, $q->p ('Enter the name of the', | | ($q, $q->p ('Enter the name of the', |
− | $q->b ('windows workgroup'),
| + | $q->b ('windows workgroup'), |
− | 'that the e-smith server should appear in.')),
| + | '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 | | 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, | | esmith::cgi::genNameValueRow ($q, |
− | "Windows workgroup",
| + | "Windows workgroup", |
− | "sambaWorkgroup",
| + | "sambaWorkgroup", |
− | $conf {'SambaWorkgroup'}),
| + | $conf {'SambaWorkgroup'}), |
| | | |
| esmith::cgi::genTextRow | | esmith::cgi::genTextRow |
| ($q, $q->p ('Enter the name that the e-smith server should use', | | ($q, $q->p ('Enter the name that the e-smith server should use', |
− | 'for Windows and Macintosh file sharing.')),
| + | 'for Windows and Macintosh file sharing.')), |
| | | |
| esmith::cgi::genNameValueRow ($q, | | esmith::cgi::genNameValueRow ($q, |
− | "Server name",
| + | "Server name", |
− | "sambaServerName",
| + | "sambaServerName", |
− | $conf {'SambaServerName'}),
| + | $conf {'SambaServerName'}), |
| | | |
| esmith::cgi::genTextRow | | esmith::cgi::genTextRow |
− | ($q, $q->p ('Should the e-smith server be the domain master for your 'Windows workgroup?', | + | ($q, $q->p ('Should the e-smith server be the domain master for your 'Windows workgroup?', |
− | 'Typically the answer should be',
| + | 'Typically the answer should be', |
− | $q->b ('no'),
| + | $q->b ('no'), |
− | 'if you are running a Windows NT server on this network, and,',
| + | 'if you are running a Windows NT server on this network, and,', |
− | $q->b ('yes'),
| + | $q->b ('yes'), |
− | 'otherwise.') . ' ' .
| + | 'otherwise.') . ' ' . |
| | | |
| $q->p ('If you enable e-smith server to be the domain master a', | | $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',
| + | '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',
| + | 'for those who do not wish to use it. It is recommended that only', |
− | 'experienced users customize the netlogon.bat script.')),
| + | '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 | | 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:"), | | $q->Tr (esmith::cgi::genCell ($q, "Domain master:"), |
− | esmith::cgi::genCell ($q, $q->popup_menu (-name => 'sambaDomainMaster',
| + | esmith::cgi::genCell ($q, $q->popup_menu (-name => 'sambaDomainMaster', |
− | -values => ['yes', 'no'],
| + | -values => ['yes', 'no'], |
− | -default => $conf {'SambaDomainMaster'},
| + | -default => $conf {'SambaDomainMaster'}, |
− | -labels => \%yesnoLabels))),
| + | -labels => \%yesnoLabels))), |
| | | |
| Create a button to push, name and label it. End the html for the page. | | Create a button to push, name and label it. End the html for the page. |
| | | |
| esmith::cgi::genButtonRow ($q, | | esmith::cgi::genButtonRow ($q, |
− | $q->submit (-name => 'action', -value => 'Save')));
| + | $q->submit (-name => 'action', -value => 'Save'))); |
| | | |
| print $q->hidden (-name => 'state', -override => 1, -default => 'perform'); | | print $q->hidden (-name => 'state', -override => 1, -default => 'perform'); |
Line 205: |
Line 208: |
| if (db_get_prop(\%conf, 'ntpd', 'status') eq "enabled") | | if (db_get_prop(\%conf, 'ntpd', 'status') eq "enabled") |
| { | | { |
− | $enabledChk = "checked";
| + | $enabledChk = "checked"; |
| } | | } |
| | | |
Line 220: |
Line 223: |
| print $q->table ({border => 0, cellspacing => 0, cellpadding => 4}, | | print $q->table ({border => 0, cellspacing => 0, cellpadding => 4}, |
| | | |
− | esmith::cgi::genTextRow
| + | esmith::cgi::genTextRow |
− | ($q, $q->p ($description)),
| + | ($q, $q->p ($description)), |
| | | |
− | esmith::cgi::genTextRow
| + | esmith::cgi::genTextRow |
− | ($q, $q->p ("Enable NTP Service ',
| + | ($q, $q->p ("Enable NTP Service ', |
− | '>input type=\"checkbox\" name=\"ntpdEnabled\"$enabledChk<")),
| + | '>input type=\"checkbox\" name=\"ntpdEnabled\"$enabledChk<")), |
| | | |
− | esmith::cgi::genNameValueRow ($q,
| + | esmith::cgi::genNameValueRow ($q, |
− | "NTP server",
| + | "NTP server", |
− | "ntpServer",
| + | "ntpServer", |
− | $oldNTPServer),
| + | $oldNTPServer), |
| | | |
− | esmith::cgi::genButtonRow ($q,
| + | esmith::cgi::genButtonRow ($q, |
− | $q->submit (-name => 'action', -value => 'Save NTP Settings')));
| + | $q->submit (-name => 'action', -value => 'Save NTP Settings'))); |
| | | |
| print ''; | | print ''; |
Line 241: |
Line 244: |
| | | |
| print $q->p ($q->a ({href => $q->url (-absolute => 1) . "?state=create"}, | | print $q->p ($q->a ({href => $q->url (-absolute => 1) . "?state=create"}, |
− | 'Click here'),
| + | 'Click here'), |
− | 'to create a user group.');
| + | 'to create a user group.'); |
| | | |
| Which we defined above | | Which we defined above |
Line 264: |
Line 267: |
| if ($msg eq '') | | if ($msg eq '') |
| { | | { |
− | esmith::cgi::genHeaderNonCacheable
| + | esmith::cgi::genHeaderNonCacheable |
− | ($q, \%conf, 'Create, remove, or change user groups');
| + | ($q, \%conf, 'Create, remove, or change user groups'); |
| } | | } |
| else | | else |
| { | | { |
− | esmith::cgi::genHeaderNonCacheable
| + | esmith::cgi::genHeaderNonCacheable |
− | ($q, \%conf, 'Operation status report');
| + | ($q, \%conf, 'Operation status report'); |
| | | |
− | print $q->p ($msg);
| + | print $q->p ($msg); |
− | print $q->hr;
| + | print $q->hr; |
| } | | } |
| | | |
Line 321: |
Line 324: |
| | | |
| print $q->Tr (esmith::cgi::genSmallRedCell ($q, $pseudonym), | | print $q->Tr (esmith::cgi::genSmallRedCell ($q, $pseudonym), |
− | esmith::cgi::genSmallCell ($q, $account),
| + | esmith::cgi::genSmallCell ($q, $account), |
− | $q->td (' '), #also works
| + | $q->td (' '), #also works |
− | esmith::cgi::genSmallCell ($q, " " ),
| + | esmith::cgi::genSmallCell ($q, " " ), |
− | );
| + | ); |
| | | |
| or you can have just one cell per row, for a genSmallRedCell warning? )) | | or you can have just one cell per row, for a genSmallRedCell warning? )) |
Line 377: |
Line 380: |
| { | | { |
| my ($q) = @_; | | my ($q) = @_; |
− | | + | |
| #------------------------------------------------------------ | | #------------------------------------------------------------ |
| # Verify the arguments and untaint the variables (see Camel | | # Verify the arguments and untaint the variables (see Camel |
Line 390: |
Line 393: |
| if (defined ($q->param ('ntpdEnabled'))) | | if (defined ($q->param ('ntpdEnabled'))) |
| { | | { |
− | $newStatus = "on";
| + | $newStatus = "on"; |
| } | | } |
| else | | else |
| { | | { |
− | $newStatus = "off";
| + | $newStatus = "off"; |
| } | | } |
| | | |
Line 401: |
Line 404: |
| my $day = $q->param ('day'); | | my $day = $q->param ('day'); |
| if ($day =~ /^(.*)$/) { | | if ($day =~ /^(.*)$/) { |
− | $day = $1;
| + | $day = $1; |
| } else { | | } else { |
− | $day = "1";
| + | $day = "1"; |
| } | | } |
| if (($day < 1) || ($day > 31)) | | if (($day < 1) || ($day > 31)) |
Line 411: |
Line 414: |
| { | | { |
| esmith::cgi::genResult ($q, "Error: invalid day of month ($day). ', | | esmith::cgi::genResult ($q, "Error: invalid day of month ($day). ', |
− | 'Please choose a day between 1 and 31.");
| + | 'Please choose a day between 1 and 31."); |
− | return;
| + | 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 | | 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.
| + | # Looks good; go ahead and change the parameters. |
− | #------------------------------------------------------------
| + | #------------------------------------------------------------ |
− | | + | |
− | if ($newStatus ne "on") # asking to have NTP disabled | + | if ($newStatus ne "on") # asking to have NTP disabled |
| { | | { |
− | # make sure that the parameters are set for disabled
| + | # make sure that the parameters are set for disabled |
− | | + | |
− | my $old = $conf {'UnsavedChanges'};
| + | my $old = $conf {'UnsavedChanges'}; |
− | db_set_prop(\%conf, 'ntpd', 'status', 'disabled');
| + | db_set_prop(\%conf, 'ntpd', 'status', 'disabled'); |
− | db_set_prop(\%conf, 'ntpd', 'NTPServer', '');
| + | db_set_prop(\%conf, 'ntpd', 'NTPServer', ''); |
− | $conf {'UnsavedChanges'} = $old;
| + | $conf {'UnsavedChanges'} = $old; |
− | | + | |
− | system ("/sbin/e-smith/signal-event", "timeserver-update") == 0
| + | system ("/sbin/e-smith/signal-event", "timeserver-update") == 0 |
− | or die ("Error occurred while updating system configuration.\n");
| + | or die ("Error occurred while updating system configuration.\n"); |
− | | + | |
− | esmith::cgi::genHeaderNonCacheable
| + | esmith::cgi::genHeaderNonCacheable |
− | ($q, \%conf, "Network time server disabled successfully");
| + | ($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.");
| + | 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 | + | else # enable service and synch with ntpServer |
− | | + | |
| { | | { |
− | if ($ntpServer =~ /^([a-zA-Z0-9\.\-]+)$/)
| + | if ($ntpServer =~ /^([a-zA-Z0-9\.\-]+)$/) |
− | {
| + | { |
− | $ntpServer = $1;
| + | $ntpServer = $1; |
− | }
| + | } |
− | elsif ($ntpServer =~ /^\s*$/)
| + | elsif ($ntpServer =~ /^\s*$/) |
− | {
| + | { |
− | $ntpServer = "";
| + | $ntpServer = ""; |
− | }
| + | } |
− | else
| + | else |
− | {
| + | { |
− | esmith::cgi::genHeaderNonCacheable ($q, \%conf, "Error while changing network',
| + | esmith::cgi::genHeaderNonCacheable ($q, \%conf, "Error while changing network', |
| 'time server setting"); | | 'time server setting"); |
− | esmith::cgi::genResult ($q, "Invalid NTP server address \"$ntpServer\".");
| + | esmith::cgi::genResult ($q, "Invalid NTP server address \"$ntpServer\"."); |
− | return;
| + | return; |
− | }
| + | } |
| } | | } |
− | | + | |
| return; | | return; |
| } | | } |
Line 470: |
Line 473: |
| #-------------------------------------------------------------------------- | | #-------------------------------------------------------------------------- |
| | | |
− | db_set
| + | db_set |
− | db_get
| + | db_get |
− | db_delete
| + | db_delete |
− | | + | |
− | db_set_type
| + | db_set_type |
− | db_get_type
| + | db_get_type |
− | | + | |
− | db_get_prop
| + | db_get_prop |
− | db_set_prop
| + | db_set_prop |
− | db_delete_prop
| + | db_delete_prop |
− | | + | |
− | db_print
| + | db_print |
− | db_show
| + | db_show |
− | | + | |
− | db_print_type
| + | db_print_type |
− | db_print_prop
| + | db_print_prop |
| * 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 526: |
Line 529: |
| # 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 532: |
Line 535: |
| else | | else |
| { | | { |
− | db_set(\%conf, 'DelegateMailServer', $delegate);
| + | db_set(\%conf, 'DelegateMailServer', $delegate); |
| } | | } |
| )) | | )) |
Line 543: |
Line 546: |
| # 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 554: |
Line 557: |
| # 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 560: |
Line 563: |
| if ($delegate eq "") | | if ($delegate eq "") |
| { | | { |
− | db_delete(\%conf, 'DelegateMailServer');
| + | db_delete(\%conf, 'DelegateMailServer'); |
| } | | } |
| )) | | )) |
Line 569: |
Line 572: |
| # 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 578: |
Line 581: |
| # 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 584: |
Line 587: |
| if (db_get(\%accounts, $groupName)) | | if (db_get(\%accounts, $groupName)) |
| { | | { |
− | my $type = db_get_type(\%accounts, $groupName);
| + | my $type = db_get_type(\%accounts, $groupName); |
| | | |
− | if ($type eq "pseudonym")
| + | if ($type eq "pseudonym") |
− | {
| + | { |
− | my $acct = db_get_prop(\%accounts, $groupName, "Account");
| + | my $acct = db_get_prop(\%accounts, $groupName, "Account"); |
| | | |
| )) | | )) |
Line 598: |
Line 601: |
| # 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 (%$$$;) |
| (( | | (( |
− | if ($specifyHeader eq 'on')
| + | if ($specifyHeader eq 'on') |
− | {
| + | { |
− | db_set_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope', $header);
| + | db_set_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope', $header); |
− | }
| + | } |
− | else
| + | else |
− | {
| + | { |
− | db_delete_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope');
| + | db_delete_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope'); |
− | }
| + | } |
| )) | | )) |
| | | |
Line 619: |
Line 622: |
| # 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) |
| (( | | (( |
| my $SecondaryMailServer = | | my $SecondaryMailServer = |
− | db_get_prop(\%conf, "fetchmail", "SecondaryMailServer")
| + | db_get_prop(\%conf, "fetchmail", "SecondaryMailServer") |
| )) | | )) |
| | | |
Line 633: |
Line 636: |
| # 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) |
| (( | | (( |
− | if ($specifyHeader eq 'on')
| + | if ($specifyHeader eq 'on') |
− | {
| + | { |
− | db_set_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope', $header);
| + | db_set_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope', $header); |
− | }
| + | } |
− | else
| + | else |
− | {
| + | { |
− | db_delete_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope');
| + | db_delete_prop(\%conf, "fetchmail", 'SecondaryMailEnvelope'); |
− | }
| + | } |
| )) | | )) |
| | | |
Line 654: |
Line 657: |
| # 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 666: |
Line 669: |
| # 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 677: |
Line 680: |
| # 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 689: |
Line 692: |
| # 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) |
Line 695: |
Line 698: |
| ===Basic Perl=== | | ===Basic Perl=== |
| A few samples that demonstrate correct coding practise. In areas of logic, Testing user input, and calling events and unix programs. | | A few samples that demonstrate correct coding practise. In areas of logic, Testing user input, and calling events and unix programs. |
− | ====Logic=== | + | ====Logic==== |
− | "||" gives an answer if the first try didn't work. | + | * "||" gives an answer if the first try didn't work. |
| | | |
| my $FetchmailFreqOffice = db_get_prop(\%conf, "fetchmail", "FreqOffice") | | my $FetchmailFreqOffice = db_get_prop(\%conf, "fetchmail", "FreqOffice") |
− | || 'every15min';
| + | || '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 $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 = | | my $FetchMethod = |
− | (db_get_prop(\%conf, "fetchmail", "status") eq 'enabled') ?
| + | (db_get_prop(\%conf, "fetchmail", "status") eq 'enabled') ? |
− | (db_get_prop(\%conf, "fetchmail", "Method") || 'standard') :
| + | (db_get_prop(\%conf, "fetchmail", "Method") || 'standard') : |
− | 'standard';
| + | 'standard'; |
| | | |
− | "if (defined $something)" if defined then first else second | + | * "if (defined $something)" if defined then first else second |
| | | |
| my $SecondaryMailUseEnvelope; | | my $SecondaryMailUseEnvelope; |
| if (defined $SecondaryMailEnvelope) | | if (defined $SecondaryMailEnvelope) |
| { | | { |
− | $SecondaryMailUseEnvelope = "on";
| + | $SecondaryMailUseEnvelope = "on"; |
| } | | } |
| else | | else |
| { | | { |
− | $SecondaryMailUseEnvelope = "off";
| + | $SecondaryMailUseEnvelope = "off"; |
− | $SecondaryMailEnvelope = "";
| + | $SecondaryMailEnvelope = ""; |
| } | | } |
| | | |
− | "&&" if true twice continue | + | * "&&" if true twice continue |
| | | |
| if (defined $backup_status && $backup_status eq "enabled") | | if (defined $backup_status && $backup_status eq "enabled") |
| { | | { |
− | print $q->p ("Tape backups are enabled.");
| + | print $q->p ("Tape backups are enabled."); |
| } | | } |
| else | | else |
| { | | { |
− | print $q->p ("Tape backups are disabled.");
| + | 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" | | db_set_prop(\%conf, "fetchmail", 'SecondaryMailServer', $server) unless ($server eq '');; db_set_prop(\%conf, "fetchmail", 'FreqOffice', $fetchmailFreqOffice); "foreach" |
| | | |
− | foreach $pseudonym ("everyone", "mailer-daemon", "postmaster")
| + | foreach $pseudonym ("everyone", "mailer-daemon", "postmaster") |
− | {
| + | { |
| do something over | | do something over |
| } | | } |
Line 744: |
Line 747: |
| if (length $HostName > 32) | | if (length $HostName > 32) |
| { | | { |
− | showInitial ($q,
| + | showInitial ($q, |
− | "Error: account name \"$HostName\" is too long. The
| + | "Error: account name \"$HostName\" is too long. The |
− | maximum is 32 characters.");
| + | maximum is 32 characters."); |
− | return;
| + | return; |
| } | | } |
| | | |
Line 755: |
Line 758: |
| if ($password =~ /^(.*)$/) | | if ($password =~ /^(.*)$/) |
| { | | { |
− | $password = $1;
| + | $password = $1; |
| } | | } |
| else | | else |
| { | | { |
− | $password = "";
| + | $password = ""; |
| } | | } |
| | | |
Line 767: |
Line 770: |
| if ($groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/) | | if ($groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/) |
| { | | { |
− | $groupName = $1;
| + | $groupName = $1; |
| } | | } |
| else | | else |
| { | | { |
− | showInitial ($q,
| + | showInitial ($q, |
− | "Error: unexpected characters in group name: " .
| + | "Error: unexpected characters in group name: " . |
− | "\"$groupName\". The group name should contain only " .
| + | "\"$groupName\". The group name should contain only " . |
− | "lower-case letters, numbers, hyphens, periods, and underscores, and should start " .
| + | "lower-case letters, numbers, hyphens, periods, and underscores, and should start " . |
− | "with a lower-case letter. For example \"sales\", \"beta5\", and \"reseller_partners\" are " .
| + | "with a lower-case letter. For example \"sales\", \"beta5\", and \"reseller_partners\" are " . |
− | "all valid group names, but \"3rd-event\", \"Marketing Team\" " .
| + | "all valid group names, but \"3rd-event\", \"Marketing Team\" " . |
− | "and \"order-status\" are not.");
| + | "and \"order-status\" are not."); |
− | return;
| + | return; |
| | | |
| If you have a lot of tests you can define a set of expressions, describe them, and test for them | | If you have a lot of tests you can define a set of expressions, describe them, and test for them |
| | | |
− | #define expression to test
| + | * define expression to test |
| my $REGEXPHostname = '([a-z0-9][a-z0-9-\.]*)'; | | my $REGEXPHostname = '([a-z0-9][a-z0-9-\.]*)'; |
| my $REGEXPIPAddress = '(self|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})'; | | my $REGEXPIPAddress = '(self|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})'; |
Line 788: |
Line 791: |
| | | |
| | | |
− | #advice to user
| + | * advice to user |
| esmith::cgi::genTextRow ($q, $q->p ( 'The IP address displayed | | esmith::cgi::genTextRow ($q, $q->p ( 'The IP address displayed |
| is the IP address of the e-smith server. If this hostname | | is the IP address of the e-smith server. If this hostname |
Line 795: |
Line 798: |
| address in the format "aaa.bbb.ccc.ddd"' )), | | address in the format "aaa.bbb.ccc.ddd"' )), |
| | | |
− | #get input
| + | * get input |
− | esmith::cgi::genNameValueRow ($q,
| + | esmith::cgi::genNameValueRow ($q, |
− | "Hostname",
| + | "Hostname", |
− | "HostName",
| + | "HostName", |
− | ""),
| + | ""), |
− | #test input
| + | * test input |
| my $MACAddress = lc($q->param ('MACAddress')); | | my $MACAddress = lc($q->param ('MACAddress')); |
| | | |
Line 809: |
Line 812: |
| elsif ($MACAddress =~ /^$REGEXPMACAddress$/ ) | | elsif ($MACAddress =~ /^$REGEXPMACAddress$/ ) |
| { | | { |
− | $MACAddress = $1;
| + | $MACAddress = $1; |
| } | | } |
| else | | else |
| { | | { |
− | showInitial ($q,
| + | showInitial ($q, |
− | "Error: Ethernet Address \"$MACAddress\"
| + | "Error: Ethernet Address \"$MACAddress\" |
| is invalid. Ethernet addresses must be in the | | is invalid. Ethernet addresses must be in the |
| form \"AA:BB:CC:DD:EE:FF\" and only contain the | | form \"AA:BB:CC:DD:EE:FF\" and only contain the |
| numbers 0-9 and the letters A-F. Did not create | | numbers 0-9 and the letters A-F. Did not create |
| host entry."); | | host entry."); |
− | return;
| + | return; |
| | | |
| ====Run command (event)==== | | ====Run command (event)==== |
Line 825: |
Line 828: |
| | | |
| system ("/sbin/e-smith/signal-event", "email-update") == 0 | | system ("/sbin/e-smith/signal-event", "email-update") == 0 |
− | or die ("Error occurred while updating system configuration.\n");
| + | or die ("Error occurred while updating system configuration.\n"); |
| | | |
| esmith::cgi::genHeaderNonCacheable | | esmith::cgi::genHeaderNonCacheable |
Line 837: |
Line 840: |
| | | |
| esmith::cgi::genHeaderNonCacheable | | esmith::cgi::genHeaderNonCacheable |
− | ($q, \%conf, "Dialup funtion performed - down");
| + | ($q, \%conf, "Dialup funtion performed - down"); |
| | | |
| esmith::cgi::genResult ($q, "The modem is going down"); | | esmith::cgi::genResult ($q, "The modem is going down"); |
Line 843: |
Line 846: |
| ===References=== | | ===References=== |
| ====Bugs==== | | ====Bugs==== |
− | Syntax errors are common, a misplaced , or missed ) will result in a panel that will not run or compile. | + | 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. |
− | 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 |
− | Check that httpd-admin is running as well as httpd, via a ps -A |grep httpd. | + | ps -A |grep httpd. |
| | | |
| Check you have correct permissions, and locate/link it the e-smith way | | Check you have correct permissions, and locate/link it the e-smith way |
− | cd /etc/e-smith/web/functions/ | + | cd /etc/e-smith/web/functions/ |
− | chmod 750 thing, then chmod u+s thing (?sn) | + | chmod 750 thing, then chmod u+s thing (?sn) |
− | cd /etc/e-smith/web/panel/manager/cgi-bin | + | cd /etc/e-smith/web/panel/manager/cgi-bin |
− | ln -s ../../../thing thing | + | ln -s ../../../thing thing |
− | Links | + | |
− | www.e-smth.org duh | + | ====Links==== |
− | www.perl.org | + | www.e-smth.org duh |
− | Thanks | + | www.perl.org |
| + | |
| + | ====Thanks==== |
| A big thank you to Gordon, Charlie and the e-smith team. | | A big thank you to Gordon, Charlie and the e-smith team. |
| | | |
− | Stephen Noble April 2001 ver 0.1-2 | + | Stephen Noble April 2001 ver 0.1-2 |