initial commit of file from CVS for e-smith-base on Thu 26 Oct 11:24:52 BST 2023
This commit is contained in:
12
root/usr/share/hal/fdi/95userpolicy/usb-rev35-drive.fdi
Normal file
12
root/usr/share/hal/fdi/95userpolicy/usb-rev35-drive.fdi
Normal file
@@ -0,0 +1,12 @@
|
||||
<?xml version="1.0" encoding="ISO-8859-1"?> <!-- -*- SGML -*- -->
|
||||
<deviceinfo version="0.2">
|
||||
<device>
|
||||
<match key="storage.bus" string="usb">
|
||||
<match key="storage.vendor" string="Iomega">
|
||||
<match key="storage.model" string="RRD">
|
||||
<merge key="storage.policy.desired_mount_point" type="string">usbdisk</merge>
|
||||
</match>
|
||||
</match>
|
||||
</match>
|
||||
</device>
|
||||
</deviceinfo>
|
12
root/usr/share/hal/fdi/95userpolicy/usb-rev70-drive.fdi
Normal file
12
root/usr/share/hal/fdi/95userpolicy/usb-rev70-drive.fdi
Normal file
@@ -0,0 +1,12 @@
|
||||
<?xml version="1.0" encoding="ISO-8859-1"?> <!-- -*- SGML -*- -->
|
||||
<deviceinfo version="0.2">
|
||||
<device>
|
||||
<match key="storage.bus" string="usb">
|
||||
<match key="storage.vendor" string="Iomega">
|
||||
<match key="storage.model" string="RRD2">
|
||||
<merge key="storage.policy.desired_mount_point" type="string">usbdisk</merge>
|
||||
</match>
|
||||
</match>
|
||||
</match>
|
||||
</device>
|
||||
</deviceinfo>
|
0
root/usr/share/locale/en_US/LC_MESSAGES/.gitignore
vendored
Normal file
0
root/usr/share/locale/en_US/LC_MESSAGES/.gitignore
vendored
Normal file
59
root/usr/share/perl5/vendor_perl/esmith/ConfigDB/unsaved.pm
Normal file
59
root/usr/share/perl5/vendor_perl/esmith/ConfigDB/unsaved.pm
Normal file
@@ -0,0 +1,59 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# Override set_value, delete, set_prop and delete_prop functions in
|
||||
# esmith::ConfigDB to provide UnsavedChanges automatically
|
||||
package esmith::ConfigDB::unsaved;
|
||||
use strict;
|
||||
use warnings;
|
||||
require esmith::ConfigDB;
|
||||
@esmith::ConfigDB::unsaved::ISA = qw(esmith::ConfigDB);
|
||||
|
||||
sub set_value {
|
||||
my ($self, $key, $value) = @_;
|
||||
|
||||
# The 'UnsavedChanges' entry is automatically set to 'yes'
|
||||
# when a system parameter is changed. This means that there
|
||||
# are changes to the main e-smith configuration file which
|
||||
# need to be 'saved' (i.e. all of the e-smith config files
|
||||
# must be updated). However, don't do anything automatic if
|
||||
# the caller is deliberately trying to set the UnsavedChanges
|
||||
# flag. (That's how they can reset it.)
|
||||
|
||||
my $current_value = $self->SUPER::get_value($key);
|
||||
return $current_value if (defined $current_value and $current_value eq $value);
|
||||
|
||||
if ($key ne 'UnsavedChanges') {
|
||||
$self->SUPER::set_value('UnsavedChanges', 'yes');
|
||||
}
|
||||
|
||||
return $self->SUPER::set_value($key, $value);
|
||||
}
|
||||
sub set_prop {
|
||||
my ($self, $key, $prop, $value) = @_;
|
||||
|
||||
my $rec = $self->get($key);
|
||||
return unless ($rec);
|
||||
my $current_value = $rec->prop($prop);
|
||||
return $current_value if (defined $current_value and $current_value eq $value);
|
||||
|
||||
$self->SUPER::set_value('UnsavedChanges', 'yes');
|
||||
return $rec->set_prop($prop, $value);
|
||||
}
|
||||
sub delete_prop {
|
||||
my ($self, $key, $prop) = @_;
|
||||
my $rec = $self->get($key);
|
||||
my $current_value = $rec->prop($prop);
|
||||
return unless (defined $current_value);
|
||||
|
||||
$self->SUPER::set_value('UnsavedChanges', 'yes');
|
||||
return $rec->delete_prop($prop);
|
||||
}
|
||||
# Deleting a record is the same as changing one
|
||||
sub delete {
|
||||
my ($self, $key) = @_;
|
||||
my $current = $self->get($key);
|
||||
return unless (defined $current);
|
||||
$self->SUPER::set_value('UnsavedChanges', 'yes');
|
||||
return $current->delete;
|
||||
}
|
||||
1;
|
603
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/groups.pm
Executable file
603
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/groups.pm
Executable file
@@ -0,0 +1,603 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#
|
||||
# $Id: groups.pm,v 1.38 2005/05/12 21:44:29 charlieb Exp $
|
||||
#
|
||||
|
||||
package esmith::FormMagick::Panel::groups;
|
||||
|
||||
use strict;
|
||||
|
||||
use esmith::FormMagick;
|
||||
use esmith::ConfigDB;
|
||||
use esmith::AccountsDB;
|
||||
use File::Basename;
|
||||
use Exporter;
|
||||
use Carp;
|
||||
|
||||
our @ISA = qw(esmith::FormMagick Exporter);
|
||||
|
||||
our @EXPORT = qw(
|
||||
|
||||
show_initial
|
||||
genUsers
|
||||
create_group
|
||||
modify_group
|
||||
delete_group
|
||||
validate_is_group
|
||||
validate_group_naming_conflict
|
||||
validate_group
|
||||
validate_group_length
|
||||
getNextFreeID
|
||||
validate_group_has_members
|
||||
print_group_delete_desc
|
||||
print_group_members
|
||||
print_group_name
|
||||
print_ibay_list
|
||||
get_accounts_prop
|
||||
get_description
|
||||
get_cgi_param
|
||||
);
|
||||
|
||||
our $accounts = esmith::AccountsDB->open() || die "Couldn't open accounts";
|
||||
our $db = esmith::ConfigDB->open || die "Couldn't open config db";
|
||||
|
||||
our $VERSION = sprintf '%d.%03d', q$Revision: 1.38 $ =~ /: (\d+).(\d+)/;
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
esmith::FormMagick::Panels::groups - useful panel functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::FormMagick::Panels::groups;
|
||||
|
||||
my $panel = esmith::FormMagick::Panel::groups->new();
|
||||
$panel->display();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
=head2 new();
|
||||
|
||||
Exactly as for esmith::FormMagick
|
||||
|
||||
=begin testing
|
||||
|
||||
$ENV{ESMITH_ACCOUNT_DB} = "10e-smith-base/accounts.conf";
|
||||
$ENV{ESMITH_CONFIG_DB} = "10e-smith-base/configuration.conf";
|
||||
|
||||
use_ok('esmith::FormMagick::Panel::groups');
|
||||
use vars qw($panel);
|
||||
ok($panel = esmith::FormMagick::Panel::groups->new(), "Create panel object");
|
||||
isa_ok($panel, 'esmith::FormMagick::Panel::groups');
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
shift;
|
||||
my $self = esmith::FormMagick->new();
|
||||
$self->{calling_package} = (caller)[0];
|
||||
bless $self;
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
=head1 ACCESSORS
|
||||
|
||||
=head2 get_cgi_param FM FIELD
|
||||
|
||||
Returns the named CGI parameter as a string
|
||||
|
||||
=cut
|
||||
|
||||
sub get_cgi_param {
|
||||
my $fm = shift;
|
||||
my $param = shift;
|
||||
|
||||
return ( $fm->{'cgi'}->param($param) );
|
||||
}
|
||||
|
||||
|
||||
=head2 get_accounts_prop ITEM PROP
|
||||
|
||||
A simple accessor for esmith::AccountsDB::Record::prop
|
||||
|
||||
=cut
|
||||
|
||||
sub get_accounts_prop {
|
||||
my $fm = shift;
|
||||
my $item = shift;
|
||||
my $prop = shift;
|
||||
|
||||
my $record = $accounts->get($item);
|
||||
|
||||
if ($record) {
|
||||
return $record->prop($prop);
|
||||
}
|
||||
else {
|
||||
return '';
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head2 get_description
|
||||
|
||||
Get the Description for the group named in the CGI argument "GroupName"
|
||||
|
||||
=cut
|
||||
|
||||
sub get_description {
|
||||
my $fm = shift;
|
||||
my $group = $fm->{'cgi'}->param('groupName');
|
||||
return ( $fm->get_accounts_prop( $group, 'Description' ) );
|
||||
}
|
||||
|
||||
=head1 ACTION
|
||||
|
||||
|
||||
=head2 show_initial FM
|
||||
|
||||
Show the "start" page for this panel
|
||||
|
||||
=cut
|
||||
|
||||
sub show_initial () {
|
||||
my $fm = shift;
|
||||
my $q = $fm->{cgi};
|
||||
$q->Delete('groupName');
|
||||
|
||||
my $params = $fm->build_cgi_params();
|
||||
|
||||
my $numGroups = $accounts->groups;
|
||||
|
||||
print $q->Tr($q->td(
|
||||
"<p><a class=\"button-like\" href=\"groups?$params&wherenext=CreateGroup\">"
|
||||
. $fm->localise("GROUP_ADD")
|
||||
. "</a></p>"));
|
||||
|
||||
if ( $numGroups == 0 ) {
|
||||
print $q->Tr($q->td(
|
||||
'<p><b>' . $fm->localise("ACCOUNT_GROUP_NONE") . '</p></b>'));
|
||||
|
||||
}
|
||||
else {
|
||||
print $q->Tr($q->td({-colspan => 2}, $fm->localise('CURRENT_LIST')));
|
||||
print $q->start_table({-CLASS => "sme-border"}),"\n";
|
||||
print "<tr><th class=\"sme-border\">"
|
||||
. $fm->localise("GROUP")
|
||||
. "</th> <th class=\"sme-border\">"
|
||||
. $fm->localise('DESCRIPTION')
|
||||
. "</th><th class=\"sme-border\" colspan=\"2\">"
|
||||
. $fm->localise('ACTION')
|
||||
. "</th></tr>";
|
||||
foreach my $group ( $accounts->groups() ) {
|
||||
$params = $fm->build_cgi_params( $group->key );
|
||||
print "<tr>" . "<td class=\"sme-border\">"
|
||||
. $group->key . "</td>" . "<td class=\"sme-border\">"
|
||||
. $group->prop('Description') . "</td>"
|
||||
. "<td class=\"sme-border\"><a href=\"groups?$params&wherenext=Modify\">"
|
||||
. $fm->localise("MODIFY") . "</a></td>"
|
||||
. "<td class=\"sme-border\"><a href=\"groups?$params&wherenext=Delete\">"
|
||||
. $fm->localise("REMOVE") . "</a>" . "</td></tr>";
|
||||
|
||||
}
|
||||
print $q->end_table,"\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 create_group FM
|
||||
|
||||
Create a group
|
||||
|
||||
=cut
|
||||
|
||||
sub create_group {
|
||||
my $fm = shift;
|
||||
my $q = $fm->{'cgi'};
|
||||
|
||||
my $groupName = $q->param('groupName');
|
||||
my @members = $q->param('groupMembers');
|
||||
my $members = join ( ",", @members );
|
||||
|
||||
my %props = (
|
||||
'type', 'group', 'Description',
|
||||
$q->param('groupDesc'), 'Members', $members
|
||||
);
|
||||
|
||||
$accounts->new_record( $groupName, \%props );
|
||||
|
||||
# Untaint groupName before use in system()
|
||||
($groupName) = ($groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/);
|
||||
$fm->clear_params();
|
||||
|
||||
return system("/sbin/e-smith/signal-event", "group-create", "$groupName") ?
|
||||
$fm->error('CREATE_ERROR') : $fm->success('CREATED_GROUP');
|
||||
}
|
||||
|
||||
=head2 modify_group FM
|
||||
|
||||
Modify a group's description and membership roster
|
||||
|
||||
=cut
|
||||
|
||||
sub modify_group {
|
||||
|
||||
my $fm = shift;
|
||||
my $q = $fm->{'cgi'};
|
||||
|
||||
my @members = $q->param('groupMembers');
|
||||
my $desc = $q->param('groupDesc');
|
||||
my $groupName = $q->param('groupName');
|
||||
|
||||
$accounts->get($groupName)->set_prop( 'Members', join ( ',', @members ) );
|
||||
$accounts->get($groupName)->set_prop( 'Description', $desc );
|
||||
|
||||
# Untaint groupName before use in system()
|
||||
($groupName) = ($groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/);
|
||||
$fm->clear_params();
|
||||
return system("/sbin/e-smith/signal-event", "group-modify", "$groupName") ?
|
||||
$fm->error('MODIFY_ERROR') : $fm->success('MODIFIED_GROUP');
|
||||
}
|
||||
|
||||
=head2 delete_group FM
|
||||
|
||||
Delete a group and move all of its ibays to the 'admin' group.
|
||||
|
||||
=cut
|
||||
|
||||
sub delete_group {
|
||||
|
||||
my $fm = shift;
|
||||
my $q = $fm->{'cgi'};
|
||||
|
||||
my $groupName = $q->param('groupName');
|
||||
|
||||
$accounts->get($groupName)->set_prop( 'type', 'group-deleted' );
|
||||
|
||||
|
||||
# Untaint groupName before use in system()
|
||||
($groupName) = ($groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/);
|
||||
$fm->clear_params();
|
||||
return (system("/sbin/e-smith/signal-event", "group-delete",
|
||||
"$groupName") ||
|
||||
!$accounts->get($groupName)->delete()) ?
|
||||
$fm->error('DELETE_ERROR') : $fm->success('DELETED_GROUP');
|
||||
}
|
||||
|
||||
|
||||
=head1 VALIDATION
|
||||
|
||||
=head2 validate_is_group FM GROUP
|
||||
|
||||
returns OK if GROUP is a current group. otherwisee returns "NOT_A_GROUP"
|
||||
|
||||
=begin testing
|
||||
|
||||
#ok($panel->validate_is_group('root') eq 'OK', "Root is a group");
|
||||
ok($panel->validate_is_group('ro2ot') eq 'NOT_A_GROUP', "Ro2ot is not a group");
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub validate_is_group () {
|
||||
my $fm = shift;
|
||||
my $group = shift;
|
||||
|
||||
my @groups = $accounts->groups();
|
||||
my %groups = map { $_->key => 1 } @groups;
|
||||
|
||||
unless ( exists $groups{$group} ) {
|
||||
return ("NOT_A_GROUP");
|
||||
}
|
||||
return ("OK");
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head2 validate_group_naming_conflict FM GROUPNAME
|
||||
|
||||
Returns "OK" if this group's name doesn't conflict with anything
|
||||
Returns "PSEUDONYM_CONFLICT" if this name conflicts with a pseudonym
|
||||
Returns "NAME_CONFLICT" if this group name conflicts with anything else
|
||||
|
||||
ok (undef, 'need testing for validate_naming_Conflicts');
|
||||
=cut
|
||||
|
||||
sub validate_group_naming_conflict
|
||||
{
|
||||
my $fm = shift;
|
||||
my $groupName = shift;
|
||||
|
||||
my $account = $accounts->get($groupName);
|
||||
my $type;
|
||||
|
||||
if (defined $account)
|
||||
{
|
||||
$type = $account->prop('type');
|
||||
}
|
||||
elsif (defined getpwnam($groupName) || defined getgrnam($groupName))
|
||||
{
|
||||
$type = "system";
|
||||
}
|
||||
else
|
||||
{
|
||||
return('OK');
|
||||
}
|
||||
return $fm->localise('ACCOUNT_CONFLICT',
|
||||
{ group => $groupName,
|
||||
type => $type,
|
||||
});
|
||||
}
|
||||
|
||||
=head2 validate_group FM groupname
|
||||
|
||||
Returns OK if the group name contains only valid characters
|
||||
Returns GROUP_NAMING otherwise
|
||||
|
||||
=being testing
|
||||
|
||||
ok(validate_group('','foo') eq 'OK', 'foo is a valid group);
|
||||
ok(validate_group('','f&oo') eq 'GROUP_CONTAINS_INVALD', 'f&oo is not a valid group);
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub validate_group {
|
||||
my $fm = shift;
|
||||
my $groupName = shift;
|
||||
unless ( $groupName =~ /^([a-z][\-\_\.a-z0-9]*)$/ ) {
|
||||
return ('GROUP_NAMING');
|
||||
}
|
||||
return ('OK');
|
||||
}
|
||||
|
||||
|
||||
=head2 validate_group_length FM GROUPNAME
|
||||
|
||||
returns 'OK' if the group name is shorter than the maximum group name length
|
||||
returns 'GROUP_TOO_LONG' otherwise
|
||||
|
||||
=begin testing
|
||||
|
||||
ok(($panel->validate_group_length('foo') eq 'OK'), "a short groupname passes");
|
||||
ok(($panel->validate_group_length('fooooooooooooooooo') eq 'GROUP_TOO_LONG'), "a long groupname fails");
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub validate_group_length {
|
||||
my $fm = shift;
|
||||
my $groupName = shift;
|
||||
|
||||
my $maxGroupNameLength = ($db->get('maxGroupNameLength')
|
||||
? $db->get('maxGroupNameLength')->prop('type')
|
||||
: "") || 12;
|
||||
|
||||
if ( length $groupName > $maxGroupNameLength ) {
|
||||
|
||||
return $fm->localise('GROUP_TOO_LONG',
|
||||
{maxLength => $maxGroupNameLength});
|
||||
}
|
||||
else {
|
||||
return ('OK');
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
=head2 validate_group_has_members FM MEMBERS
|
||||
|
||||
Validates that the cgi parameter MEMBERS is an array with at least one entry
|
||||
Returns OK if true. Otherwise, returns NO_MEMBERS
|
||||
|
||||
|
||||
=begin testing
|
||||
|
||||
ok(validate_group_has_members('',qw(foo bar)) eq 'OK', "We do ok with a group with two members");
|
||||
|
||||
ok(validate_group_has_members('',qw()) eq 'NO_MEMBERS', "We do ok with a group with no members");
|
||||
ok(validate_group_has_members('') eq 'NO_MEMBERS', "We do ok with a group with undef members");
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub validate_group_has_members {
|
||||
my $fm = shift;
|
||||
my @members = (@_);
|
||||
my $count = @members;
|
||||
if ( $count == 0 ) {
|
||||
return ('NO_MEMBERS');
|
||||
}
|
||||
else {
|
||||
return ('OK');
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
=head1 UTILITY FUNCTIONS
|
||||
|
||||
|
||||
=head2 print_group_members FM ACCT
|
||||
|
||||
Takes an FM object and the name of a group.
|
||||
Prints out an unordered list of the group's members.
|
||||
|
||||
=cut
|
||||
|
||||
sub print_group_members {
|
||||
my $fm = shift;
|
||||
my $q = $fm->cgi;
|
||||
my $acct = $q->param('groupName');
|
||||
|
||||
print $q->Tr(
|
||||
$q->td({-class => "sme-noborders"},
|
||||
$fm->localise('GROUP_HAS_MEMBERS'))),"\n";
|
||||
|
||||
my @members = split ( /,/, $accounts->get($acct)->prop('Members') );
|
||||
my %names;
|
||||
foreach my $m (@members) {
|
||||
my $name;
|
||||
if ( $m eq 'admin' ) {
|
||||
$name = "Administrator";
|
||||
}
|
||||
else {
|
||||
$name =
|
||||
$accounts->get($m)->prop('FirstName') . " "
|
||||
. $accounts->get($m)->prop('LastName');
|
||||
}
|
||||
$names{$m} = $name;
|
||||
}
|
||||
|
||||
print $q->Tr(
|
||||
$q->td({-class => "sme-noborders"},
|
||||
$q->p($q->ul(
|
||||
$q->li({-type => 'disc'},
|
||||
[map { "$_ (${names{$_}})" } @members]))))),"\n";
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub print_group_delete_desc
|
||||
{
|
||||
my $fm = shift;
|
||||
my $q = $fm->cgi;
|
||||
my $acct = $q->param('groupName');
|
||||
print $q->Tr(
|
||||
$q->td({-class => "sme-noborders"},
|
||||
$q->p($fm->localise('DELETE_DESCRIPTION', {group => $acct})),
|
||||
$q->br)),"\n";
|
||||
return '';
|
||||
}
|
||||
|
||||
sub print_ibay_list {
|
||||
my $fm = shift;
|
||||
my $q = $fm->cgi;
|
||||
my $acct = $q->param('groupName');
|
||||
|
||||
my %names;
|
||||
foreach my $ibay ( $accounts->ibays ) {
|
||||
if ( $ibay->prop('Group') eq $acct ) {
|
||||
$names{$ibay->key} = $ibay->prop('Name');
|
||||
}
|
||||
}
|
||||
|
||||
if (%names) {
|
||||
print $q->Tr(
|
||||
$q->td({-class => "sme-noborders"},
|
||||
$q->p($fm->localise('IBAYS_WILL_BE_CHANGED')),
|
||||
$q->ul(
|
||||
$q->li({-type => 'disc'},
|
||||
[map { "$_ (${names{$_}})" } sort keys %names])))),"\n";
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
||||
=head2 build_cgi_params()
|
||||
|
||||
Builds a CGI query string, using various sensible
|
||||
defaults and esmith::FormMagick's props_to_query_string() method.
|
||||
|
||||
=cut
|
||||
|
||||
sub build_cgi_params {
|
||||
my ( $fm, $group ) = @_;
|
||||
|
||||
my %props = (
|
||||
page => 0,
|
||||
page_stack => "",
|
||||
".id" => $fm->{cgi}->param('.id') || "",
|
||||
groupName => $group,
|
||||
);
|
||||
|
||||
return $fm->props_to_query_string( \%props );
|
||||
}
|
||||
|
||||
=head2 genUsers MEMBERS
|
||||
|
||||
Takes a comma delimited list of users and returns a string of
|
||||
html checkboxes for all system users with the members of the group
|
||||
in $fm->{cgi}->parm('groupName')checked.
|
||||
|
||||
=cut
|
||||
|
||||
sub genUsers () {
|
||||
my $fm = shift;
|
||||
my $members = "";
|
||||
my $group = $fm->{'cgi'}->param('groupName');
|
||||
|
||||
if ($accounts->get($group)) {
|
||||
$members = $accounts->get($group)->prop('Members');
|
||||
}
|
||||
my %members;
|
||||
foreach my $member ( split ( /,/, $members ) ) {
|
||||
$members{$member} = 1;
|
||||
}
|
||||
my @users = sort { $a->key() cmp $b->key() } $accounts->users();
|
||||
|
||||
# include Administrator at beginning of list
|
||||
|
||||
my $out = "<tr>\n <td class=\"sme-noborders-label\">"
|
||||
. $fm->localise('GROUP_MEMBERS')
|
||||
. "</td>\n <td>\n"
|
||||
. " <table border='0' cellspacing='0' cellpadding='0'>\n"
|
||||
. " <tr>\n"
|
||||
. " <td><input type=\"checkbox\" name=\"groupMembers\"";
|
||||
if ( $members{'admin'} ) {
|
||||
$out .= "checked";
|
||||
}
|
||||
$out .= " value=\"admin\"></td>\n <td>Administrator (admin)</td>\n </tr>\n";
|
||||
foreach my $user (@users) {
|
||||
my $checked = "";
|
||||
if ( $members{ $user->key() } ) {
|
||||
$checked = "checked";
|
||||
}
|
||||
my $name;
|
||||
if ( $user eq 'admin' ) { $name = 'Administrator'; }
|
||||
else {
|
||||
$name = $user->prop('FirstName') . " " . $user->prop('LastName');
|
||||
}
|
||||
|
||||
$out .=" <tr>\n"
|
||||
. " <td><input type=\"checkbox\" name=\"groupMembers\" $checked value=\""
|
||||
. $user->key
|
||||
. "\"></td>\n <td>$name (".$user->key.")</td>\n </tr>\n";
|
||||
|
||||
}
|
||||
|
||||
$out .= " </table>\n </td>\n </tr>\n";
|
||||
return $out;
|
||||
}
|
||||
|
||||
=head2 clear_params
|
||||
|
||||
This method clears-out the parameters used in form submission so that they are
|
||||
not inadvertenly picked-up where they should not be.
|
||||
|
||||
=cut
|
||||
|
||||
sub clear_params
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
|
||||
$q->delete('groupMembers');
|
||||
$q->delete('groupDesc');
|
||||
$q->delete('groupName');
|
||||
}
|
524
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/localnetworks.pm
Executable file
524
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/localnetworks.pm
Executable file
@@ -0,0 +1,524 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#
|
||||
# $Id: localnetworks.pm,v 1.32 2004/08/27 17:27:30 msoulier Exp $
|
||||
#
|
||||
|
||||
package esmith::FormMagick::Panel::localnetworks;
|
||||
|
||||
use strict;
|
||||
|
||||
use esmith::FormMagick;
|
||||
use esmith::NetworksDB;
|
||||
use esmith::ConfigDB;
|
||||
use esmith::HostsDB;
|
||||
use esmith::cgi;
|
||||
use esmith::util;
|
||||
use File::Basename;
|
||||
use Exporter;
|
||||
use Carp;
|
||||
use Net::IPv4Addr;
|
||||
use Net::Netmask;
|
||||
|
||||
our @ISA = qw(esmith::FormMagick Exporter);
|
||||
|
||||
our @EXPORT = qw(
|
||||
print_network_table
|
||||
ip_number_or_blank
|
||||
subnet_mask
|
||||
add_network
|
||||
remove_network
|
||||
show_remove_network_summary
|
||||
);
|
||||
|
||||
our $VERSION = sprintf '%d.%03d', q$Revision: 1.32 $ =~ /: (\d+).(\d+)/;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
esmith::FormMagick::Panels::localnetworks - useful panel functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::FormMagick::Panels::localnetworks;
|
||||
|
||||
my $panel = esmith::FormMagick::Panel::localnetworks->new();
|
||||
$panel->display();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
||||
=head2 new();
|
||||
|
||||
Exactly as for esmith::FormMagick
|
||||
|
||||
=begin testing
|
||||
|
||||
$ENV{ESMITH_ACCOUNT_DB} = "10e-smith-base/accounts.conf";
|
||||
$ENV{ESMITH_CONFIG_DB} = "10e-smith-base/configuration.conf";
|
||||
$ENV{ESMITH_NETWORKS_DB} = "10e-smith-base/networks.conf";
|
||||
|
||||
use_ok('esmith::FormMagick::Panel::localnetworks');
|
||||
use vars qw($panel);
|
||||
ok($panel = esmith::FormMagick::Panel::localnetworks->new(),
|
||||
"Create panel object");
|
||||
isa_ok($panel, 'esmith::FormMagick::Panel::localnetworks');
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub new
|
||||
{
|
||||
shift;
|
||||
my $self = esmith::FormMagick->new();
|
||||
$self->{calling_package} = (caller)[0];
|
||||
bless $self;
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head1 HTML GENERATION ROUTINES
|
||||
|
||||
Routines for generating chunks of HTML needed by the panel.
|
||||
|
||||
=head2 print_user_table
|
||||
|
||||
Prints out the user table on the front page.
|
||||
|
||||
=for testing
|
||||
my $fm = esmith::FormMagick::Panel::localnetworks->new();
|
||||
$fm->{cgi} = CGI->new();
|
||||
can_ok('main', 'print_network_table');
|
||||
print_network_table($fm);
|
||||
like($_STDOUT_, qr/NUMBER_OF_HOSTS/, "saw hosts table");
|
||||
|
||||
=cut
|
||||
|
||||
sub print_network_table
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
|
||||
my $network_db = esmith::NetworksDB->open();
|
||||
my @networks = $network_db->get_all_by_prop( type => 'network' );
|
||||
unless (@networks)
|
||||
{
|
||||
print $q->h3 ( $self->localise('NO_ADDITIONAL_NETWORKS') );
|
||||
return "";
|
||||
}
|
||||
|
||||
print $q->start_Tr, "\n";
|
||||
print $q->start_td, "\n";
|
||||
print $q->start_table( { class => "sme-border" } ), "\n";
|
||||
|
||||
my $remove = $self->localise('REMOVE');
|
||||
|
||||
print $q->Tr (
|
||||
esmith::cgi::genSmallCell(
|
||||
$q, ( $self->localise('NETWORK') ), "header"
|
||||
),
|
||||
esmith::cgi::genSmallCell(
|
||||
$q, ( $self->localise('SUBNET_MASK') ), "header"
|
||||
),
|
||||
esmith::cgi::genSmallCell(
|
||||
$q, ( $self->localise('NUMBER_OF_HOSTS') ), "header"
|
||||
),
|
||||
esmith::cgi::genSmallCell(
|
||||
$q, ( $self->localise('ROUTER') ), "header"
|
||||
),
|
||||
esmith::cgi::genSmallCell(
|
||||
$q, ( $self->localise('ACTION') ), "header"
|
||||
)
|
||||
),
|
||||
"\n";
|
||||
|
||||
my $scriptname = basename($0);
|
||||
|
||||
foreach my $n ( sort by_key @networks )
|
||||
{
|
||||
my $network = $n->key();
|
||||
my $subnet = $n->prop('Mask');
|
||||
my $router = $n->prop('Router');
|
||||
my $removable = $n->prop('Removable') || "yes";
|
||||
my $system = $n->prop('SystemLocalNetwork') || "no";
|
||||
if ( $system eq "yes" )
|
||||
{
|
||||
$removable = "no";
|
||||
}
|
||||
my $params = $self->build_network_cgi_params($network);
|
||||
my $link =
|
||||
( $removable eq "no" )
|
||||
? ' '
|
||||
: $q->a( { -href => "$scriptname?$params&wherenext=Remove" },
|
||||
$remove );
|
||||
my ($num_hosts) = esmith::util::computeHostRange( $network, $subnet );
|
||||
print $q->Tr (
|
||||
esmith::cgi::genSmallCell( $q, $network, "normal" ),
|
||||
esmith::cgi::genSmallCell( $q, $subnet, "normal" ),
|
||||
esmith::cgi::genSmallCell( $q, $num_hosts, "normal" ),
|
||||
esmith::cgi::genSmallCell( $q, $n->prop('Router'), "normal" ),
|
||||
esmith::cgi::genSmallCell( $q, $link, "normal" )
|
||||
);
|
||||
}
|
||||
|
||||
print $q->end_table, "\n";
|
||||
print $q->end_td, "\n";
|
||||
print $q->end_Tr, "\n";
|
||||
|
||||
return "";
|
||||
}
|
||||
|
||||
sub by_key
|
||||
{
|
||||
$a->key() cmp $b->key();
|
||||
}
|
||||
|
||||
sub build_network_cgi_params
|
||||
{
|
||||
my ( $fm, $network, $oldprops ) = @_;
|
||||
|
||||
my %props = (
|
||||
page => 0,
|
||||
page_stack => "",
|
||||
".id" => $fm->{cgi}->param('.id') || "",
|
||||
network => $network,
|
||||
);
|
||||
|
||||
return $fm->props_to_query_string( \%props );
|
||||
}
|
||||
|
||||
sub show_remove_network_summary
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
my $network = $q->param('network');
|
||||
|
||||
my $network_db = esmith::NetworksDB->open();
|
||||
my $record = $network_db->get($network);
|
||||
my $subnet = $record->prop('Mask');
|
||||
my $router = $record->prop('Router');
|
||||
|
||||
print $q->Tr(
|
||||
$q->td(
|
||||
{ -class => 'sme-noborders-label' },
|
||||
$self->localise('NETWORK')
|
||||
),
|
||||
$q->td( { -class => 'sme-noborders-content' }, $network )
|
||||
),
|
||||
"\n";
|
||||
print $q->Tr(
|
||||
$q->td(
|
||||
{ -class => 'sme-noborders-label' },
|
||||
$self->localise('SUBNET_MASK')
|
||||
),
|
||||
$q->td( { -class => 'sme-noborders-content' }, $subnet )
|
||||
),
|
||||
"\n";
|
||||
print $q->Tr(
|
||||
$q->td(
|
||||
{ -class => 'sme-noborders-label' }, $self->localise('ROUTER')
|
||||
),
|
||||
$q->td( { -class => 'sme-noborders-content' }, $router )
|
||||
),
|
||||
"\n";
|
||||
if ($self->hosts_on_network($network, $subnet))
|
||||
{
|
||||
print $q->Tr(
|
||||
$q->td({-colspan => 2},
|
||||
$self->localise('REMOVE_HOSTS_DESC')));
|
||||
print $q->Tr(
|
||||
$q->td({-class => 'sme-noborders-label'},
|
||||
$self->localise('REMOVE_HOSTS_LABEL')),
|
||||
$q->td({-class => 'sme-noborders-content'},
|
||||
$q->checkbox(-name => 'delete_hosts',
|
||||
-checked=>1,
|
||||
-value=>'ON',
|
||||
-label => '')));
|
||||
}
|
||||
print $q->table(
|
||||
{ -width => '100%' },
|
||||
$q->Tr(
|
||||
$q->th(
|
||||
{ -class => 'sme-layout' },
|
||||
$q->submit(
|
||||
-name => 'cancel',
|
||||
-value => $self->localise('CANCEL')
|
||||
),
|
||||
' ',
|
||||
$q->submit(
|
||||
-name => 'remove',
|
||||
-value => $self->localise('REMOVE')
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
"\n";
|
||||
|
||||
# Clear these values to prevent collisions when the page reloads.
|
||||
$q->delete("cancel");
|
||||
$q->delete("remove");
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
=head1 VALIDATION ROUTINES
|
||||
|
||||
=head2 ip_number_or_blank
|
||||
|
||||
The router field may either contain an ip address or may be blank.
|
||||
|
||||
=for testing
|
||||
is (ip_number_or_blank($panel, ''), "OK", "blank IP address is OK");
|
||||
is (ip_number_or_blank($panel, '1.2.3.4'), "OK", "IP dress is OK");
|
||||
isnt(ip_number_or_blank($panel, '1.2.3.4000'), "OK", "invalid IP address");
|
||||
|
||||
=cut
|
||||
|
||||
#sub ip_number_or_blank {
|
||||
# my ($fm, $data) = @_;
|
||||
# if (CGI::FormMagick::Validator::ip_number($fm, $data) eq "OK"
|
||||
# or $data eq "") {
|
||||
# return "OK";
|
||||
# } else {
|
||||
# return "INVALID_IP_ADDRESS";
|
||||
# }
|
||||
#}
|
||||
|
||||
sub subnet_mask
|
||||
{
|
||||
my ( $fm, $data ) = @_;
|
||||
# we test for a valid mask or bit mask
|
||||
my $tip="192.168.50.1";
|
||||
my $block = new Net::Netmask("$tip/$data") or return "INVALID_SUBNET_MASK";
|
||||
if ($block->mask() eq "$data" || $block->bits() eq "$data")
|
||||
{
|
||||
return "OK";
|
||||
}
|
||||
return "INVALID_SUBNET_MASK";
|
||||
}
|
||||
|
||||
=head1 ADDING AND REMOVING NETWORKS
|
||||
|
||||
=head2 add_network()
|
||||
|
||||
=cut
|
||||
|
||||
sub add_network
|
||||
{
|
||||
my ($fm) = @_;
|
||||
my $networkAddress = $fm->{cgi}->param('networkAddress');
|
||||
my $networkMask = $fm->{cgi}->param('networkMask');
|
||||
# we transform bit mask to regular mask
|
||||
my $block = new Net::Netmask("$networkAddress/$networkMask");
|
||||
$networkMask = $block->mask();
|
||||
|
||||
my $networkRouter = $fm->{cgi}->param('networkRouter');
|
||||
|
||||
my $network_db = esmith::NetworksDB->open()
|
||||
|| esmith::NetworksDB->create();
|
||||
my $config_db = esmith::ConfigDB->open();
|
||||
|
||||
my $localIP = $config_db->get('LocalIP');
|
||||
my $localNetmask = $config_db->get('LocalNetmask');
|
||||
|
||||
my ( $localNetwork, $localBroadcast ) =
|
||||
esmith::util::computeNetworkAndBroadcast( $localIP->value(),
|
||||
$localNetmask->value() );
|
||||
|
||||
my ( $routerNetwork, $routerBroadcast ) =
|
||||
esmith::util::computeNetworkAndBroadcast( $networkRouter,
|
||||
$localNetmask->value() );
|
||||
|
||||
# Note to self or future developers:
|
||||
# the following tests should probably be validation routines
|
||||
# in the form itself, but it just seemed too fiddly to do that
|
||||
# at the moment. -- Skud 2002-04-11
|
||||
|
||||
if ( $routerNetwork ne $localNetwork )
|
||||
{
|
||||
$fm->error('NOT_ACCESSIBLE_FROM_LOCAL_NETWORK');
|
||||
return;
|
||||
}
|
||||
|
||||
my ( $network, $broadcast ) =
|
||||
esmith::util::computeNetworkAndBroadcast( $networkAddress, $networkMask );
|
||||
|
||||
if ( $network eq $localNetwork )
|
||||
{
|
||||
$fm->error('NETWORK_ALREADY_LOCAL');
|
||||
return;
|
||||
}
|
||||
|
||||
if ( $network_db->get($network) )
|
||||
{
|
||||
$fm->error('NETWORK_ALREADY_ADDED');
|
||||
return;
|
||||
}
|
||||
|
||||
$network_db->new_record(
|
||||
$network,
|
||||
{
|
||||
Mask => $networkMask,
|
||||
Router => $networkRouter,
|
||||
type => 'network',
|
||||
}
|
||||
);
|
||||
|
||||
# Untaint $network before use in system()
|
||||
$network =~ /(.+)/;
|
||||
$network = $1;
|
||||
system( "/sbin/e-smith/signal-event", "network-create", $network ) == 0
|
||||
or ( $fm->error('ERROR_CREATING_NETWORK') and return undef );
|
||||
|
||||
my ( $totalHosts, $firstAddr, $lastAddr ) =
|
||||
esmith::util::computeHostRange( $network, $networkMask );
|
||||
|
||||
my $msg;
|
||||
if ( $totalHosts == 1 )
|
||||
{
|
||||
$msg = $fm->localise(
|
||||
'SUCCESS_SINGLE_ADDRESS',
|
||||
{
|
||||
network => $network,
|
||||
networkMask => $networkMask,
|
||||
networkRouter => $networkRouter
|
||||
}
|
||||
);
|
||||
$fm->success($msg);
|
||||
}
|
||||
elsif (( $totalHosts == 256 )
|
||||
|| ( $totalHosts == 65536 )
|
||||
|| ( $totalHosts == 16777216 ) )
|
||||
{
|
||||
$msg = $fm->localise(
|
||||
'SUCCESS_NETWORK_RANGE',
|
||||
{
|
||||
network => $network,
|
||||
networkMask => $networkMask,
|
||||
networkRouter => $networkRouter,
|
||||
totalHosts => $totalHosts,
|
||||
firstAddr => $firstAddr,
|
||||
lastAddr => $lastAddr
|
||||
}
|
||||
);
|
||||
$fm->success($msg);
|
||||
}
|
||||
else
|
||||
{
|
||||
my $simpleMask =
|
||||
esmith::util::computeLocalNetworkPrefix( $network, $networkMask );
|
||||
$msg = $fm->localise(
|
||||
'SUCCESS_NONSTANDARD_RANGE',
|
||||
{
|
||||
network => $network,
|
||||
networkMask => $networkMask,
|
||||
networkRouter => $networkRouter,
|
||||
totalHosts => $totalHosts,
|
||||
firstAddr => $firstAddr,
|
||||
lastAddr => $lastAddr,
|
||||
simpleMask => $simpleMask
|
||||
}
|
||||
);
|
||||
$fm->success($msg);
|
||||
}
|
||||
}
|
||||
|
||||
=head2 remove_network()
|
||||
|
||||
=cut
|
||||
|
||||
sub remove_network
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
my $network = $self->cgi->param('network');
|
||||
my $delete_hosts = $self->cgi->param('delete_hosts') || "";
|
||||
my $network_db = esmith::NetworksDB->open();
|
||||
|
||||
unless ( $self->{cgi}->param("cancel") )
|
||||
{
|
||||
if ( my $record = $network_db->get($network) )
|
||||
{
|
||||
$record->set_prop( type => 'network-deleted' );
|
||||
# Untaint $network before use in system()
|
||||
$network =~ /(.+)/;
|
||||
$network = $1;
|
||||
if (
|
||||
system(
|
||||
"/sbin/e-smith/signal-event", "network-delete",
|
||||
$network
|
||||
) == 0
|
||||
)
|
||||
{
|
||||
my $networkMask = $record->prop('Mask') || "";
|
||||
my $networkRouter = $record->prop('Router') || "";
|
||||
if ($delete_hosts)
|
||||
{
|
||||
my @hosts_to_delete = $self->hosts_on_network(
|
||||
$network, $networkMask);
|
||||
foreach my $host (@hosts_to_delete)
|
||||
{
|
||||
$host->delete;
|
||||
}
|
||||
}
|
||||
$record->delete;
|
||||
my $msg = $self->localise(
|
||||
'SUCCESS_REMOVED_NETWORK',
|
||||
{
|
||||
network => $network,
|
||||
networkMask => $networkMask,
|
||||
networkRouter => $networkRouter
|
||||
}
|
||||
);
|
||||
$self->success($msg);
|
||||
}
|
||||
else
|
||||
{
|
||||
$self->error("ERROR_DELETING_NETWORK");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
$self->error("NO_SUCH_NETWORK");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
=head2 hosts_on_network
|
||||
|
||||
This method takes a network address, and a netmask, and audits the hosts
|
||||
database looking for hosts on that network. In a scalar context it returns the
|
||||
number of hosts found on that network. In a list context it returns the host
|
||||
records.
|
||||
|
||||
=cut
|
||||
|
||||
sub hosts_on_network
|
||||
{
|
||||
my $self = shift;
|
||||
my $network = shift;
|
||||
my $netmask = shift;
|
||||
|
||||
die if not $network and $netmask;
|
||||
|
||||
my $cidr = "$network/$netmask";
|
||||
my $hosts = esmith::HostsDB->open;
|
||||
my @localhosts = grep { $_->prop('HostType') eq 'Local' } $hosts->hosts;
|
||||
my @hosts_on_network = ();
|
||||
foreach my $host (@localhosts)
|
||||
{
|
||||
my $ip = $host->prop('InternalIP') || "";
|
||||
if ($ip)
|
||||
{
|
||||
if (Net::IPv4Addr::ipv4_in_network($cidr, $ip))
|
||||
{
|
||||
push @hosts_on_network, $host;
|
||||
}
|
||||
}
|
||||
}
|
||||
return @hosts_on_network if wantarray;
|
||||
return scalar @hosts_on_network;
|
||||
}
|
||||
|
||||
1;
|
136
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/reboot.pm
Executable file
136
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/reboot.pm
Executable file
@@ -0,0 +1,136 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
# $Id: reboot.pm,v 1.3 2002/05/22 21:58:07 apc Exp $
|
||||
#----------------------------------------------------------------------
|
||||
# copyright (C) 2002-2005 Mitel Networks Corporation
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
#----------------------------------------------------------------------
|
||||
package esmith::FormMagick::Panel::reboot;
|
||||
|
||||
use strict;
|
||||
|
||||
use esmith::FormMagick;
|
||||
use esmith::util;
|
||||
use File::Basename;
|
||||
use Exporter;
|
||||
use Carp;
|
||||
|
||||
our @ISA = qw(esmith::FormMagick Exporter);
|
||||
|
||||
our @EXPORT = qw( change_settings
|
||||
);
|
||||
|
||||
our $VERSION = sprintf '%d.%03d', q$Revision: 1.3 $ =~ /: (\d+).(\d+)/;
|
||||
|
||||
# {{{ header
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
esmith::FormMagick::Panels::reboot - useful panel functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::FormMagick::Panels::reboot;
|
||||
|
||||
my $panel = esmith::FormMagick::Panel::reboot->new();
|
||||
$panel->display();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=cut
|
||||
|
||||
# {{{ new
|
||||
|
||||
=head2 new();
|
||||
|
||||
Exactly as for esmith::FormMagick
|
||||
|
||||
=begin testing
|
||||
|
||||
|
||||
use_ok('esmith::FormMagick::Panel::reboot');
|
||||
use vars qw($panel);
|
||||
ok($panel = esmith::FormMagick::Panel::reboot->new(), "Create panel object");
|
||||
isa_ok($panel, 'esmith::FormMagick::Panel::reboot');
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
sub new {
|
||||
shift;
|
||||
my $self = esmith::FormMagick->new();
|
||||
$self->{calling_package} = (caller)[0];
|
||||
bless $self;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# }}}
|
||||
|
||||
|
||||
=head1 ACTION
|
||||
|
||||
=head2 change_settings
|
||||
|
||||
Reboot or halt the machine
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
sub change_settings {
|
||||
my ($fm) = @_;
|
||||
|
||||
my $q = $fm->{'cgi'};
|
||||
|
||||
my $function = $q->param ('function');
|
||||
|
||||
my $debug = $q->param('debug');
|
||||
|
||||
if ($function eq "reboot") {
|
||||
$fm->{cgi}->param( -name => 'initial_message', -value => 'REBOOT_SUCCEEDED');
|
||||
$fm->{cgi}->param( -name => 'wherenext', -value => 'Reboot' );
|
||||
unless ($debug) {
|
||||
system( "/sbin/e-smith/signal-event", "reboot" ) == 0
|
||||
or die ("Error occurred while rebooting.\n");
|
||||
}
|
||||
} elsif ($function eq 'shutdown') {
|
||||
$fm->{cgi}->param( -name => 'initial_message', -value => 'HALT_SUCCEEDED');
|
||||
$fm->{cgi}->param( -name => 'wherenext', -value => 'Shutdown' );
|
||||
unless ($debug) {
|
||||
system( "/sbin/e-smith/signal-event", "halt" ) == 0
|
||||
or die ("Error occurred while halting.\n");
|
||||
}
|
||||
} elsif ($function eq 'reconfigure') {
|
||||
$fm->{cgi}->param( -name => 'initial_message', -value => 'RECONFIGURE_SUCCEEDED');
|
||||
$fm->{cgi}->param( -name => 'wherenext', -value => 'Reconfigure' );
|
||||
unless ($debug) {
|
||||
system( "/sbin/e-smith/signal-event", "post-upgrade" ) == 0
|
||||
or die ("Error occurred while running post-upgrade.\n");
|
||||
system( "/sbin/e-smith/signal-event", "reboot" ) == 0
|
||||
or die ("Error occurred while rebooting.\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
844
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/remoteaccess.pm
Executable file
844
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/remoteaccess.pm
Executable file
@@ -0,0 +1,844 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
# $Id: remoteaccess.pm,v 1.42 2005/03/19 01:00:54 charlieb Exp $
|
||||
#----------------------------------------------------------------------
|
||||
#----------------------------------------------------------------------
|
||||
# copyright (C) 1999-2003 Mitel Networks Corporation
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package esmith::FormMagick::Panel::remoteaccess;
|
||||
|
||||
use strict;
|
||||
use esmith::ConfigDB;
|
||||
use esmith::FormMagick;
|
||||
use esmith::util;
|
||||
use esmith::cgi;
|
||||
use File::Basename;
|
||||
use Exporter;
|
||||
use Carp;
|
||||
use Socket qw( inet_aton );
|
||||
use Net::Netmask;
|
||||
|
||||
our @ISA = qw(esmith::FormMagick Exporter);
|
||||
|
||||
our @EXPORT = qw(get_ssh_permit_root_login get_ssh_access get_telnet_mode
|
||||
change_settings get_ftp_access get_ftp_password_login_access
|
||||
get_value get_prop get_ssh_password_auth zero_or_positive
|
||||
show_valid_from_list add_new_valid_from remove_valid_from
|
||||
validate_network_and_mask ip_number_or_blank subnet_mask_or_blank
|
||||
show_telnet_section get_serial_console show_ftp_section
|
||||
get_ipsecrw_sessions show_ipsecrw_section
|
||||
get_vpn_sessions
|
||||
);
|
||||
|
||||
|
||||
|
||||
our $VERSION = sprintf '%d.%03d', q$Revision: 1.42 $ =~ /: (\d+).(\d+)/;
|
||||
our $db = esmith::ConfigDB->open
|
||||
|| warn "Couldn't open configuration database (permissions problems?)";
|
||||
|
||||
|
||||
# {{{ header
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
esmith::FormMagick::Panels::remoteaccess - useful panel functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::FormMagick::Panels::remoteaccess;
|
||||
|
||||
my $panel = esmith::FormMagick::Panel::remoteaccess->new();
|
||||
$panel->display();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=cut
|
||||
|
||||
# {{{ new
|
||||
|
||||
=head2 new();
|
||||
|
||||
Exactly as for esmith::FormMagick
|
||||
|
||||
=begin testing
|
||||
|
||||
$ENV{ESMITH_CONFIG_DB} = "10e-smith-base/configuration.conf";
|
||||
|
||||
use_ok('esmith::FormMagick::Panel::remoteaccess');
|
||||
use vars qw($panel);
|
||||
ok($panel = esmith::FormMagick::Panel::remoteaccess->new(),
|
||||
"Create panel object");
|
||||
isa_ok($panel, 'esmith::FormMagick::Panel::remoteaccess');
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
shift;
|
||||
my $self = esmith::FormMagick->new();
|
||||
$self->{calling_package} = (caller)[0];
|
||||
bless $self;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# }}}
|
||||
|
||||
=head2 get_prop ITEM PROP
|
||||
|
||||
A simple accessor for esmith::ConfigDB::Record::prop
|
||||
|
||||
=cut
|
||||
|
||||
sub get_prop {
|
||||
my ($self, $item, $prop) = @_;
|
||||
warn "You must specify a record key" unless $item;
|
||||
warn "You must specify a property name" unless $prop;
|
||||
my $record = $db->get($item) or warn "Couldn't get record for $item";
|
||||
return $record ? $record->prop($prop) : undef;
|
||||
}
|
||||
|
||||
=head2 get_value ITEM
|
||||
|
||||
A simple accessor for esmith::ConfigDB::Record::value
|
||||
|
||||
=cut
|
||||
|
||||
sub get_value {
|
||||
my $self = shift;
|
||||
my $item = shift;
|
||||
return ($db->get($item)->value());
|
||||
}
|
||||
|
||||
=head2 get_ftp_access
|
||||
|
||||
Returns "normal", "private" or "off" depending on the 'access' and 'status' properties
|
||||
of the "ftp" config file variable
|
||||
|
||||
=cut
|
||||
|
||||
sub get_ftp_access
|
||||
{
|
||||
my $status = get_prop('','ftp','status') || 'disabled';
|
||||
return 'off' unless $status eq 'enabled';
|
||||
|
||||
my $access = get_prop('','ftp','access') || 'private';
|
||||
return ($access eq 'public') ? 'normal' : 'private';
|
||||
}
|
||||
|
||||
=head2 get_vpn_sessions
|
||||
|
||||
Get the # of vpn sessions defined in the sessions property of the generik vpn config file variable
|
||||
|
||||
=cut
|
||||
|
||||
sub get_vpn_sessions {
|
||||
my $status = get_prop('','vpn','status');
|
||||
if (defined($status) && ($status eq 'enabled')) {
|
||||
|
||||
return(get_prop('','vpn','sessions') || '0');
|
||||
}
|
||||
else {
|
||||
return('0');
|
||||
}
|
||||
}
|
||||
|
||||
=head2 get_ssh_permit_root_login
|
||||
|
||||
returns 'yes' or 'no' depending on whether ssh permit root login is enabled
|
||||
|
||||
=cut
|
||||
|
||||
sub get_ssh_permit_root_login
|
||||
{
|
||||
return(get_prop('','sshd','PermitRootLogin') || 'no');
|
||||
}
|
||||
|
||||
=head2 get_ssh_password_auth
|
||||
|
||||
Returns 'no' or 'yes' depending on whether ssh password auth is enabled
|
||||
|
||||
=cut
|
||||
|
||||
sub get_ssh_password_auth
|
||||
{
|
||||
return(get_prop('','sshd','PasswordAuthentication') || 'yes');
|
||||
}
|
||||
|
||||
=head2 get_ssh_access
|
||||
|
||||
Returns 'public' 'private' or 'off', depending on the current ssh server mode.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_ssh_access {
|
||||
|
||||
my $status = get_prop('','sshd','status');
|
||||
if (defined($status) && ($status eq 'enabled')) {
|
||||
my $access = get_prop('','sshd','access');
|
||||
$access = ($access eq 'public') ? 'public' : 'private';
|
||||
return($access);
|
||||
}
|
||||
else {
|
||||
return('off');
|
||||
}
|
||||
}
|
||||
|
||||
=head2 get_ssh_port
|
||||
|
||||
Get the tcp port defined in the TCPPort propery
|
||||
in the sshd config file variable
|
||||
|
||||
=cut
|
||||
|
||||
sub get_ssh_port
|
||||
{
|
||||
return(get_prop('$self','sshd','TCPPort') || '22');
|
||||
}
|
||||
|
||||
=head2 get_ftp_password_login_access
|
||||
|
||||
Returns "public" or "private" depending on the 'status' and 'LoginAccess' properties
|
||||
of the "ftp" config file variable
|
||||
|
||||
=cut
|
||||
|
||||
sub get_ftp_password_login_access
|
||||
{
|
||||
my $status = get_prop('','ftp','status') || 'disabled';
|
||||
return 'private' unless $status eq 'enabled';
|
||||
|
||||
my $access = get_prop('','ftp','LoginAccess') || 'private';
|
||||
|
||||
return ($access eq 'public') ? 'public' : 'private';
|
||||
}
|
||||
|
||||
=head2 get_telnet_mode
|
||||
|
||||
Returns "public", "private" or "off" depending on the current telnet configuration
|
||||
|
||||
=cut
|
||||
|
||||
sub get_telnet_mode {
|
||||
my $telnet = $db->get('telnet');
|
||||
return('off') unless $telnet;
|
||||
my $status = $telnet->prop('status') || 'disabled';
|
||||
return('off') unless $status eq 'enabled';
|
||||
my $access = $telnet->prop('access') || 'private';
|
||||
return ($access eq "public") ? "public" : "private";
|
||||
}
|
||||
|
||||
=head2 get_serial_console
|
||||
|
||||
Returns "disabled" or the serial device on which a login console is
|
||||
enabled.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_serial_console
|
||||
{
|
||||
my $status = get_prop('','serial-console','status') || 'disabled';
|
||||
return 'disabled' unless $status eq 'enabled';
|
||||
|
||||
return get_prop('','serial-console','Device') || 'ttyS1';
|
||||
}
|
||||
|
||||
sub show_telnet_section
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->cgi;
|
||||
my $mode = get_telnet_mode();
|
||||
|
||||
# Don't show telnet setting if it is off
|
||||
return '' if $mode eq 'off';
|
||||
|
||||
my %options = (
|
||||
public => $self->localise('NETWORKS_ALLOW_PUBLIC'),
|
||||
private => $self->localise('NETWORKS_ALLOW_LOCAL'),
|
||||
off => $self->localise('NO_ACCESS'),
|
||||
);
|
||||
|
||||
print $q->Tr(
|
||||
$q->td({-colspan => 2},
|
||||
$q->p(
|
||||
$q->table(
|
||||
$q->Tr(
|
||||
$q->td({-colspan => 2},
|
||||
$q->span({-class => "error-noborders"},
|
||||
$self->localise('DESC_TELNET_ACCESS')))),
|
||||
$q->Tr(
|
||||
$q->td({-class => "sme-noborders-label"},
|
||||
$self->localise('LABEL_TELNET_ACCESS')),
|
||||
$q->td({-class => "sme-noborders-content"},
|
||||
$q->popup_menu(-name => 'TelnetAccess',
|
||||
-values => [ keys %options ],
|
||||
-labels => \%options,
|
||||
-default => $mode)))
|
||||
)
|
||||
)
|
||||
)
|
||||
);
|
||||
return '';
|
||||
}
|
||||
|
||||
|
||||
sub show_ftp_section
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
|
||||
# Don't show ftp setting unless the property exists
|
||||
return '' unless $db->get('ftp');
|
||||
|
||||
my %options = (
|
||||
normal => $self->localise('NETWORKS_ALLOW_PUBLIC'),
|
||||
private => $self->localise('NETWORKS_ALLOW_LOCAL'),
|
||||
off => $self->localise('NO_ACCESS'),
|
||||
);
|
||||
|
||||
my %loginOptions = (
|
||||
private => $self->localise('PASSWORD_LOGIN_PRIVATE'),
|
||||
public => $self->localise('PASSWORD_LOGIN_PUBLIC'),
|
||||
);
|
||||
|
||||
print $q->Tr(
|
||||
$q->td({-colspan => 2},
|
||||
$q->p(
|
||||
$q->table(
|
||||
$q->Tr(
|
||||
$q->td({-colspan => 2},
|
||||
$q->span({-class => "sme-noborders"},
|
||||
$self->localise('DESC_FTP_ACCESS')))),
|
||||
$q->Tr(
|
||||
$q->td({-class => "sme-noborders-label"},
|
||||
$self->localise('LABEL_FTP_ACCESS')),
|
||||
$q->td({-class => "sme-noborders-content"},
|
||||
$q->popup_menu(-name => 'FTPAccess',
|
||||
-values => [ keys %options ],
|
||||
-labels => \%options,
|
||||
-default => get_ftp_access()))),
|
||||
$q->Tr(
|
||||
$q->td({-colspan => 2},
|
||||
$q->span({-class => "sme-noborders"},
|
||||
$self->localise('DESC_FTP_LOGIN')))),
|
||||
$q->Tr(
|
||||
$q->td({-class => "sme-noborders-label"},
|
||||
$self->localise('LABEL_FTP_LOGIN')),
|
||||
$q->td({-class => "sme-noborders-content"},
|
||||
$q->popup_menu(-name => 'FTPPasswordLogin',
|
||||
-values => [ keys %loginOptions ],
|
||||
-labels => \%loginOptions,
|
||||
-default => get_ftp_password_login_access())))
|
||||
)
|
||||
)
|
||||
)
|
||||
);
|
||||
return '';
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 zero_or_positive
|
||||
|
||||
Validate that the input is a number >= 0.
|
||||
|
||||
=cut
|
||||
|
||||
sub zero_or_positive
|
||||
{
|
||||
my $self = shift;
|
||||
my $val = shift || 0;
|
||||
|
||||
return 'OK' if($val =~ /^\d+$/ and $val >= 0);
|
||||
return $self->localise('VALUE_ZERO_OR_POSITIVE');
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 vpn_and_dhcp_range
|
||||
|
||||
Validate the input of vpn session if it is not superior than the maximum number of ip between dhcpd_start and dhcpd_end
|
||||
|
||||
=cut
|
||||
|
||||
sub vpn_and_dhcp_range
|
||||
{
|
||||
my $self = shift;
|
||||
my $val = shift || 0;
|
||||
my $dhcp_status = $db->get_prop('dhcpd','status') || 'disabled';
|
||||
my $dhcp_end = $db->get_prop('dhcpd','end') || '';
|
||||
my $dhcp_start = $db->get_prop('dhcpd','start') || '';
|
||||
|
||||
if ( $dhcp_status eq 'enabled' )
|
||||
{
|
||||
my $ip_start = unpack 'N', inet_aton($dhcp_start);
|
||||
my $ip_end = unpack 'N', inet_aton($dhcp_end);
|
||||
my $ip_count = $ip_end - $ip_start;
|
||||
return 'OK' if( $val < $ip_count );
|
||||
return $self->localise('NUMBER_OF_VPN_CLIENTS_MUST_BE_LESSER_THAN_NUMBER_OF_IP_IN_DHCP_RANGE');
|
||||
}
|
||||
else
|
||||
{
|
||||
return 'OK';
|
||||
}
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 _get_valid_from
|
||||
|
||||
Reads the ValidFrom property of config entry httpd-admin and returns a list
|
||||
of the results. Private method.
|
||||
|
||||
=for testing
|
||||
ok($panel->_get_valid_from(), "_get_valid_from");
|
||||
|
||||
=cut
|
||||
|
||||
sub _get_valid_from
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $rec = $db->get('httpd-admin');
|
||||
return undef unless($rec);
|
||||
my @vals = (split ',', ($rec->prop('ValidFrom') || ''));
|
||||
return @vals;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 add_new_valid_from
|
||||
|
||||
Adds a new ValidFrom property in httpd-admin.
|
||||
|
||||
=for testing
|
||||
$panel->{cgi} = CGI->new();
|
||||
$panel->{cgi}->param(-name=>'validFromNetwork',-value=>'1.2.3.4');
|
||||
$panel->{cgi}->param(-name=>'validFromMask',-value=>'255.255.255.255');
|
||||
is($panel->add_new_valid_from(), '', 'add_new_valid_from');
|
||||
|
||||
=cut
|
||||
|
||||
sub ip_number_or_blank
|
||||
{
|
||||
my $self = shift;
|
||||
my $ip = shift;
|
||||
|
||||
if (!defined($ip) || $ip eq "")
|
||||
{
|
||||
return 'OK';
|
||||
}
|
||||
return CGI::FormMagick::Validator::ip_number($self, $ip);
|
||||
}
|
||||
|
||||
sub subnet_mask_or_blank
|
||||
{
|
||||
my ($self, $mask) = @_;
|
||||
if (!defined($mask) || $mask eq "")
|
||||
{
|
||||
return "OK";
|
||||
}
|
||||
chomp $mask ;
|
||||
# we test for a valid mask or bit mask
|
||||
my $tip="192.168.50.1";
|
||||
my $block = new Net::Netmask("$tip/$mask") or return "INVALID_SUBNET_MASK";
|
||||
if ($block->mask() eq "$mask" || $block->bits() eq "$mask")
|
||||
{
|
||||
return "OK";
|
||||
}
|
||||
return "INVALID_SUBNET_MASK";
|
||||
}
|
||||
|
||||
sub validate_network_and_mask
|
||||
{
|
||||
my $self = shift;
|
||||
my $mask = shift || "";
|
||||
|
||||
my $net = $self->cgi->param('validFromNetwork') || "";
|
||||
if ($net xor $mask)
|
||||
{
|
||||
return $self->localise('ERR_INVALID_PARAMS');
|
||||
}
|
||||
return 'OK';
|
||||
}
|
||||
|
||||
sub add_new_valid_from
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
|
||||
my $net = $q->param('validFromNetwork');
|
||||
my $mask = $q->param('validFromMask');
|
||||
|
||||
# we transform bit mask to regular mask
|
||||
my $block = new Net::Netmask("$net/$mask");
|
||||
$mask = $block->mask();
|
||||
|
||||
# do nothing if no network was added
|
||||
return 1 unless ($net && $mask);
|
||||
|
||||
my $rec = $db->get('httpd-admin');
|
||||
unless ($rec)
|
||||
{
|
||||
return $self->error('ERR_NO_RECORD');
|
||||
}
|
||||
|
||||
my $prop = $rec->prop('ValidFrom') || '';
|
||||
|
||||
my @vals = split /,/, $prop;
|
||||
return '' if (grep /^$net\/$mask$/, @vals); # already have this entry
|
||||
|
||||
if ($prop ne '')
|
||||
{
|
||||
$prop .= ",$net/$mask";
|
||||
}
|
||||
else
|
||||
{
|
||||
$prop = "$net/$mask";
|
||||
}
|
||||
$rec->set_prop('ValidFrom', $prop);
|
||||
$q->delete('validFromNetwork');
|
||||
$q->delete('validFromMask');
|
||||
return 1;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 remove_valid_from
|
||||
|
||||
Remove the specified net/mask from ValidFrom
|
||||
|
||||
=for testing
|
||||
$panel->{cgi}->param(-name=>'validFromNetwork', -value=>'1.2.3.4');
|
||||
$panel->{cgi}->param(-name=>'validFromMask', -value=>'255.255.255.255');
|
||||
is($panel->remove_valid_from(), '', 'remove_valid_from');
|
||||
|
||||
=cut
|
||||
|
||||
sub remove_valid_from
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
|
||||
my @remove = $q->param('validFromRemove');
|
||||
my @vals = $self->_get_valid_from();
|
||||
|
||||
foreach my $entry (@remove)
|
||||
{
|
||||
return undef unless $entry;
|
||||
|
||||
my ($net, $mask) = split (/\//, $entry);
|
||||
|
||||
unless (@vals)
|
||||
{
|
||||
print STDERR "ERROR: unable to load ValidFrom property from conf db\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
# what if we don't have a mask because someone added an entry from
|
||||
# the command line? by the time we get here, the panel will have
|
||||
# added a 32 bit mask, so we don't know for sure if the value in db
|
||||
# is $net alone or $net/255.255.255.255. we have to check for both
|
||||
# in this special case...
|
||||
@vals = (grep { $entry ne $_ && $net ne $_ } @vals);
|
||||
}
|
||||
|
||||
my $prop;
|
||||
if (@vals)
|
||||
{
|
||||
$prop = join ',',@vals;
|
||||
}
|
||||
else
|
||||
{
|
||||
$prop = '';
|
||||
}
|
||||
$db->get('httpd-admin')->set_prop('ValidFrom', $prop);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
=head2 show_valid_from_list
|
||||
|
||||
Displays a table of the ValidFrom networks for httpd-admin.
|
||||
|
||||
=for testing
|
||||
$panel->{cgi}->param(-name=>'validFromNetwork', -value=>'5.4.3.2');
|
||||
$panel->{cgi}->param(-name=>'validFromMask', -value=>'255.255.255.255');
|
||||
$panel->add_new_valid_from();
|
||||
$panel->{source} = qq(<form><page name="RemoveValidFrom"></page></form>);
|
||||
$panel->parse_xml();
|
||||
$panel->show_valid_from_list();
|
||||
like($_STDOUT_, qr/VALIDFROM_DESC/, 'show_valid_from_list');
|
||||
like($_STDOUT_, qr/5.4.3.2/, ' .. saw the network listed');
|
||||
like($_STDOUT_, qr/REMOVE/, ' .. saw the remove button');
|
||||
$panel->remove_valid_from();
|
||||
|
||||
=cut
|
||||
|
||||
sub show_valid_from_list
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->{cgi};
|
||||
|
||||
print '<tr><td colspan=2>',$q->p($self->localise('VALIDFROM_DESC')),'</td></tr>';
|
||||
|
||||
my @vals = $self->_get_valid_from();
|
||||
if (@vals)
|
||||
{
|
||||
print '<tr><td colspan=2>',
|
||||
$q->start_table({class => "sme-border"}),"\n";
|
||||
print $q->Tr(
|
||||
esmith::cgi::genSmallCell($q, $self->localise('NETWORK'),"header"),
|
||||
esmith::cgi::genSmallCell($q, $self->localise('SUBNET_MASK'),"header"),
|
||||
esmith::cgi::genSmallCell($q, $self->localise('NUM_OF_HOSTS'),"header"),
|
||||
esmith::cgi::genSmallCell($q, $self->localise('REMOVE'),"header"));
|
||||
|
||||
my @cbGroup = $q->checkbox_group(-name => 'validFromRemove',
|
||||
-values => [@vals], -labels => { map {$_ => ''} @vals });
|
||||
foreach my $val (@vals)
|
||||
{
|
||||
my ($net, $mask) = split '/', $val;
|
||||
$mask = '255.255.255.255' unless ($mask);
|
||||
my ($numhosts,$a,$b) = esmith::util::computeHostRange($net,$mask);
|
||||
print $q->Tr(
|
||||
esmith::cgi::genSmallCell($q, $net, "normal"),
|
||||
esmith::cgi::genSmallCell($q, $mask, "normal"),
|
||||
esmith::cgi::genSmallCell($q, $numhosts, "normal"),
|
||||
esmith::cgi::genSmallCell($q, shift(@cbGroup),
|
||||
"normal"));
|
||||
}
|
||||
print '</table></td></tr>';
|
||||
}
|
||||
else
|
||||
{
|
||||
print $q->Tr($q->td($q->b($self->localise('NO_ENTRIES_YET'))));
|
||||
}
|
||||
return '';
|
||||
}
|
||||
|
||||
=head1 ACTION
|
||||
|
||||
=head2 change_settings
|
||||
|
||||
If everything has been validated, properly, go ahead and set the new settings
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
sub change_settings {
|
||||
my ($self) = @_;
|
||||
|
||||
my %conf;
|
||||
|
||||
my $q = $self->{'cgi'};
|
||||
|
||||
# Don't process the form unless we clicked the Save button. The event is
|
||||
# called even if we chose the Remove link or the Add link.
|
||||
return unless($q->param('Next') eq $self->localise('SAVE'));
|
||||
|
||||
my $access = ($q->param ('TelnetAccess') || 'off');
|
||||
my $sshaccess = ($q->param ('sshAccess') || 'off');
|
||||
my $sshPermitRootLogin = ($q->param ('sshPermitRootLogin') || 'no');
|
||||
my $sshPasswordAuthentication = ($q->param ('sshPasswordAuthentication') || 'no');
|
||||
my $sshTCPPort = ($q->param ('sshTCPPort') || '22');
|
||||
my $ftplogin = ($q->param ('FTPPasswordLogin') || 'private');
|
||||
my $ftpaccess = ($q->param ('FTPAccess') || 'off');
|
||||
my $vpnSessions = ($q->param ('vpnSessions') || '0');
|
||||
# my $serialConsole = ($q->param ('serialConsole') || 'disabled');
|
||||
|
||||
#------------------------------------------------------------
|
||||
# Looks good; go ahead and change the access.
|
||||
#------------------------------------------------------------
|
||||
|
||||
my $rec = $db->get('telnet');
|
||||
if($rec)
|
||||
{
|
||||
if ($access eq "off")
|
||||
{
|
||||
$rec->set_prop('status','disabled');
|
||||
}
|
||||
else
|
||||
{
|
||||
$rec->set_prop('status','enabled');
|
||||
$rec->set_prop('access', $access);
|
||||
}
|
||||
}
|
||||
|
||||
$rec = $db->get('sshd') || $db->new_record('sshd', {type => 'service'});
|
||||
$rec->set_prop('TCPPort', $sshTCPPort);
|
||||
$rec->set_prop('status', ($sshaccess eq "off" ? 'disabled' : 'enabled'));
|
||||
$rec->set_prop('access', $sshaccess);
|
||||
$rec->set_prop('PermitRootLogin', $sshPermitRootLogin);
|
||||
$rec->set_prop('PasswordAuthentication', $sshPasswordAuthentication);
|
||||
|
||||
|
||||
$rec = $db->get('ftp');
|
||||
if($rec)
|
||||
{
|
||||
if ($ftpaccess eq "off")
|
||||
{
|
||||
$rec->set_prop('status', 'disabled');
|
||||
$rec->set_prop('access', 'private');
|
||||
$rec->set_prop('LoginAccess', 'private');
|
||||
}
|
||||
elsif ($ftpaccess eq "normal")
|
||||
{
|
||||
$rec->set_prop('status', 'enabled');
|
||||
$rec->set_prop('access', 'public');
|
||||
$rec->set_prop('LoginAccess', $ftplogin);
|
||||
}
|
||||
else
|
||||
{
|
||||
$rec->set_prop('status', 'enabled');
|
||||
$rec->set_prop('access', 'private');
|
||||
$rec->set_prop('LoginAccess', $ftplogin);
|
||||
}
|
||||
}
|
||||
|
||||
if ($vpnSessions == 0)
|
||||
{
|
||||
$db->get('vpn')->set_prop('sessions', $vpnSessions);
|
||||
$db->get('vpn')->set_prop('status', 'disabled');
|
||||
}
|
||||
else
|
||||
{
|
||||
$db->get('vpn')->set_prop('status', 'enabled');
|
||||
$db->get('vpn')->set_prop('sessions', $vpnSessions);
|
||||
}
|
||||
|
||||
|
||||
# REMOVED by markk, May 16 2005 - see DPAR MN00084537
|
||||
# $rec = $db->get('serial-console');
|
||||
# unless($rec)
|
||||
# {
|
||||
# $rec = $db->new_record('serial-console', {type=>'service'});
|
||||
# }
|
||||
|
||||
# if ($serialConsole eq 'disabled')
|
||||
# {
|
||||
# $rec->set_prop('status', 'disabled');
|
||||
# }
|
||||
# else
|
||||
# {
|
||||
# $rec->set_prop('status', 'enabled');
|
||||
# $rec->set_prop('Device', $serialConsole);
|
||||
# }
|
||||
|
||||
$self->cgi->param(-name=>'wherenext', -value=>'First');
|
||||
|
||||
unless ($self->add_new_valid_from)
|
||||
{
|
||||
return '';
|
||||
}
|
||||
|
||||
unless ($self->remove_valid_from)
|
||||
{
|
||||
return '';
|
||||
}
|
||||
|
||||
# reset ipsec roadwarrior CA,server,client certificates
|
||||
if ($q->param('ipsecrwReset')) {
|
||||
system('/sbin/e-smith/roadwarrior', 'reset_certs') == 0
|
||||
or die "Error occurred while resetting ipsec certificates.\n";
|
||||
$q->param(-name=>'ipsecrwReset', -value=>'');
|
||||
}
|
||||
$self->set_ipsecrw_sessions;
|
||||
|
||||
unless ( system( "/sbin/e-smith/signal-event", "remoteaccess-update" ) == 0 )
|
||||
{
|
||||
$self->error('ERROR_UPDATING_CONFIGURATION');
|
||||
return undef;
|
||||
}
|
||||
|
||||
$self->success('SUCCESS');
|
||||
}
|
||||
|
||||
sub get_ipsecrw_sessions
|
||||
{
|
||||
my $status = $db->get('ipsec')->prop('RoadWarriorStatus');
|
||||
if (defined($status) && ($status eq 'enabled')) {
|
||||
return($db->get('ipsec')->prop('RoadWarriorSessions') || '0');
|
||||
}
|
||||
else {
|
||||
return('0');
|
||||
}
|
||||
}
|
||||
|
||||
sub show_ipsecrw_section
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->cgi;
|
||||
|
||||
# Don't show ipsecrw setting unless the status property exists
|
||||
return $self->localise('DESC_IPSEC_VPN_UNAVAILABLE') unless ($db->get('ipsec')
|
||||
&& $db->get('ipsec')->prop('RoadWarriorStatus'));
|
||||
|
||||
print $q->Tr(
|
||||
$q->td( {-colspan => 2},
|
||||
$q->p(
|
||||
$q->table(
|
||||
$q->Tr(
|
||||
$q->td({-colspan => 2, -class => "sme-noborders"},
|
||||
$self->localise('DESC_IPSECRW'))),
|
||||
$q->Tr(
|
||||
$q->td({-class => "sme-noborders-label"},
|
||||
$self->localise('LABEL_IPSECRW_SESS')),
|
||||
$q->td({-class => "sme-noborders-content"},
|
||||
$q->textfield(-name => 'ipsecrwSessions',
|
||||
-value => get_ipsecrw_sessions(),
|
||||
-size => '3'))),
|
||||
$q->Tr(
|
||||
$q->td({-colspan => 2, -class => "sme-noborders"},
|
||||
$self->localise('DESC_IPSECRW_RESET'))),
|
||||
$q->Tr(
|
||||
$q->td({-class => "sme-noborders-label"},
|
||||
$self->localise('LABEL_IPSECRW_RESET')),
|
||||
$q->td({-class => "sme-noborders-content"},
|
||||
$q->checkbox(-name => 'ipsecrwReset', -label => ''))),
|
||||
)
|
||||
)
|
||||
)
|
||||
);
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub set_ipsecrw_sessions
|
||||
{
|
||||
my $self = shift;
|
||||
my $q = $self->cgi;
|
||||
my $sessions = $q->param('ipsecrwSessions');
|
||||
if (defined $sessions)
|
||||
{
|
||||
$db->get('ipsec')->set_prop('RoadWarriorSessions', $sessions);
|
||||
if (int($sessions) > 0) {
|
||||
$db->get('ipsec')->set_prop('RoadWarriorStatus', 'enabled');
|
||||
}
|
||||
}
|
||||
return '';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
412
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/review.pm
Executable file
412
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/review.pm
Executable file
@@ -0,0 +1,412 @@
|
||||
#
|
||||
# $Id: review.pm,v 1.16 2003/06/02 20:50:49 charlieb Exp $
|
||||
#
|
||||
|
||||
package esmith::FormMagick::Panel::review;
|
||||
|
||||
use strict;
|
||||
use esmith::DomainsDB;
|
||||
use esmith::ConfigDB;
|
||||
use esmith::NetworksDB;
|
||||
use esmith::FormMagick;
|
||||
use esmith::util;
|
||||
use File::Basename;
|
||||
use Exporter;
|
||||
use Carp;
|
||||
|
||||
our @ISA = qw(esmith::FormMagick Exporter);
|
||||
|
||||
our @EXPORT = qw( print_row print_page print_header gen_email_addresses get_local_domain
|
||||
gen_domains get_local_networks print_serveronly_stanza
|
||||
print_gateway_stanza print_dhcp_stanza
|
||||
get_value get_prop get_net_prop
|
||||
|
||||
);
|
||||
|
||||
|
||||
|
||||
our $VERSION = sprintf '%d.%03d', q$Revision: 1.16 $ =~ /: (\d+).(\d+)/;
|
||||
|
||||
our $db = esmith::ConfigDB->open || die "Couldn't open config db";
|
||||
our $domains = esmith::DomainsDB->open || die "Couldn't open domains";
|
||||
our $networks = esmith::NetworksDB->open || die "Couldn't open networks";
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
esmith::FormMagick::Panels::review - useful panel functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::FormMagick::Panels::review;
|
||||
|
||||
my $panel = esmith::FormMagick::Panel::review->new();
|
||||
$panel->display();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=cut
|
||||
|
||||
# {{{ new
|
||||
|
||||
=head2 new();
|
||||
|
||||
Exactly as for esmith::FormMagick
|
||||
|
||||
=begin testing
|
||||
|
||||
$ENV{ESMITH_CONFIG_DB} = "10e-smith-base/configuration.conf";
|
||||
$ENV{ESMITH_NETWORKS_DB} = "10e-smith-base/networks.conf";
|
||||
$ENV{ESMITH_DOMAINS_DB} = "10e-smith-base/domains.conf";
|
||||
|
||||
use_ok('esmith::FormMagick::Panel::review');
|
||||
use vars qw($panel);
|
||||
ok($panel = esmith::FormMagick::Panel::review->new(), "Create panel object");
|
||||
isa_ok($panel, 'esmith::FormMagick::Panel::review');
|
||||
|
||||
=end testing
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
sub new {
|
||||
shift;
|
||||
my $self = esmith::FormMagick->new();
|
||||
$self->{calling_package} = (caller)[0];
|
||||
bless $self;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# }}}
|
||||
|
||||
=head2 get_prop ITEM PROP
|
||||
|
||||
A simple accessor for esmith::ConfigDB::Record::prop
|
||||
|
||||
=cut
|
||||
|
||||
sub get_prop {
|
||||
my $fm = shift if (ref($_[0]) ); # If we're being called in a formmagick context
|
||||
# The first argument will always be a fm.
|
||||
#otherwise, we don't want to grab it
|
||||
my $item = shift;
|
||||
my $prop = shift;
|
||||
|
||||
my $record = $db->get($item);
|
||||
if ($record) {
|
||||
return $record->prop($prop);
|
||||
}
|
||||
else {
|
||||
return '';
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
=head2 get_net_prop ITEM PROP $fm $item $prop
|
||||
|
||||
A simple accessor for esmith::NetworksDB::Record::prop
|
||||
|
||||
=cut
|
||||
|
||||
sub get_net_prop {
|
||||
my $fm = shift;
|
||||
my $item = shift;
|
||||
my $prop = shift;
|
||||
|
||||
my $record = $networks->get($item);
|
||||
if ($record) {
|
||||
return $record->prop($prop);
|
||||
}
|
||||
else {
|
||||
return '';
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
=head2 get_value ITEM
|
||||
|
||||
A simple accessor for esmith::ConfigDB::Record::value
|
||||
|
||||
=cut
|
||||
|
||||
sub get_value {
|
||||
my $fm = shift;
|
||||
my $item = shift;
|
||||
my $record = $db->get($item);
|
||||
if ($record) {
|
||||
return $record->value();
|
||||
}
|
||||
else {
|
||||
return '';
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
=head2 print_header FORMMAGICK HEADER
|
||||
|
||||
Prints an arbitrary "header" (h2) in the context of the form
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
sub print_header {
|
||||
my ($fm, $word) = @_;
|
||||
my $q = $fm->{cgi};
|
||||
# print $q->Tr(esmith::cgi::genDoubleCell($q, $q->h3($fm->localise($word)),"normal"));
|
||||
$word = $fm->localise($word);
|
||||
print qq(<tr><td colspan=2><h3>$word</h3></td></tr>),"\n";
|
||||
return undef;
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head2 print_row FORMMAGICK LABEL VALUE
|
||||
|
||||
Prints a row <tr><td>LABEL</td><td>VALUE</td></tr> in the context of the form.
|
||||
LABEL is localized. VALUE is not.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
sub print_row {
|
||||
my $self = shift;
|
||||
my ($label, $value) = @_;
|
||||
$label = $self->localise($label);
|
||||
print qq(<tr><td class="sme-noborders-label">$label</td><td class="sme-noborders-content">$value</td></tr>),"\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
=head2 print_gateway_stanza
|
||||
|
||||
If this system is a server gateway, show the external ip and gateway ip
|
||||
|
||||
=cut
|
||||
|
||||
sub print_gateway_stanza
|
||||
{
|
||||
my $fm = shift;
|
||||
if (get_value($fm,'SystemMode') =~ /servergateway/)
|
||||
{
|
||||
my $ip = get_value($fm,'ExternalIP');
|
||||
my $static =
|
||||
(get_value($fm, 'AccessType') eq 'dedicated') &&
|
||||
(get_value($fm, 'ExternalDHCP') eq 'off') &&
|
||||
(get_prop($fm, 'pppoe', 'status') eq 'disabled');
|
||||
if ($static)
|
||||
{
|
||||
$ip .= "/".get_value($fm,'ExternalNetmask');
|
||||
}
|
||||
print_row($fm, 'EXTERNAL_IP_ADDRESS_SUBNET_MASK', $ip);
|
||||
if ($static)
|
||||
{
|
||||
print_row($fm, 'GATEWAY', get_value($fm,'GatewayIP') );
|
||||
}
|
||||
}
|
||||
}
|
||||
=head2 print_serveronly_stanza
|
||||
|
||||
If this system is a standalone server with net access, show the external
|
||||
gateway IP
|
||||
|
||||
=cut
|
||||
|
||||
sub print_serveronly_stanza {
|
||||
my $fm = shift;
|
||||
if ( (get_value($fm,'SystemMode') eq 'serveronly') &&
|
||||
get_value($fm,'AccessType') &&
|
||||
(get_value($fm,'AccessType') ne "off")) {
|
||||
print_row($fm, 'GATEWAY', get_value($fm,'GatewayIP') );
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
=head2 print_dhcp_stanza
|
||||
|
||||
Prints out the current state of dhcp service
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
sub print_dhcp_stanza {
|
||||
my $fm = shift;
|
||||
print_row($fm,'DHCP_SERVER', (get_prop($fm,'dhcpd','status') || 'disabled' ));
|
||||
|
||||
if (get_prop($fm,'dhcpd', 'status') eq 'enabled') {
|
||||
print_row($fm, 'BEGINNING_OF_DHCP_ADDRESS_RANGE',
|
||||
get_prop($fm,'dhcpd','start') || '' );
|
||||
print_row($fm,'END_OF_DHCP_ADDRESS_RANGE',
|
||||
get_prop($fm,'dhcpd','end') || '' );
|
||||
}
|
||||
}
|
||||
|
||||
=head2 gen_domains
|
||||
|
||||
Returns a string of the domains this SME Server serves or a localized string
|
||||
saying "no domains defined"
|
||||
|
||||
=cut
|
||||
|
||||
sub gen_domains {
|
||||
my $fm = shift;
|
||||
|
||||
my @virtual = $domains->get_all_by_prop( type => 'domain');
|
||||
my $numvirtual = @virtual;
|
||||
if ($numvirtual == 0) {
|
||||
$fm->localise("NO_VIRTUAL_DOMAINS");
|
||||
}
|
||||
else {
|
||||
my $out = "";
|
||||
my $domain;
|
||||
foreach $domain (sort @virtual) {
|
||||
if ($out ne "") {
|
||||
$out .= "<BR>";
|
||||
}
|
||||
$out .= $domain->key;
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
}
|
||||
|
||||
=head2 gen_email_addresses
|
||||
|
||||
Returns a string of the various forms of email addresses that work
|
||||
on an SMEServer
|
||||
|
||||
=cut
|
||||
|
||||
sub gen_email_addresses {
|
||||
my $fm = shift;
|
||||
|
||||
my $domain = get_value($fm,'DomainName');
|
||||
my $useraccount = $fm->localise("EMAIL_USERACCOUNT");
|
||||
my $firstname = $fm->localise("EMAIL_FIRSTNAME");
|
||||
my $lastname = $fm->localise("EMAIL_LASTNAME");
|
||||
|
||||
my $out = "<I>" . $useraccount . "</I>\@" . $domain . "<BR>"
|
||||
. "<I>" . $firstname . "</I>.<I>" . $lastname . "</I>\@" . $domain . "<BR>"
|
||||
. "<I>" . $firstname . "</I>_<I>" . $lastname . "</I>\@" . $domain . "<BR>";
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
=head2 get_local_networks
|
||||
|
||||
Return a <br> delimited string of all the networks this SMEServer is
|
||||
serving.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_local_networks {
|
||||
my $fm = shift;
|
||||
|
||||
my @nets = $networks->get_all_by_prop('type' => 'network');
|
||||
|
||||
my $numNetworks = @nets;
|
||||
if ($numNetworks == 0) {
|
||||
return $fm->localise('NO_NETWORKS');
|
||||
}
|
||||
else {
|
||||
my $out = "";
|
||||
foreach my $network (sort @nets) {
|
||||
if ($out ne "") {
|
||||
$out .= "<BR>";
|
||||
}
|
||||
|
||||
$out .= $network->key."/" . get_net_prop($fm, $network->key, 'Mask');
|
||||
|
||||
if ( defined get_net_prop($fm, $network->key, 'Router') ) {
|
||||
$out .= " via " . get_net_prop ($fm, $network->key, 'Router');
|
||||
}
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head2 get_local_domain
|
||||
|
||||
Get the local domain name
|
||||
|
||||
=cut
|
||||
|
||||
sub get_local_domain
|
||||
{
|
||||
return (get_value('','DomainName'));
|
||||
}
|
||||
|
||||
=head2 get_public_ip_address
|
||||
|
||||
Get the public IP address, if it is set. Note that this will only be set
|
||||
for ServiceLink customers.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_public_ip_address
|
||||
{
|
||||
my $self = shift;
|
||||
my $sysconfig = $db->get('sysconfig');
|
||||
if ($sysconfig)
|
||||
{
|
||||
my $publicIP = $sysconfig->prop('PublicIP');
|
||||
if ($publicIP)
|
||||
{
|
||||
return $publicIP;
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
=head2 print_page
|
||||
|
||||
output the whole page we want to show
|
||||
|
||||
=cut
|
||||
|
||||
sub print_page {
|
||||
my $self = shift;
|
||||
|
||||
print "<table>";
|
||||
print_header($self,'NETWORKING_PARAMS' );
|
||||
print_row($self,'SERVER_MODE', (get_value($self,'SystemMode' )|| '') );
|
||||
print_row($self,'LOCAL_IP_ADDRESS_SUBNET_MASK', get_value($self,'LocalIP').'/'.get_value($self,'LocalNetmask') );
|
||||
my $publicIP = $self->get_public_ip_address;
|
||||
if ($publicIP)
|
||||
{
|
||||
$self->print_row('INTERNET_VISIBLE_ADDRESS', $publicIP);
|
||||
}
|
||||
|
||||
print_gateway_stanza($self);
|
||||
print_serveronly_stanza($self);
|
||||
print_row($self,'ADDITIONAL_LOCAL_NETWORKS', get_local_networks($self) );
|
||||
print_dhcp_stanza($self);
|
||||
|
||||
print_header($self, 'SERVER_NAMES' );
|
||||
print_row($self,'DNS_SERVER', get_value('','LocalIP') );
|
||||
print_row($self,'WEB_SERVER', 'www.'.get_local_domain() );
|
||||
|
||||
my $port = $db->get_prop("squid", "TransparentPort") || 3128;
|
||||
print_row($self,'PROXY_SERVER', 'proxy.'.get_local_domain().":$port" );
|
||||
|
||||
print_row($self,'FTP_SERVER', 'ftp.'.get_local_domain() );
|
||||
print_row($self,'SMTP_POP_AND_IMAP_MAIL_SERVERS', 'mail.'.get_local_domain() );
|
||||
|
||||
print_header($self,'DOMAIN_INFORMATION' );
|
||||
print_row($self,'PRIMARY_DOMAIN', get_value('','DomainName') );
|
||||
print_row($self,'VIRTUAL_DOMAINS', gen_domains($self));
|
||||
print_row($self,'PRIMARY_WEB_SITE', 'http://www.'.get_value('','DomainName') );
|
||||
print_row($self,'MITEL_NETWORKS_SME_SERVER_MANAGER',
|
||||
'https://'. (get_value('','SystemName') || 'localhost').'/server-manager/' );
|
||||
print_row($self,'MITEL_NETWORKS_SME_SERVER_USER_PASSWORD_PANEL',
|
||||
'https://'. (get_value($self,'SystemName') || 'localhost').'/user-password/' );
|
||||
print_row($self,'EMAIL_ADDRESSES', gen_email_addresses($self) );
|
||||
print "</table>";
|
||||
}
|
||||
|
||||
1;
|
||||
|
1285
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/useraccounts.pm
Executable file
1285
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/useraccounts.pm
Executable file
File diff suppressed because it is too large
Load Diff
1935
root/usr/share/perl5/vendor_perl/esmith/console/configure.pm
Normal file
1935
root/usr/share/perl5/vendor_perl/esmith/console/configure.pm
Normal file
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,49 @@
|
||||
package esmith::console::quitConsole;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Locale::gettext;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
name => gettext("Exit from the server console"),
|
||||
order => 100,
|
||||
};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub name
|
||||
{
|
||||
return $_[0]->{name};
|
||||
}
|
||||
|
||||
sub order
|
||||
{
|
||||
return $_[0]->{order};
|
||||
}
|
||||
|
||||
sub doit
|
||||
{
|
||||
my ($self, $console, $db) = @_;
|
||||
if ( $db->get_value('UnsavedChanges') ne 'no' )
|
||||
{
|
||||
my ($rc, $choice) = $console->yesno_page
|
||||
(
|
||||
title => gettext("*** THERE ARE UNACTIVATED CHANGES - QUIT ANYWAY? ***"),
|
||||
defaultno => 1,
|
||||
text =>
|
||||
gettext("Your configuration changes have been saved but have not yet been activated. This may result in unpredictable system behavior. We recommend that you complete the configuration process and activate the changes before exiting the console.") .
|
||||
"\n\n" .
|
||||
gettext("Are you sure you want to quit with unactivated changes?"),
|
||||
);
|
||||
|
||||
return unless ($rc == 0);
|
||||
}
|
||||
|
||||
system("/usr/bin/tput", "clear");
|
||||
exit (0);
|
||||
}
|
||||
|
||||
1;
|
@@ -0,0 +1,33 @@
|
||||
package esmith::console::save_config;
|
||||
use Locale::gettext;
|
||||
use esmith::console;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub doit
|
||||
{
|
||||
my ($self, $console, $db) = @_;
|
||||
#------------------------------------------------------------
|
||||
SAVE_CONFIG:
|
||||
#------------------------------------------------------------
|
||||
# After saving config we don't need to run it again on the next reboot.
|
||||
$db->set_prop("bootstrap-console", "ForceSave", "no");
|
||||
$db->set_prop("bootstrap-console", "Run", "no");
|
||||
$db->set_prop("bootstrap-console", "Restore", "enabled"); # Allow console restores
|
||||
|
||||
$console->infobox(
|
||||
title => gettext("Activating configuration settings"),
|
||||
text => gettext("Please stand by while your configuration settings are activated ..."),
|
||||
);
|
||||
|
||||
system("/sbin/e-smith/signal-event", 'bootstrap-console-save');
|
||||
}
|
||||
1;
|
132
root/usr/share/perl5/vendor_perl/esmith/console/startup.pm
Normal file
132
root/usr/share/perl5/vendor_perl/esmith/console/startup.pm
Normal file
@@ -0,0 +1,132 @@
|
||||
package esmith::console::startup;
|
||||
use Locale::gettext;
|
||||
use esmith::console;
|
||||
use esmith::ConfigDB;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
@_,
|
||||
};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub startup_callback {
|
||||
my $fd = shift;
|
||||
my @out = ();
|
||||
my $done = 0;
|
||||
|
||||
use DirHandle;
|
||||
my $d = DirHandle->new("/etc/rc7.d");
|
||||
my @services = sort
|
||||
{
|
||||
$a =~ /^S(\d+)/; my $A = $1;
|
||||
$b =~ /^S(\d+)/; my $B = $1;
|
||||
$A <=> $B
|
||||
} grep { /^S/ } $d->read;
|
||||
my $rows = 12;
|
||||
my $status_col = 65;
|
||||
|
||||
my $db = esmith::ConfigDB->open_ro;
|
||||
my $rec = $db->get('smb');
|
||||
my $i=0;
|
||||
foreach (@services) {
|
||||
$i=$i+1;
|
||||
next unless /^S(\d+)([^\.][\.\w\-]+)$/;
|
||||
next unless $2 eq "smb";
|
||||
splice @services,$i-1 , 1, "S${1}4smbd", "S${1}5nmbd" unless ($rec and $rec->prop('status') eq 'disabled');
|
||||
last;
|
||||
}
|
||||
|
||||
|
||||
open(STDOUT, ">&STDERR");
|
||||
foreach (@services)
|
||||
{
|
||||
sleep 1;
|
||||
my $percent = int(($done * 100) / ($#services + 1));
|
||||
$done += 1;
|
||||
my $link = $_;
|
||||
#warn "Looking at symlink $_\n";
|
||||
next unless /^S\d+([^\.][\.\w\-]+)$/; # Untaint service name
|
||||
my $service = $1;
|
||||
#my $db = esmith::ConfigDB->open_ro;
|
||||
$rec = $db->get($service);
|
||||
do
|
||||
{
|
||||
warn "not starting disabled service $service\n";
|
||||
next;
|
||||
} unless ($rec and $rec->prop('status') eq 'enabled');
|
||||
my $prompt = "starting ";
|
||||
my $supervised = -x "/service/$service/run";
|
||||
my @cmd;
|
||||
if (-x "/service/$service/run")
|
||||
{
|
||||
$prompt .= " supervised service $service";
|
||||
warn "starting supervised service $service\n";
|
||||
@cmd = ("sv", "up", "/service/$service");
|
||||
}
|
||||
elsif (-x "/etc/init.d/$service")
|
||||
{
|
||||
$prompt .= " unsupervised service $service";
|
||||
warn "starting unsupervised service $service\n";
|
||||
@cmd = ("/etc/init.d/$service", "start");
|
||||
}
|
||||
else
|
||||
{
|
||||
warn "ignoring unknown service $service: bogus start symlink $link\n";
|
||||
next;
|
||||
}
|
||||
|
||||
push @out, "$prompt\n";
|
||||
print $fd "XXX\n";
|
||||
print $fd "$percent\n";
|
||||
my @show = $#out > $rows ? @out[$#out - $rows .. $#out] : @out;
|
||||
do { print $fd $_ } foreach @show;
|
||||
print $fd "XXX\n";
|
||||
$prompt .= " " x ($status_col - length($prompt));
|
||||
$prompt .= system(@cmd) ? "\\Z1FAILED\\Zn" : "\\Z2OK\\Zn";
|
||||
$out[-1] = "$prompt\n";
|
||||
@show = $#out > $rows ? @out[$#out - $rows .. $#out] : @out;
|
||||
print $fd "XXX\n";
|
||||
print $fd "$percent\n";
|
||||
do { print $fd $_ } foreach @show;
|
||||
print $fd "XXX\n";
|
||||
}
|
||||
print $fd "100\n";
|
||||
sleep 2;
|
||||
return undef;
|
||||
};
|
||||
|
||||
my $console = esmith::console->new;
|
||||
|
||||
sub doit
|
||||
{
|
||||
my ($self, $console, $db) = @_;
|
||||
|
||||
$console->infobox
|
||||
(
|
||||
title => gettext("Starting system services"),
|
||||
text => "\n" .
|
||||
gettext("Please standby while system services are started ..."
|
||||
),
|
||||
);
|
||||
|
||||
system(qw(touch /var/lock/subsys/backup-running));
|
||||
system(qw(chown admin /var/lock/subsys/backup-running));
|
||||
sleep(6); # Wait to be certain that all runsv services have been started.
|
||||
$console->gauge(\&startup_callback,
|
||||
text => '',
|
||||
title => 'Starting system services',
|
||||
colors => 1,
|
||||
no_collapse => 1);
|
||||
}
|
||||
|
||||
#use esmith::console;
|
||||
#use esmith::ConfigDB;
|
||||
#esmith::console::startup->new->doit(esmith::console->new(),
|
||||
# esmith::ConfigDB->open);
|
||||
1;
|
@@ -0,0 +1,148 @@
|
||||
package esmith::console::system_password;
|
||||
use esmith::util;
|
||||
use Locale::gettext;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub doit
|
||||
{
|
||||
my ($self, $console, $db) = @_;
|
||||
return if ($db->get_value('PasswordSet') eq 'yes');
|
||||
#------------------------------------------------------------
|
||||
INITIAL_PASSWORD:
|
||||
#------------------------------------------------------------
|
||||
|
||||
my $rc;
|
||||
my $choice;
|
||||
my $choice1;
|
||||
my $choice2;
|
||||
|
||||
($rc, $choice1) = $console->password_page
|
||||
(
|
||||
title => gettext("Choose administrator password"),
|
||||
text =>
|
||||
gettext("Welcome to the server console!") .
|
||||
"\n\n" .
|
||||
gettext("You will now be taken through a sequence of screens to perform basic networking configuration on this server.") .
|
||||
"\n\n" .
|
||||
gettext("You can make your selections in each screen using the Arrow and Tab keys. At any point, if you select Back you will be returned to the previous screen.") .
|
||||
"\n\n" .
|
||||
gettext("Before you start, you must first choose the administrator password for your system and enter it below. You will not see the password as you enter it."),
|
||||
);
|
||||
|
||||
unless ($rc == 0)
|
||||
{
|
||||
($rc, $choice) = $console->message_page
|
||||
(
|
||||
title => gettext("Administrator password not set"),
|
||||
text => gettext("Sorry, you must set the administrator password now."),
|
||||
);
|
||||
|
||||
goto INITIAL_PASSWORD;
|
||||
}
|
||||
|
||||
unless ($choice1 =~ /^([ -~]+)$/)
|
||||
{
|
||||
($rc, $choice) = $console->message_page
|
||||
(
|
||||
title => gettext("Unprintable characters in password"),
|
||||
text => gettext("The password must contain only printable characters."),
|
||||
);
|
||||
|
||||
goto INITIAL_PASSWORD;
|
||||
}
|
||||
|
||||
use Crypt::Cracklib;
|
||||
|
||||
#--------------------------------------------------------
|
||||
# These are just to ensure that xgettext knows about the
|
||||
# Cracklib strings.
|
||||
# Note the extra space here and in the gettext call below. This
|
||||
# allows the French localization to properly generate qu'il
|
||||
gettext("it is based on your username");
|
||||
gettext("it is based upon your password entry");
|
||||
gettext("it is derived from your password entry");
|
||||
gettext("it is derivable from your password entry");
|
||||
gettext("it is too short");
|
||||
gettext("it is all whitespace");
|
||||
gettext("it is too simplistic/systematic");
|
||||
gettext("it is based on a dictionary word");
|
||||
gettext("it is based on a (reversed) dictionary word");
|
||||
gettext("it does not contain numbers");
|
||||
gettext("it does not contain uppercase characters");
|
||||
gettext("it does not contain lowercase characters");
|
||||
gettext("it does not contain special characters");
|
||||
#--------------------------------------------------------
|
||||
|
||||
my $strength = $db->get_prop("passwordstrength", "Admin");
|
||||
my $reason = esmith::util::validatePassword($choice1,$strength);
|
||||
|
||||
# Untaint return data from cracklib, so we can use it later. We
|
||||
# trust the library, so we accept anything.
|
||||
$reason =~ /(.+)/; $reason = $1;
|
||||
$reason ||= gettext("Software error: password check failed");
|
||||
unless ($reason eq 'ok')
|
||||
{
|
||||
($rc, $choice) = $console->yesno_page
|
||||
(
|
||||
title => gettext("Bad Password Choice"),
|
||||
text =>
|
||||
gettext("The password you have chosen is not a good choice, because ") .
|
||||
gettext($reason) . "." .
|
||||
"\n\n" .
|
||||
gettext("Do you wish to choose a better one?"),
|
||||
);
|
||||
|
||||
goto INITIAL_PASSWORD if ($rc == 0);
|
||||
}
|
||||
|
||||
($rc, $choice2) = $console->password_page
|
||||
(
|
||||
title => gettext("Choose administrator password"),
|
||||
text => gettext("Please type your administrator password again to verify."),
|
||||
);
|
||||
|
||||
unless ($rc == 0)
|
||||
{
|
||||
($rc, $choice) = $console->message_page
|
||||
(
|
||||
title => gettext("Administrator password not set"),
|
||||
text => gettext("Sorry, you must set the administrator password now."),
|
||||
);
|
||||
|
||||
goto INITIAL_PASSWORD;
|
||||
}
|
||||
|
||||
if ($choice1 ne $choice2)
|
||||
{
|
||||
($rc, $choice) = $console->message_page
|
||||
(
|
||||
title => gettext("Passwords do not match"),
|
||||
text => gettext("The two passwords did not match"),
|
||||
);
|
||||
|
||||
goto INITIAL_PASSWORD;
|
||||
}
|
||||
|
||||
#--------------------------------------------------
|
||||
# Set system password
|
||||
#--------------------------------------------------
|
||||
|
||||
esmith::util::setUnixSystemPassword ($choice1);
|
||||
esmith::util::setServerSystemPassword ($choice1);
|
||||
|
||||
my $old = $db->get_value('UnsavedChanges');
|
||||
$db->set_value('PasswordSet', 'yes');
|
||||
$db->set_value('UnsavedChanges', $old);
|
||||
}
|
||||
|
||||
1;
|
||||
|
154
root/usr/share/perl5/vendor_perl/esmith/ssl.pm
Normal file
154
root/usr/share/perl5/vendor_perl/esmith/ssl.pm
Normal file
@@ -0,0 +1,154 @@
|
||||
package esmith::ssl;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use esmith::ConfigDB;
|
||||
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw( key_exists_good_size cert_exists_good_size cert_is_cert key_is_key related_key_cert);
|
||||
|
||||
my $configdb = esmith::ConfigDB->open_ro or die "Could not open accounts db";
|
||||
our $SystemName = $configdb->get('SystemName')->value;
|
||||
our $DomainName = $configdb->get('DomainName')->value;
|
||||
our $FQDN = "$SystemName.$DomainName";
|
||||
|
||||
# test key size
|
||||
# test key exists
|
||||
=head1 NAME
|
||||
|
||||
esmith::php - A few tools to help with php-fpm installed versions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use esmith::ssl;
|
||||
|
||||
my $booleanK=key_exists_good_size;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is intended to help playing with installed SSL self-generated certificates and keys.
|
||||
|
||||
=head1 Methods
|
||||
|
||||
|
||||
=head2 key_exists_good_size
|
||||
test key exists, then test key size correct. Obviously it also test that the files is indeed a key
|
||||
planned to be called in :
|
||||
/etc/e-smith/templates/home/e-smith/ssl.crt
|
||||
/etc/e-smith/templates/home/e-smith/ssl.key
|
||||
|
||||
returns 0 if key is missing or wrong size
|
||||
returns 1 if key exists and key size is correct
|
||||
|
||||
=cut
|
||||
sub key_exists_good_size {
|
||||
my $configdb = esmith::ConfigDB->open_ro or die "Could not open accounts db";
|
||||
my %modSSL = $configdb->as_hash('modSSL');
|
||||
my $KeySize = $modSSL{KeySize} ||'4096';
|
||||
my $key = shift || "/home/e-smith/ssl.key/$FQDN.key";
|
||||
if ( -f $key )
|
||||
{
|
||||
#print "$key exists\n";
|
||||
# check key size openssl rsa -in /home/e-smith/ssl.key/$host.$domain.key -text -noout | sed -rn "s/Private-Key: \((.*) bit\)/\1/p"
|
||||
my $signatureKeySize = `openssl rsa -in $key -text -noout | grep "Private-Key" | head -1`;
|
||||
chomp $signatureKeySize;
|
||||
$signatureKeySize =~ s/^ *Private-Key: \((.*) bit\)/$1/p;
|
||||
if ( $signatureKeySize == $KeySize ) {
|
||||
#print "key size is correct ($KeySize)\n";
|
||||
# key exists and key size is correct, we can proceed
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
# key is either missing or wrong key size.
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
# test key is key
|
||||
#openssl rsa -check -in $key
|
||||
|
||||
=head2 cert_exists_good_size
|
||||
# check cert exist
|
||||
# check cert is cert
|
||||
# check cert size Public-Key
|
||||
# openssl rsa -noout -modulus -in domain.key | openssl md5
|
||||
# openssl x509 -noout -modulus -in domain.crt | openssl md5
|
||||
|
||||
=cut
|
||||
sub cert_exists_good_size {
|
||||
my $configdb = esmith::ConfigDB->open_ro or die "Could not open accounts db";
|
||||
my %modSSL = $configdb->as_hash('modSSL');
|
||||
my $KeySize = $modSSL{KeySize} ||'4096';
|
||||
my $crt = shift || "/home/e-smith/ssl.crt/$FQDN.crt";
|
||||
if ( -f $crt )
|
||||
{
|
||||
#openssl x509 -text -noout -in /home/e-smith/ssl.crt/$host.$domain.crt| sed -rn "s/Public-Key: \((.*) bit\)/\1/p"
|
||||
my $signatureKeySize = `openssl x509 -text -noout -in $crt | grep "Public-Key" | head -1`;
|
||||
chomp $signatureKeySize;
|
||||
$signatureKeySize =~ s/^ *Public-Key: \((.*) bit\)/$1/p;
|
||||
if ( $signatureKeySize == $KeySize ) {
|
||||
#print "$signatureKeySize\n";
|
||||
# cert is correct size and exists, we can proceed.
|
||||
# next check key and cert are related
|
||||
# next check cert is still valid
|
||||
# next check alt name are still the same
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub cert_is_cert {
|
||||
my $crt = shift || "/home/e-smith/ssl.crt/$FQDN.crt";
|
||||
if ( -f $crt )
|
||||
{
|
||||
open my $oldout, ">&STDERR"; # "dup" the stdout filehandle
|
||||
close STDERR;
|
||||
my $exit_code=system("openssl","x509", "-noout", "-in", "$crt");
|
||||
open STDERR, '>&', $oldout; # restore the dup'ed filehandle to STDOUT
|
||||
if ($exit_code==0){
|
||||
#print "certificate is a certificate\n";
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub key_is_key {
|
||||
my $key = shift || "/home/e-smith/ssl.key/$FQDN.key";
|
||||
if ( -f $key )
|
||||
{
|
||||
open my $oldout, ">&STDERR"; # "dup" the stdout filehandle
|
||||
close STDERR;
|
||||
my $exit_code=system("openssl","rsa", "-noout", "-in", "$key");
|
||||
open STDERR, '>&', $oldout; # restore the dup'ed filehandle to STDOUT
|
||||
if ($exit_code==0){
|
||||
#print "key is a key\n";
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub related_key_cert {
|
||||
my $key = shift || "/home/e-smith/ssl.key/$FQDN.key";
|
||||
my $crt = shift || "/home/e-smith/ssl.crt/$FQDN.crt";
|
||||
if ( key_is_key($key) and cert_is_cert($crt) )
|
||||
{
|
||||
# check the cert and the key are related, if key has been changed, then we need to change the cert
|
||||
my $crt_md5 = `openssl x509 -noout -modulus -in $crt | openssl md5`;
|
||||
my $key_md5 = `openssl rsa -noout -modulus -in $key | openssl md5`;
|
||||
#print "$key_md5 eq $crt_md5\n";
|
||||
return 1 if $key_md5 eq $crt_md5;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
##TODO migrate those actions from
|
||||
# check cert is related to key
|
||||
# => /etc/e-smith/templates/home/e-smith/ssl.crt
|
||||
# check cert domain and alt
|
||||
# => /etc/e-smith/templates/home/e-smith/ssl.crt
|
||||
# check is valid / expiry date
|
||||
# => /etc/e-smith/templates/home/e-smith/ssl.crt
|
||||
###################################
|
Reference in New Issue
Block a user