2024-03-22 04:54:28 +01:00
|
|
|
# SrvMngr: a web-based Sme Koozali server administration GUI
|
|
|
|
|
package SrvMngr;
|
|
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
|
use warnings;
|
|
|
|
|
use utf8;
|
|
|
|
|
|
|
|
|
|
use Mojo::Base 'Mojolicious';
|
|
|
|
|
|
|
|
|
|
use File::Spec;
|
|
|
|
|
use File::Spec::Functions qw( rel2abs catdir );
|
|
|
|
|
use Cwd;
|
|
|
|
|
use Net::Netmask;
|
|
|
|
|
|
|
|
|
|
use Mojo::File qw( path );
|
|
|
|
|
use Mojo::Home;
|
|
|
|
|
|
|
|
|
|
use DBM::Deep;
|
|
|
|
|
use Mojo::JWT;
|
|
|
|
|
|
|
|
|
|
use Mojolicious::Plugin::Config;
|
|
|
|
|
#use Mojolicious::Plugin::I18N;
|
|
|
|
|
|
|
|
|
|
use SrvMngr::Plugin::I18N;
|
|
|
|
|
use SrvMngr::I18N;
|
|
|
|
|
use SrvMngr::Model::Main;
|
|
|
|
|
|
2024-09-05 12:57:23 +02:00
|
|
|
use SrvMngr::Plugin::WithoutCache;
|
2024-03-22 04:54:28 +01:00
|
|
|
|
2024-10-02 10:12:38 +02:00
|
|
|
#this is overwrittrn with the "release" by the spec file - release can be "99.el8.sme"
|
|
|
|
|
our $VERSION = '';
|
|
|
|
|
#Extract the release value
|
|
|
|
|
if ($VERSION =~ /^(\d+)/) {
|
|
|
|
|
$VERSION = $1; # $1 contains the matched numeric digits
|
|
|
|
|
} else {
|
|
|
|
|
$VERSION = '999' #No leading numeric digits found
|
|
|
|
|
}
|
2024-03-22 04:54:28 +01:00
|
|
|
$VERSION = eval $VERSION;
|
|
|
|
|
|
|
|
|
|
use Exporter 'import';
|
|
|
|
|
our @EXPORT_OK = qw(
|
|
|
|
|
init_session get_mod_url theme_list
|
|
|
|
|
getNavigation ip_number is_normal_password email_simple
|
|
|
|
|
mac_address_or_blank mac_address ip_number_or_blank
|
|
|
|
|
lang_space get_routes_list subnet_mask get_reg_mask
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
has home => sub {
|
|
|
|
|
my $path = $ENV{SRVMNGR_HOME} || getcwd;
|
|
|
|
|
return Mojo::Home->new(File::Spec->rel2abs($path));
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
has config_file => sub {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return $ENV{SRVMNGR_CONFIG} if $ENV{SRVMNGR_CONFIG};
|
|
|
|
|
return $self->home->rel_file('conf/srvmngr.conf');
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
has data_dir => sub {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return $ENV{SRVMNGR_DATA} if $ENV{SRVMNGR_DATA};
|
|
|
|
|
return $self->home->rel_file('data');
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
has temp_dir => sub {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return $ENV{SRVMNGR_TEMP} if $ENV{SRVMNGR_TEMP};
|
|
|
|
|
return $self->home->rel_file('temp');
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
has conf_dir => sub{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return $ENV{SRVMNGR_CONF} if $ENV{SRVMNGR_CONF};
|
|
|
|
|
return $self->home->rel_file('conf');
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub startup {
|
|
|
|
|
|
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
|
|
$self->plugin( Config => { file => $self->config_file()} );
|
|
|
|
|
|
|
|
|
|
$self->mode( $self->config->{mode} || 'production' ); #'development'
|
|
|
|
|
|
|
|
|
|
$ENV{'MOJO_SMANAGER_DEBUG'} = $self->config->{debug} || 0;
|
|
|
|
|
|
|
|
|
|
$self->setup_plugins;
|
|
|
|
|
|
|
|
|
|
$self->setup_helpers;
|
|
|
|
|
|
|
|
|
|
$self->setup_paths;
|
|
|
|
|
|
|
|
|
|
$self->setup_sessions;
|
|
|
|
|
|
|
|
|
|
$self->setup_routing;
|
|
|
|
|
|
|
|
|
|
$self->setup_hooks;
|
|
|
|
|
|
|
|
|
|
# no data in cache
|
|
|
|
|
$self->renderer->cache->max_keys(0);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub setup_sessions {
|
|
|
|
|
|
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
|
|
# Setup signed sessions
|
|
|
|
|
$self->app->secrets( $self->config->{secrets} );
|
|
|
|
|
$self->sessions->cookie_name('smanager');
|
|
|
|
|
$self->sessions->default_expiration( $self->config->{timeout} );
|
|
|
|
|
$self->sessions->secure( 1 );
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub setup_paths {
|
|
|
|
|
|
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
|
|
# Replace the default paths
|
|
|
|
|
$self->renderer->paths([$self->home->rel_file('themes/default/templates')]);
|
|
|
|
|
$self->static->paths([$self->home->rel_file('themes/default/public')]);
|
|
|
|
|
|
|
|
|
|
my $theme = $self->config->{theme} || 'default';
|
|
|
|
|
if ( $theme ne 'default' ) {
|
|
|
|
|
# Put the new theme first
|
|
|
|
|
my $t_path = $self->home->rel_file('themes/'.$theme);
|
|
|
|
|
unshift @{$self->renderer->paths}, $t_path.'/templates' if -d $t_path.'/templates';
|
|
|
|
|
unshift @{$self->static->paths}, $t_path.'/public' if -d $t_path.'/public';
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub setup_helpers {
|
|
|
|
|
|
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
|
|
$self->helper(log_req => sub {
|
|
|
|
|
my $c = shift;
|
|
|
|
|
my $mess = shift || '';
|
|
|
|
|
my $method = $c->req->method;
|
|
|
|
|
my $url = $c->req->url;
|
|
|
|
|
my $version = $c->req->version;
|
|
|
|
|
my $ip = $c->tx->remote_address;
|
|
|
|
|
return "Request received => $method $url HTTP/$version from $ip : $mess ";
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper( 'home_page' => sub{ '/initial' } );
|
|
|
|
|
|
|
|
|
|
$self->helper( 'auth_fail' => sub {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $message = shift || $self->l('acs_NO');
|
|
|
|
|
$self->flash( error => $message );
|
|
|
|
|
$self->redirect_to( $self->home_page, status => 403 );
|
|
|
|
|
return 0;
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper( 'is_admin' => sub {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
if ( defined $self->session->{username} && defined $self->session->{is_admin} ) {
|
|
|
|
|
return $self->session->{is_admin};
|
|
|
|
|
}
|
|
|
|
|
return undef;
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper( 'is_unsafe' => sub {
|
|
|
|
|
return SrvMngr::Model::Main->reconf_needed();
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper( 'is_logged_in' => sub {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
if ( defined $self->session->{logged_in} ) {
|
|
|
|
|
return 1 if ( $self->session('logged_in') == 1 );
|
|
|
|
|
}
|
|
|
|
|
return undef;
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper(lang_space => \&_lang_space);
|
|
|
|
|
|
|
|
|
|
$self->plugin( Config => { file => $self->config_file()} );
|
|
|
|
|
|
|
|
|
|
$self->helper( send_email => sub {
|
|
|
|
|
my ($c, $address, $subject, $body) = @_;
|
|
|
|
|
|
|
|
|
|
if (not defined $body) {
|
|
|
|
|
warn "send_email: Need 3 parameters (Address, Subject, Body)\n";
|
|
|
|
|
return;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
my $rcfile = $c->app->conf_dir().'/admin_muttrc';
|
|
|
|
|
|
|
|
|
|
#warn "send_email: $rcfile * $address\n"; #$rcfile $subject $address\n";
|
|
|
|
|
system( "/bin/echo \"$body\" | /usr/bin/mutt -F $rcfile -s \"$subject\" \"$address\"" ) == 0
|
|
|
|
|
or warn "error sendmail: $address \n"; # $subject";
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper( pwdrst => sub {
|
|
|
|
|
my $c = shift;
|
|
|
|
|
my $file = $c->app->data_dir().'/pwdrst.db';
|
|
|
|
|
state $db = DBM::Deep->new($file);
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$self->helper( jwt => sub {
|
|
|
|
|
Mojo::JWT->new(secret => shift->app->secrets->[0] || die)
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub setup_plugins {
|
|
|
|
|
|
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
|
|
$self->plugin('TagHelpers');
|
|
|
|
|
|
|
|
|
|
$self->plugin('RenderFile');
|
2024-09-05 12:57:23 +02:00
|
|
|
|
|
|
|
|
$self->plugin('SrvMngr::Plugin::WithoutCache');
|
2024-03-22 04:54:28 +01:00
|
|
|
|
|
|
|
|
# CSRF protection if production mode
|
|
|
|
|
# $self->plugin('Mojolicious::Plugin::CSRFDefender' => {
|
|
|
|
|
# Adapted plugin for use with GET method
|
|
|
|
|
$self->plugin('SrvMngr::Plugin::CSRFDefender' => {
|
|
|
|
|
onetime => 1,
|
|
|
|
|
error_status => 400,
|
|
|
|
|
error_content => 'Error: CSRF token is invalid or outdated'
|
|
|
|
|
#error_template => 'csrf_400'
|
|
|
|
|
}) if ( $self->mode eq 'production' );
|
|
|
|
|
|
|
|
|
|
$self->plugin('SrvMngr::Plugin::I18N' => {namespace => 'SrvMngr::I18N', default => 'en'});
|
|
|
|
|
|
|
|
|
|
# $self->plugin('Mojolicious::Plugin::FrozenSessions' => {});
|
|
|
|
|
|
|
|
|
|
$self->helper(log_req => sub {
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
my $mess = shift || '';
|
|
|
|
|
|
|
|
|
|
my $method = $c->req->method;
|
|
|
|
|
my $url = $c->req->url;
|
|
|
|
|
my $version = $c->req->version;
|
|
|
|
|
my $ip = $c->tx->remote_address;
|
|
|
|
|
|
|
|
|
|
return "Request received => $method $url HTTP/$version from $ip: $mess ";
|
|
|
|
|
});
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub setup_routing {
|
|
|
|
|
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $r = $self->app->routes;
|
|
|
|
|
$r->namespaces(['SrvMngr::Controller']);
|
|
|
|
|
|
|
|
|
|
$r->get('/')->to('initial#main')->name('initial');
|
|
|
|
|
$r->get('/initial')->to('initial#main')->name('initial');
|
|
|
|
|
$r->get('/login')->to('login#main')->name('login');
|
|
|
|
|
$r->post('/login')->to('login#login')->name('signin');
|
|
|
|
|
$r->get('/manual')->to('manual#main')->name('manual');
|
|
|
|
|
$r->get('/support')->to('support#main')->name('support');
|
|
|
|
|
|
|
|
|
|
# Password reset allowed for this server
|
|
|
|
|
if ( ( $self->config->{pwdreset} || '0') == 1 ) {
|
|
|
|
|
$r->get('/login2')->to('login#pwdrescue')->name('pwdresc');
|
|
|
|
|
$r->get('/loginc')->to('login#confpwd')->name('resetpwdconf');
|
|
|
|
|
$r->get('/userpasswordr')->to('userpassword#main')->name('upwdreset');
|
|
|
|
|
$r->post('/userpasswordr')->to('userpassword#change_password')->name('upwdreset2');
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
my $if_logged_in = $r->under( sub {
|
|
|
|
|
my $c =shift;
|
|
|
|
|
return $c->is_logged_in || $c->auth_fail($c->l("acs_LOGIN"));
|
|
|
|
|
});
|
|
|
|
|
$if_logged_in->post('/swttheme')->to('swttheme#main')->name('swttheme');
|
|
|
|
|
$if_logged_in->get('/review')->to('review#main')->name('review');
|
|
|
|
|
$if_logged_in->get('/logout')->to('logout#logout')->name('logout');
|
|
|
|
|
$if_logged_in->get('/userpassword')->to('userpassword#main')->name('passwd');
|
|
|
|
|
$if_logged_in->post('/userpassword')->to('userpassword#change_password')->name('passwd2');
|
|
|
|
|
|
|
|
|
|
my $if_admin = $r->under( sub {
|
|
|
|
|
my $c =shift;
|
|
|
|
|
return $c->is_admin || $c->auth_fail($c->l("acs_ADMIN"));
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/backup')->to('backup#main')->name('backup');
|
|
|
|
|
$if_admin->post('/backup')->to('backup#do_display')->name('backupd');
|
|
|
|
|
$if_admin->get('/backupd')->to('backup#do_display')->name('backupc'); # corrections #
|
|
|
|
|
$if_admin->post('/backupd')->to('backup#do_update')->name('backupu');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/bugreport')->to('bugreport#main')->name('bugreport');
|
|
|
|
|
$if_admin->post('/bugreport')->to('bugreport#do_report')->name('bugreport2');
|
|
|
|
|
$if_admin->post('/bugreportD')->to('bugreport#download_config_report')->name('bugreportD');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/clamav')->to('clamav#main')->name('clamav');
|
|
|
|
|
$if_admin->post('/clamav')->to('clamav#do_update')->name('clamav2');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/datetime')->to('datetime#main')->name('datetime');
|
|
|
|
|
$if_admin->post('/datetime')->to('datetime#do_update')->name('datetime2');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/directory')->to('directory#main')->name('directory');
|
|
|
|
|
$if_admin->post('/directory')->to('directory#do_update')->name('directory2');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/domains')->to('domains#main')->name('domainsg');
|
|
|
|
|
$if_admin->post('/domains')->to('domains#do_display')->name('domainsp');
|
|
|
|
|
$if_admin->get('/domains2')->to('domains#do_display')->name('domains2g');
|
|
|
|
|
$if_admin->post('/domains2')->to('domains#do_update')->name('domains2p');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/emailsettings')->to('emailsettings#main')->name('emailsettings');
|
|
|
|
|
$if_admin->post('/emailsettings')->to('emailsettings#do_display')->name('emailsetting');
|
|
|
|
|
$if_admin->post('/emailsettingd')->to('emailsettings#do_update')->name('emailsettingu');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/groups')->to('groups#main')->name('groupsl');
|
|
|
|
|
$if_admin->post('/groups')->to('groups#do_display')->name('groupa');
|
|
|
|
|
$if_admin->get('/groups2')->to('groups#do_display')->name('groupd');
|
|
|
|
|
$if_admin->post('/groups2')->to('groups#do_update')->name('groupu');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/hostentries')->to('hostentries#main')->name('hostentries');
|
|
|
|
|
$if_admin->post('/hostentries')->to('hostentries#do_display')->name('hostentryadd');
|
|
|
|
|
$if_admin->get('/hostentriesd')->to('hostentries#do_display')->name('hostentrydis');
|
|
|
|
|
$if_admin->post('/hostentriesd')->to('hostentries#do_update')->name('hostentryupd');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/ibays')->to('ibays#main')->name('ibays');
|
|
|
|
|
$if_admin->post('/ibays')->to('ibays#do_display')->name('ibayadd');
|
|
|
|
|
$if_admin->get('/ibaysd')->to('ibays#do_display')->name('ibaydis');
|
|
|
|
|
$if_admin->post('/ibaysd')->to('ibays#do_update')->name('ibayupd');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/localnetworks')->to('localnetworks#main')->name('localnetworks');
|
|
|
|
|
$if_admin->post('/localnetworks')->to('localnetworks#do_display')->name('localnetworks');
|
|
|
|
|
$if_admin->post('/localnetworksa')->to('localnetworks#do_display')->name('localnetworksadd');
|
|
|
|
|
$if_admin->post('/localnetworksb')->to('localnetworks#do_display')->name('localnetworksadd1');
|
|
|
|
|
$if_admin->get('/localnetworksd')->to('localnetworks#do_display')->name('localnetworksdel');
|
|
|
|
|
$if_admin->post('/localnetworkse')->to('localnetworks#do_display')->name('localnetworksdel1');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/portforwarding')->to('portforwarding#main')->name('portforwarding');
|
|
|
|
|
$if_admin->post('/portforwarding')->to('portforwarding#do_display')->name('portforwarding');
|
|
|
|
|
$if_admin->post('/portforwardinga')->to('portforwarding#do_display')->name('portforwardingadd');
|
|
|
|
|
$if_admin->post('/portforwardingb')->to('portforwarding#do_display')->name('portforwardingadd1');
|
|
|
|
|
$if_admin->get('/portforwardingd')->to('portforwarding#do_display')->name('portforwardingdel');
|
|
|
|
|
$if_admin->post('/portforwardinge')->to('portforwarding#do_display')->name('portforwardingdel1');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/printers')->to('printers#main')->name('printersg');
|
|
|
|
|
$if_admin->post('/printers')->to('printers#do_display')->name('printera');
|
|
|
|
|
$if_admin->get('/printers2')->to('printers#do_display')->name('printer2g');
|
|
|
|
|
$if_admin->post('/printers2')->to('printers#do_update')->name('printers2p');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/proxy')->to('proxy#main')->name('proxy');
|
|
|
|
|
$if_admin->post('/proxy')->to('proxy#do_update')->name('proxy2');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/pseudonyms')->to('pseudonyms#main')->name('pseudonymsl');
|
|
|
|
|
$if_admin->post('/pseudonyms')->to('pseudonyms#do_display')->name('pseudonyma');
|
|
|
|
|
$if_admin->get('/pseudonyms2')->to('pseudonyms#do_display')->name('pseudonymd');
|
|
|
|
|
$if_admin->post('/pseudonyms2')->to('pseudonyms#do_update')->name('pseudonymu');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/qmailanalog')->to('qmailanalog#main')->name('qmailanalog');
|
|
|
|
|
$if_admin->post('/qmailanalog')->to('qmailanalog#do_update')->name('qmailanalog2');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/quota')->to('quota#main')->name('quota');
|
|
|
|
|
$if_admin->get('/quotad')->to('quota#do_display')->name('quotalist');
|
|
|
|
|
$if_admin->post('/quotad')->to('quota#do_update')->name('quotaupd');
|
|
|
|
|
$if_admin->post('/quota2')->to('quota#do_update')->name('quotaval');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/reboot')->to('reboot#main')->name('reboot');
|
|
|
|
|
$if_admin->post('/reboot')->to('reboot#do_action')->name('rebootact');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/remoteaccess')->to('remoteaccess#main')->name('remoteaccess');
|
|
|
|
|
$if_admin->post('/remoteaccess')->to('remoteaccess#do_action')->name('remoteaccessact');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/support')->to('support#main')->name('support');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/useraccounts')->to('useraccounts#main')->name('useraccounts');
|
|
|
|
|
$if_admin->post('/useraccounts')->to('useraccounts#do_display')->name('useraccountadd');
|
|
|
|
|
$if_admin->get('/useraccountsd')->to('useraccounts#do_display')->name('useraccountdis');
|
|
|
|
|
$if_admin->post('/useraccountsd')->to('useraccounts#do_update')->name('useraccountupd');
|
|
|
|
|
$if_admin->post('/useraccountso')->to('useraccounts#do_display')->name('useraccountvpn');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/viewlogfiles')->to('viewlogfiles#main')->name('viewlogfiles');
|
|
|
|
|
$if_admin->post('/viewlogfiles')->to('viewlogfiles#do_action')->name('viewlogfiles2');
|
|
|
|
|
$if_admin->post('/viewlogfilesr')->to('viewlogfiles#do_action')->name('viewlogfilesr');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/yum')->to('yum#main')->name('yum');
|
|
|
|
|
$if_admin->post('/yum')->to('yum#do_display')->name('yumd1');
|
|
|
|
|
$if_admin->get('/yumd')->to('yum#do_display')->name('yumd');
|
|
|
|
|
$if_admin->post('/yumd')->to('yum#do_update')->name('yumu');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/welcome')->to('welcome#main')->name('welcome');
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/workgroup')->to('workgroup#main')->name('workgroup');
|
|
|
|
|
$if_admin->post('/workgroup')->to('workgroup#do_update')->name('workgroup2');
|
|
|
|
|
|
|
|
|
|
# additional routes (for contribs) got from 'routes' db
|
|
|
|
|
#my @routes = @{SrvMngr::get_routes_list()};
|
|
|
|
|
|
|
|
|
|
foreach (@{SrvMngr::get_routes_list()}) {
|
|
|
|
|
|
|
|
|
|
if ( defined $_->{method} and defined $_->{url} and defined $_->{ctlact} and defined $_->{name} ) {
|
|
|
|
|
my $menu = defined $_->{menu} ? $_->{menu} : 'A';
|
|
|
|
|
if ( $menu eq 'N' ) {
|
|
|
|
|
$r->get($_->{url})->to($_->{ctlact})->name($_->{name})
|
|
|
|
|
if ( $_->{method} eq 'get');
|
|
|
|
|
$r->post($_->{url})->to($_->{ctlact})->name($_->{name})
|
|
|
|
|
if ( $_->{method} eq 'post');
|
|
|
|
|
} elsif ( $menu eq 'U' ) {
|
|
|
|
|
$if_logged_in->get($_->{url})->to($_->{ctlact})->name($_->{name})
|
|
|
|
|
if ( $_->{method} eq 'get');
|
|
|
|
|
$if_logged_in->post($_->{url})->to($_->{ctlact})->name($_->{name})
|
|
|
|
|
if ( $_->{method} eq 'post');
|
|
|
|
|
} else {
|
|
|
|
|
$if_admin->get($_->{url})->to($_->{ctlact})->name($_->{name})
|
|
|
|
|
if ( $_->{method} eq 'get');
|
|
|
|
|
$if_admin->post($_->{url})->to($_->{ctlact})->name($_->{name})
|
|
|
|
|
if ( $_->{method} eq 'post');
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$if_admin->get('/config/:key' => {key => qr/[a-z0-9]{2,32}/})->to('request#getconfig')->name('getconfig');
|
|
|
|
|
$if_admin->get('/account/:key' => {key => qr/[a-z0-9]{2,32}/})->to('request#getaccount')->name('getaccount');
|
|
|
|
|
$if_admin->get('/:module' => {module => qr/[a-z0-9]{2,32}/})->to('modules#modsearch')->name('module_search');
|
|
|
|
|
$if_admin->any('/*whatever' => {whatever => ''})->to('modules#whatever')->name('whatever');
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub setup_hooks {
|
|
|
|
|
my ($c) = @_;
|
|
|
|
|
|
|
|
|
|
$c->hook( before_routes => sub {
|
|
|
|
|
my $c = shift;
|
|
|
|
|
if ( not defined $c->session->{lang} ) {
|
|
|
|
|
SrvMngr::init_session ( $c );
|
|
|
|
|
}
|
|
|
|
|
$c->lang_space();
|
|
|
|
|
});
|
|
|
|
|
|
|
|
|
|
if ( my $path = $ENV{MOJO_REVERSE_PROXY} ) {
|
|
|
|
|
my @path_parts = grep /\S/, split m{/}, $path;
|
|
|
|
|
$c->hook( before_dispatch => sub {
|
|
|
|
|
my ( $c ) = @_;
|
|
|
|
|
my $url = $c->req->url;
|
|
|
|
|
my $base = $url->base;
|
|
|
|
|
push @{ $base->path }, @path_parts;
|
|
|
|
|
$base->path->trailing_slash(1);
|
|
|
|
|
$url->path->leading_slash(0);
|
|
|
|
|
});
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub init_session {
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
$c->app->log->info("Init app session.");
|
|
|
|
|
|
|
|
|
|
my %datas = ();
|
|
|
|
|
%datas = %{SrvMngr::Model::Main->init_data()};
|
|
|
|
|
|
|
|
|
|
$c->session->{lang} = $datas{'lang'};
|
|
|
|
|
$c->session->{copyRight} = $c->l($datas{'copyRight'});
|
|
|
|
|
$c->session->{releaseVersion} = $datas{'releaseVersion'};
|
|
|
|
|
$c->session->{PwdSet} = $datas{'PwdSet'};
|
|
|
|
|
$c->session->{SystemName} = $datas{'SystemName'};
|
|
|
|
|
$c->session->{DomainName} = $datas{'DomainName'};
|
|
|
|
|
$c->session->{Access} = $datas{'Access'};
|
|
|
|
|
if ( not defined $c->session->{CurrentTheme} ) {
|
|
|
|
|
$c->session->{CurrentTheme} = $c->config->{theme};
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_mod_url{
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
my $module = shift;
|
|
|
|
|
|
|
|
|
|
# test if module (panel) exists
|
|
|
|
|
my $module_file = $c->config->{modules_dir} . '/' . ucfirst($module) . '.pm';
|
|
|
|
|
if ( -e $module_file){
|
|
|
|
|
return "/$module";
|
|
|
|
|
}
|
|
|
|
|
return -1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head2 theme_list()
|
|
|
|
|
|
|
|
|
|
Returns a hash of themes for the header theme field's drop down list.
|
|
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub theme_list {
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
|
|
|
|
|
my @files = ();
|
|
|
|
|
my @themes = ();
|
|
|
|
|
my $theme_ignore = "(\.\.?)";
|
|
|
|
|
|
|
|
|
|
# my $themedir = '/usr/share/smanager/themes/';
|
|
|
|
|
my $themedir = $c->app->home->rel_file('themes/');
|
|
|
|
|
|
|
|
|
|
if (opendir (DIR, $themedir)) {
|
|
|
|
|
@files = grep (!/^${theme_ignore}$/, readdir(DIR));
|
|
|
|
|
closedir (DIR);
|
|
|
|
|
} else {
|
|
|
|
|
warn "Can't open directory $themedir\n";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
foreach my $theme (@files) {
|
|
|
|
|
if (-d "$themedir/$theme") {
|
|
|
|
|
push @themes, $theme;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return \@themes;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#------------------------------------------------------------
|
|
|
|
|
# subroutine to feed navigation bar
|
|
|
|
|
#------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
sub getNavigation {
|
|
|
|
|
|
|
|
|
|
use esmith::NavigationDB;
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
my $lang = shift || 'en-us';
|
|
|
|
|
my $menu = shift || 'N';
|
|
|
|
|
|
|
|
|
|
# my $lang = $c->session->{lang} || 'en-us';
|
|
|
|
|
|
|
|
|
|
# Use this variable throughout to keep track of files
|
|
|
|
|
# list of just the files
|
|
|
|
|
|
|
|
|
|
my @files = ();
|
|
|
|
|
my %files_hash = ();
|
|
|
|
|
|
|
|
|
|
#-----------------------------------------------------
|
|
|
|
|
# Determine the directory where the functions are kept
|
|
|
|
|
#-----------------------------------------------------
|
|
|
|
|
my $navigation_ctlr_ignore =
|
2024-04-23 10:28:31 +02:00
|
|
|
"(\.\.?|Swttheme\.pm|Login\.pm|Request\.pm|Modules\.pm|Legacypanel\.pm(-.*)?)";
|
2024-03-22 04:54:28 +01:00
|
|
|
# "(\.\.?|Initial\.pm|Manual\.pm|Swttheme\.pm|Request\.pm|Modules\.pm(-.*)?)";
|
|
|
|
|
my $navigation_cgi_ignore =
|
|
|
|
|
"(\.\.?|navigation|noframes|online-manual|(internal|pleasewait)(-.*)?)";
|
|
|
|
|
|
|
|
|
|
# my $ctrldir = $c->app->home->rel_file('lib/SrvMngr/Controller');
|
|
|
|
|
my $ctrldir = '/usr/share/smanager/lib/SrvMngr/Controller';
|
|
|
|
|
my $cgidir = '/etc/e-smith/web/panels/manager/cgi-bin/';
|
|
|
|
|
|
|
|
|
|
if (opendir (DIR, $ctrldir)) {
|
|
|
|
|
@files = grep (!/^${navigation_ctlr_ignore}$/,
|
|
|
|
|
readdir (DIR));
|
|
|
|
|
closedir (DIR);
|
|
|
|
|
} else {
|
|
|
|
|
warn "Can't open directory $ctrldir\n";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
foreach my $file (@files) {
|
|
|
|
|
next if (-d "$ctrldir/$file");
|
|
|
|
|
next if ( $file !~ m/^[A-Z].*\.pm$/ );
|
|
|
|
|
|
|
|
|
|
my $file2 = lc($file);
|
|
|
|
|
$file2 =~ s/\.pm$//;
|
|
|
|
|
$files_hash{$file2} = 'ctrl';
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Is there some old panels not managed in new way ?
|
|
|
|
|
@files = ();
|
|
|
|
|
if (opendir (DIR, $cgidir)) {
|
|
|
|
|
@files = grep (!/^${navigation_cgi_ignore}$/,
|
|
|
|
|
readdir (DIR));
|
|
|
|
|
closedir (DIR);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
foreach my $file (@files) {
|
|
|
|
|
next if (-d "$cgidir/$file");
|
|
|
|
|
$files_hash{$file} = 'cgim' if ( ! exists $files_hash{$file} );
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#--------------------------------------------------
|
|
|
|
|
# For each script, extract the description and category
|
|
|
|
|
# information. Build up an associative array mapping headings
|
|
|
|
|
# to heading structures. Each heading structure contains the
|
|
|
|
|
# total weight for the heading, the number of times the heading
|
|
|
|
|
# has been encountered, and another associative array mapping
|
|
|
|
|
# descriptions to description structures. Each description
|
|
|
|
|
# structure contains the filename of the particular cgi script
|
|
|
|
|
# and a weight.
|
|
|
|
|
#--------------------------------------------------
|
|
|
|
|
my %nav = ();
|
|
|
|
|
|
|
|
|
|
use constant NAVIGATIONDIR => '/home/e-smith/db/navigation2';
|
|
|
|
|
# use constant WEBFUNCTIONS => '/etc/e-smith/web/functions';
|
|
|
|
|
|
|
|
|
|
my $navinfo = NAVIGATIONDIR . "/navigation.$lang";
|
|
|
|
|
|
|
|
|
|
my $navdb = esmith::NavigationDB->open_ro( $navinfo ) or
|
|
|
|
|
die "Couldn't open $navinfo\n";
|
|
|
|
|
|
|
|
|
|
# Check the navdb for anything with a UrlPath, which means that it doesn't
|
|
|
|
|
# have a cgi file to be picked up by the above code. Ideally, only pages
|
|
|
|
|
# that exist should be in the db, but that's not the case. Anything
|
|
|
|
|
# without a cgi file will have to remove themselves on uninstall from the
|
|
|
|
|
# navigation dbs.
|
|
|
|
|
foreach my $rec ($navdb->get_all)
|
|
|
|
|
{
|
|
|
|
|
if ($rec->prop('UrlPath'))
|
|
|
|
|
{
|
|
|
|
|
$files_hash{$rec->{key}} = $cgidir;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
foreach my $file (keys %files_hash)
|
|
|
|
|
{
|
|
|
|
|
#my $heading = 'Unknown';
|
|
|
|
|
my $heading = 'Legacy';
|
|
|
|
|
|
|
|
|
|
my $description = $file;
|
|
|
|
|
my $headingWeight = 99999;
|
|
|
|
|
my $descriptionWeight = 99999;
|
|
|
|
|
my $urlpath = '';
|
|
|
|
|
my $menucat = 'A'; # admin menu (default)
|
|
|
|
|
|
|
|
|
|
my $rec = $navdb->get($file);
|
|
|
|
|
|
|
|
|
|
if (defined $rec)
|
|
|
|
|
{
|
|
|
|
|
$heading = $rec->prop('Heading');
|
|
|
|
|
$description = $rec->prop('Description');
|
2024-05-09 18:02:39 +02:00
|
|
|
$headingWeight = $rec->prop('HeadingWeight') || 99999; #Stop noise in logs if file in dir does not have nav header.
|
2024-03-22 04:54:28 +01:00
|
|
|
$descriptionWeight = $rec->prop('DescriptionWeight');
|
|
|
|
|
$urlpath = $rec->prop('UrlPath') || '';
|
|
|
|
|
$menucat = $rec->prop('MenuCat') || 'A'; # admin menu (default)
|
|
|
|
|
}
|
|
|
|
|
next if $menu ne $menucat;
|
|
|
|
|
|
|
|
|
|
#--------------------------------------------------
|
|
|
|
|
# add heading, description and weight information to data structure
|
|
|
|
|
#--------------------------------------------------
|
|
|
|
|
|
|
|
|
|
unless (exists $nav {$heading})
|
|
|
|
|
{
|
|
|
|
|
$nav {$heading} = { COUNT => 0, WEIGHT => 0, DESCRIPTIONS => [] };
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$nav {$heading} {'COUNT'} ++;
|
|
|
|
|
$nav {$heading} {'WEIGHT'} += $headingWeight;
|
|
|
|
|
|
|
|
|
|
# Check for manager panel, and assign the appropriate
|
|
|
|
|
# cgi-bin prefix for the links.
|
|
|
|
|
# Grab the last 2 directories by splitting for '/'s and
|
|
|
|
|
# then concatenating the last 2
|
|
|
|
|
# probably a better way, but I don't know it.
|
|
|
|
|
|
|
|
|
|
my $path;
|
|
|
|
|
if ( $files_hash{$file} eq 'ctrl') {
|
|
|
|
|
$path = "2";
|
|
|
|
|
} elsif ( $files_hash{$file} eq 'cgim') {
|
|
|
|
|
$path = "/cgi-bin";
|
|
|
|
|
} else {
|
|
|
|
|
my @filename = split /\//, $files_hash{$file};
|
|
|
|
|
$path = "/$filename[scalar @filename - 2]/$filename[scalar @filename - 1]";
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
push @{ $nav {$heading} {'DESCRIPTIONS'} },
|
|
|
|
|
{ DESCRIPTION => $description,
|
|
|
|
|
WEIGHT => $descriptionWeight,
|
|
|
|
|
FILENAME => $urlpath ? $urlpath : "$path/$file",
|
|
|
|
|
CGIPATH => $path,
|
|
|
|
|
MENUCAT => $menucat
|
|
|
|
|
};
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return \%nav;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub _lang_space {
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
|
|
|
|
|
my $panel = $c->tx->req->url;
|
|
|
|
|
if ( $panel =~ m/\.css$|\.js$|\.jpg$|\.gif$|\.png$/ ) {
|
|
|
|
|
#warn "panel not treated $panel";
|
|
|
|
|
return
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
my $lang = ( $c->tx->req->headers->accept_language || ['en_US'] );
|
|
|
|
|
$lang = (split(/,/, $lang))[0];
|
|
|
|
|
# my $lang = (split(/,/, $c->tx->req->headers->accept_language))[0];
|
|
|
|
|
## convert xx_XX lang format to xx-xx + delete .UTFxx + lowercase
|
|
|
|
|
# $lang =~ s/_(.*)\..*$/-${1}/; # just keep 'en-us'
|
|
|
|
|
##$lang = lc( substr( $lang,0,2 ) ); # just keep 'en'
|
|
|
|
|
|
|
|
|
|
$panel = '/initial' if ($panel eq '/' or $panel eq '');
|
|
|
|
|
|
|
|
|
|
(my $module = $panel) =~ s|\?.*$||;
|
|
|
|
|
$module =~ s|^/||;
|
|
|
|
|
$module = ucfirst($module);
|
|
|
|
|
|
|
|
|
|
my $moduleLong = "SrvMngr::I18N::Modules::$module";
|
|
|
|
|
(my $dir = $moduleLong) =~ s|::|/|g;
|
|
|
|
|
my $I18Ndir = $c->app->home->rel_file('lib/') . '/' . $dir;
|
|
|
|
|
|
|
|
|
|
##$c->app->log->debug("$panel $module $moduleLong $I18Ndir");
|
|
|
|
|
if ( ! -d $I18Ndir ) {
|
|
|
|
|
( $moduleLong = $moduleLong) =~ s/.$//;
|
|
|
|
|
( $I18Ndir = $I18Ndir) =~ s/.$//;
|
|
|
|
|
}
|
|
|
|
|
if ( -d $I18Ndir ) {
|
|
|
|
|
## $c->app->log->debug("hook_b_r->panel route. lang: $lang namespace: $moduleLong ldir; $I18Ndir");
|
|
|
|
|
warn "NS already loaded: $moduleLong \n" if ( $c->i18ns() eq $moduleLong ); # i18ns changed
|
|
|
|
|
$c->i18ns( $moduleLong, $lang );
|
|
|
|
|
} else {
|
|
|
|
|
warn "Locale lexicon missing for $module \n";
|
|
|
|
|
}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_routes_list {
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
|
|
|
|
|
my $rtdb = esmith::ConfigDB->open_ro('routes') || die 'Cannot open Routes db';
|
|
|
|
|
my @routes = $rtdb->get_all();
|
|
|
|
|
my @rt;
|
|
|
|
|
|
|
|
|
|
for (@routes) {
|
|
|
|
|
my ( $contrib, $name ) = split ( /\+/, $_->key);
|
|
|
|
|
push @rt,
|
|
|
|
|
{ 'method' => $_->prop('Method'), 'url' => $_->prop('Url'),
|
|
|
|
|
'ctlact' => $_->prop('Ctlact'), 'menu' => $_->prop('Menu'),
|
|
|
|
|
'name' => $name, 'contrib' => $contrib,
|
|
|
|
|
};
|
|
|
|
|
}
|
|
|
|
|
return \@rt;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub ip_number {
|
|
|
|
|
|
|
|
|
|
# from CGI::FormMagick::Validator qw( ip_number );
|
|
|
|
|
|
|
|
|
|
my ($c, $data) = @_;
|
|
|
|
|
|
|
|
|
|
return undef unless defined $data;
|
|
|
|
|
|
|
|
|
|
return $c->l('FM_IP_NUMBER1') . " (" . $data . ")" unless $data =~ /^[\d.]+$/;
|
|
|
|
|
|
|
|
|
|
my @octets = split /\./, $data;
|
|
|
|
|
my $dots = ($data =~ tr/.//);
|
|
|
|
|
|
|
|
|
|
return $c->l('FM_IP_NUMBER2') unless (scalar @octets == 4 and $dots == 3);
|
|
|
|
|
|
|
|
|
|
foreach my $octet (@octets) {
|
|
|
|
|
return $c->l("FM_IP_NUMBER3", $octet) if $octet > 255;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 'OK';
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub is_normal_password {
|
|
|
|
|
|
|
|
|
|
# from CGI::FormMagick::Validator qw( password );
|
|
|
|
|
|
|
|
|
|
my ($c, $data) = @_;
|
|
|
|
|
$_ = $data;
|
|
|
|
|
if (not defined $_) {
|
|
|
|
|
return $c->l("FM_PASSWORD1");
|
|
|
|
|
} elsif (/\d/ and /[A-Z]/ and /[a-z]/ and /\W|_/ and length($_) > 6) {
|
|
|
|
|
return "OK";
|
|
|
|
|
} else {
|
|
|
|
|
return $c->l("FM_PASSWORD2");
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub email_simple {
|
|
|
|
|
my ($c, $data) = @_;
|
|
|
|
|
|
|
|
|
|
use Mail::RFC822::Address;
|
|
|
|
|
|
|
|
|
|
if (not defined $data ) {
|
|
|
|
|
return $c->l("FM_EMAIL_SIMPLE1");
|
|
|
|
|
} elsif (Mail::RFC822::Address::valid($data)) {
|
|
|
|
|
return "OK";
|
|
|
|
|
} else {
|
|
|
|
|
return $c->l("FM_EMAIL_SIMPLE2");
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub mac_address_or_blank {
|
|
|
|
|
my ($c, $data) = @_;
|
|
|
|
|
return "OK" unless $data;
|
|
|
|
|
return mac_address($c, $data);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub mac_address {
|
|
|
|
|
|
|
|
|
|
# from CGI::FormMagick::Validator::Network
|
|
|
|
|
|
|
|
|
|
my ($c, $data) = @_;
|
|
|
|
|
|
|
|
|
|
$_ = lc $data; # easier to match on $_
|
|
|
|
|
if (not defined $_) {
|
|
|
|
|
return $c->l('FM_MAC_ADDRESS1');
|
|
|
|
|
} elsif (/^([0-9a-f][0-9a-f](:[0-9a-f][0-9a-f]){5})$/) {
|
|
|
|
|
return "OK";
|
|
|
|
|
} else {
|
|
|
|
|
return $c->l('FM_MAC_ADDRESS2');
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub ip_number_or_blank {
|
|
|
|
|
|
|
|
|
|
# XXX - FIXME - we should push this down into CGI::FormMagick
|
|
|
|
|
|
|
|
|
|
my $c = shift;
|
|
|
|
|
my $ip = shift;
|
|
|
|
|
|
|
|
|
|
if (!defined($ip) || $ip eq "")
|
|
|
|
|
{
|
|
|
|
|
return 'OK';
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return ip_number( $c, $ip );
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub subnet_mask {
|
|
|
|
|
|
|
|
|
|
my ( $data ) = @_;
|
|
|
|
|
|
|
|
|
|
# we test for a valid mask or bit mask
|
|
|
|
|
my $tip="192.168.1.50";
|
|
|
|
|
my $block = new Net::Netmask("$tip/$data") or return "INV1 $data";
|
|
|
|
|
|
|
|
|
|
if ($block->mask() eq "$data" || $block->bits() eq "$data") {
|
|
|
|
|
return "OK";
|
|
|
|
|
}
|
|
|
|
|
return "INV2 $data";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_reg_mask {
|
|
|
|
|
|
|
|
|
|
my ( $address, $mask ) = @_;
|
|
|
|
|
|
|
|
|
|
# we transform bit mask to regular mask
|
|
|
|
|
my $block = new Net::Netmask("$address/$mask");
|
|
|
|
|
|
|
|
|
|
return $block->mask();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1;
|
