Difference between revisions of "Create server-manager panels by perl cgi (deprecated)"

From SME Server
Jump to navigationJump to search
(added the original link where the howto was for references)
 
(16 intermediate revisions by 2 users not shown)
Line 1: Line 1:
 
{{Level|Developer}}
 
{{Level|Developer}}
  
{{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 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://www.sme-server.de/download/Howtos/e-smith_panel_howto.html original Author]
+
[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 145: 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 206: 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 221: 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 242: 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 265: 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 322: 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 378: 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 391: Line 393:
 
     if (defined ($q->param ('ntpdEnabled')))
 
     if (defined ($q->param ('ntpdEnabled')))
 
     {
 
     {
$newStatus = "on";
+
    $newStatus = "on";
 
     }
 
     }
 
     else
 
     else
 
     {
 
     {
$newStatus = "off";
+
    $newStatus = "off";
 
     }
 
     }
  
Line 402: 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 412: 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 471: 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 527: 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 533: Line 535:
 
     else
 
     else
 
     {
 
     {
db_set(\%conf, 'DelegateMailServer', $delegate);
+
    db_set(\%conf, 'DelegateMailServer', $delegate);
 
     }
 
     }
 
  ))
 
  ))
Line 544: 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 555: 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 561: Line 563:
 
     if ($delegate eq "")
 
     if ($delegate eq "")
 
     {
 
     {
db_delete(\%conf, 'DelegateMailServer');
+
    db_delete(\%conf, 'DelegateMailServer');
 
     }
 
     }
 
  ))
 
  ))
Line 570: 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 579: 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 585: 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 599: 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 620: 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 634: 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 655: 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 667: 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 678: 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 690: 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 696: 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 745: 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 756: Line 758:
 
     if ($password =~ /^(.*)$/)
 
     if ($password =~ /^(.*)$/)
 
     {
 
     {
$password = $1;
+
    $password = $1;
 
     }
 
     }
 
     else
 
     else
 
     {
 
     {
$password = "";
+
    $password = "";
 
     }
 
     }
  
Line 768: 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 789: 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 796: 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 810: 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 826: 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 838: 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 844: 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

Latest revision as of 20:41, 12 June 2015

PythonIcon.png Skill level: Developer
Risk of inconsistencies with Koozali SME Server methodology, upgrades & functionality is high. One must be knowledgeable about how changes impact their Koozali SME Server. Significant risk of irreversible harm.



Warning.png Warning:
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


original Author

original link

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