aboutsummaryrefslogtreecommitdiffstats
path: root/lib/AdminPanel/Shared
diff options
context:
space:
mode:
Diffstat (limited to 'lib/AdminPanel/Shared')
-rw-r--r--lib/AdminPanel/Shared/Firewall.pm35
-rw-r--r--lib/AdminPanel/Shared/GUI.pm1118
-rw-r--r--lib/AdminPanel/Shared/Hosts.pm216
-rw-r--r--lib/AdminPanel/Shared/JournalCtl.pm141
-rw-r--r--lib/AdminPanel/Shared/Locales.pm280
-rw-r--r--lib/AdminPanel/Shared/Proxy.pm36
-rw-r--r--lib/AdminPanel/Shared/RunProgram.pm352
-rw-r--r--lib/AdminPanel/Shared/Services.pm955
-rw-r--r--lib/AdminPanel/Shared/Shorewall.pm271
-rw-r--r--lib/AdminPanel/Shared/TimeZone.pm799
-rw-r--r--lib/AdminPanel/Shared/Users.pm1612
11 files changed, 0 insertions, 5815 deletions
diff --git a/lib/AdminPanel/Shared/Firewall.pm b/lib/AdminPanel/Shared/Firewall.pm
deleted file mode 100644
index f5a6c45c..00000000
--- a/lib/AdminPanel/Shared/Firewall.pm
+++ /dev/null
@@ -1,35 +0,0 @@
-# vim: set et ts=4 sw=4:
-#*****************************************************************************
-#
-# Copyright (c) 2013-2015 Matteo Pasotti <matteo.pasotti@gmail.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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 ManaTools::Shared::Firewall;
-
-use Moose;
-use diagnostics;
-use utf8;
-
-use lib qw(/usr/lib/libDrakX);
-use network::nfs;
-use network::network;
-use network::tools;
-
-sub _initialize {
- my $self = shift();
-}
-
-1;
diff --git a/lib/AdminPanel/Shared/GUI.pm b/lib/AdminPanel/Shared/GUI.pm
deleted file mode 100644
index 6c6144d5..00000000
--- a/lib/AdminPanel/Shared/GUI.pm
+++ /dev/null
@@ -1,1118 +0,0 @@
-# vim: set et ts=4 sw=4:
-package ManaTools::Shared::GUI;
-#============================================================= -*-perl-*-
-
-=head1 NAME
-
-Shared::GUI - Shared graphic routines
-
-=head1 SYNOPSIS
-
- my $gui = ManaTools::Shared::GUI->new();
- my $yesPressed = $gui->ask_YesOrNo($title, $text);
-
-=head1 DESCRIPTION
-
- This module contains a collection of dialogs or widgets that can be used in more
- graphics modules.
-
-=head1 EXPORT
-
-exported
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command:
-
-perldoc Shared::GUI
-
-
-=head1 AUTHOR
-
-Angelo Naselli <anaselli@linux.it>
-
-=head1 COPYRIGHT and LICENSE
-
-Copyright (C) 2014-2015, Angelo Naselli.
-Copyright (C) 2015, Matteo Pasotti <matteo.pasotti@gmail.com>.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License version 2, as
-published by the Free Software Foundation.
-
-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
-
-=head1 METHODS
-
-=cut
-
-
-use Moose;
-
-use diagnostics;
-use yui;
-
-use ManaTools::Shared qw(pathList2hash);
-
-use ManaTools::Shared::Locales;
-
-has 'loc' => (
- is => 'rw',
- init_arg => undef,
- builder => '_localeInitialize'
-);
-
-sub _localeInitialize {
- my $self = shift();
-
- # TODO fix domain binding for translation
- $self->loc(ManaTools::Shared::Locales->new(domain_name => 'libDrakX-standalone') );
- # TODO if we want to give the opportunity to test locally add dir_name => 'path'
-}
-
-
-#=============================================================
-
-=head2 warningMsgBox
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- text => string to be swhon into the dialog
- richtext => 1 if using rich text
-
-=head3 DESCRIPTION
-
- This function creates an Warning dialog and show the message
- passed as input.
-
-=cut
-
-#=============================================================
-sub warningMsgBox {
- my ($self, $info) = @_;
-
- return 0 if ( ! $info );
-
- my $retVal = 0;
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
- my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_ONE,
- $yui::YMGAMessageBox::D_WARNING);
-
- $dlg->setTitle($info->{title}) if (exists $info->{title});
- my $rt = (exists $info->{richtext}) ? $info->{richtext} : 0;
- $dlg->setText($info->{text}, $rt) if (exists $info->{text});
-
- $dlg->setButtonLabel($self->loc->N("Ok"), $yui::YMGAMessageBox::B_ONE );
-# $dlg->setMinSize(50, 5);
-
- $retVal = $dlg->show();
-
- $dlg = undef;
-
- return 1;
-}
-
-#=============================================================
-
-=head2 infoMsgBox
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- text => string to be swhon into the dialog
- richtext => 1 if using rich text
-
-=head3 DESCRIPTION
-
- This function creates an Info dialog and show the message
- passed as input.
-
-=cut
-
-#=============================================================
-
-sub infoMsgBox {
- my ($self, $info) = @_;
-
- return 0 if ( ! $info );
-
- my $retVal = 0;
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
- my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_ONE,
- $yui::YMGAMessageBox::D_INFO);
-
- $dlg->setTitle($info->{title}) if (exists $info->{title});
- my $rt = (exists $info->{richtext}) ? $info->{richtext} : 0;
- $dlg->setText($info->{text}, $rt) if (exists $info->{text});
-
- $dlg->setButtonLabel($self->loc->N("Ok"), $yui::YMGAMessageBox::B_ONE );
-# $dlg->setMinSize(50, 5);
-
- $retVal = $dlg->show();
-
- $dlg = undef;
-
- return 1;
-}
-
-#=============================================================
-
-=head2 msgBox
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- text => string to be swhon into the dialog
- richtext => 1 if using rich text
-
-=head3 DESCRIPTION
-
- This function creates a dialog and show the message passed as input.
-
-=cut
-
-#=============================================================
-
-sub msgBox {
- my ($self, $info) = @_;
-
- return 0 if ( ! $info );
-
- my $retVal = 0;
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
- my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_ONE);
-
- $dlg->setTitle($info->{title}) if (exists $info->{title});
- my $rt = (exists $info->{richtext}) ? $info->{richtext} : 0;
- $dlg->setText($info->{text}, $rt) if (exists $info->{text});
-
- $dlg->setButtonLabel($self->loc->N("Ok"), $yui::YMGAMessageBox::B_ONE );
-# $dlg->setMinSize(50, 5);
-
- $retVal = $dlg->show();
-
- $dlg = undef;
-
- return 1;
-}
-
-#=============================================================
-
-=head2 ask_OkCancel
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- text => string to be swhon into the dialog
- richtext => 1 if using rich text
-
-=head3 OUTPUT
-
- 0: Cancel button has been pressed
- 1: Ok button has been pressed
-
-=head3 DESCRIPTION
-
- This function create an OK-Cancel dialog with a 'title' and a
- 'text' passed as parameters.
-
-=cut
-
-#=============================================================
-
-sub ask_OkCancel {
- my ($self, $info) = @_;
-
- return 0 if ( ! $info );
-
- my $retVal = 0;
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
- my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_TWO);
-
- $dlg->setTitle($info->{title}) if (exists $info->{title});
- my $rt = (exists $info->{richtext}) ? $info->{richtext} : 0;
- $dlg->setText($info->{text}, $rt) if (exists $info->{text});
-
- $dlg->setButtonLabel($self->loc->N("Ok"), $yui::YMGAMessageBox::B_ONE );
- $dlg->setButtonLabel($self->loc->N("Cancel"), $yui::YMGAMessageBox::B_TWO);
- $dlg->setDefaultButton($yui::YMGAMessageBox::B_ONE);
- $dlg->setMinSize(50, 5);
-
- $retVal = $dlg->show() == $yui::YMGAMessageBox::B_ONE ? 1 : 0;
-
- $dlg = undef;
-
- return $retVal;
-}
-
-#=============================================================
-
-=head2 ask_YesOrNo
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- text => string to be swhon into the dialog
- richtext => 1 if using rich text
- default_button => (optional) 1: "Yes" (any other values "No")
-
-=head3 OUTPUT
-
- 0: "No" button has been pressed
- 1: "Yes" button has been pressed
-
-=head3 DESCRIPTION
-
- This function create a Yes-No dialog with a 'title' and a
- question 'text' passed as parameters.
-
-=cut
-
-#=============================================================
-
-sub ask_YesOrNo {
- my ($self, $info) = @_;
-
- return 0 if ( ! $info );
-
- my $retVal = 0;
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
- my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_TWO);
-
- $dlg->setTitle($info->{title}) if (exists $info->{title});
- my $rt = (exists $info->{richtext}) ? $info->{richtext} : 0;
- $dlg->setText($info->{text}, $rt) if (exists $info->{text});
-
- $dlg->setButtonLabel($self->loc->N("Yes"), $yui::YMGAMessageBox::B_ONE );
- $dlg->setButtonLabel($self->loc->N("No"), $yui::YMGAMessageBox::B_TWO);
- if (exists $info->{default_button} && $info->{default_button} == 1) {
- $dlg->setDefaultButton($yui::YMGAMessageBox::B_ONE);
- }
- else {
- $dlg->setDefaultButton($yui::YMGAMessageBox::B_TWO);
- }
- $dlg->setMinSize(50, 5);
-
- $retVal = $dlg->show() == $yui::YMGAMessageBox::B_ONE ? 1 : 0;
-
- $dlg = undef;
-
- return $retVal;
-}
-
-
-#=============================================================
-
-=head2 ask_TwoConfigurableButtons
-
-=head3 INPUT
-
-$info: HASH, information to be passed to the dialog.
- title => dialog title
- text => string to be swhon into the dialog
- richtext => 1 if using rich text
- button_one => caption for the first button
- button_two => caption for the second button
- default_button => (optional) 1: "First button"
-
-=head3 OUTPUT
-
- 0: "Button One Caption" button has been pressed
- 1: "Button Two Caption" button has been pressed
-
-=head3 DESCRIPTION
-
-This function create a two-buttons dialog with a 'title', a
-question 'text' and a label for each button passed as parameters.
-
-=cut
-
-#=============================================================
-
-sub ask_TwoConfigurableButtons {
- my ($self, $info) = @_;
-
- return 0 if ( ! $info );
-
- my $retVal = 0;
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
- my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_TWO);
-
- $dlg->setTitle($info->{title}) if (exists $info->{title});
- my $rt = (exists $info->{richtext}) ? $info->{richtext} : 0;
- $dlg->setText($info->{text}, $rt) if (exists $info->{text});
-
- $dlg->setButtonLabel($info->{button_one}, $yui::YMGAMessageBox::B_ONE );
- $dlg->setButtonLabel($info->{button_two}, $yui::YMGAMessageBox::B_TWO);
- if (exists $info->{default_button} && $info->{default_button} == 1) {
- $dlg->setDefaultButton($yui::YMGAMessageBox::B_ONE);
- }
- else {
- $dlg->setDefaultButton($yui::YMGAMessageBox::B_TWO);
- }
- $dlg->setMinSize(50, 5);
-
- $retVal = $dlg->show() == $yui::YMGAMessageBox::B_ONE ? 1 : 0;
-
- $dlg = undef;
-
- return $retVal;
-}
-
-#=============================================================
-
-=head2 arrayListToYItemCollection
-
-=head3 INPUT
-
- $listInfo: HASH reference containing
- default_item => Selected item (if any)
- item_list => ARRAY reference containing the item list
-
-=head3 OUTPUT
-
- $itemList: YItemCollection containing the item list passed
-
-=head3 DESCRIPTION
-
- This method returns a YItemCollection containing the item list passed with default item
- the "default_item"
-
-=cut
-
-#=============================================================
-
-sub arrayListToYItemCollection {
- my ($self, $listInfo) = @_;
-
- die "Item list is mandatory" if !($listInfo->{item_list});
- # TODO check type
- die "Not empty item list is mandatory" if (scalar @{$listInfo->{item_list}} < 1);
-
-
- my $itemColl = new yui::YItemCollection;
- foreach (@{$listInfo->{item_list}}) {
- my $item = new yui::YItem ($_, 0);
- $itemColl->push($item);
- $item->DISOWN();
- if ($listInfo->{default_item} && $listInfo->{default_item} eq $item->label()) {
- $item->setSelected(1);
- }
- }
-
- return $itemColl;
-}
-
-
-#=============================================================
-
-=head2 ask_fromList
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- header => combobox header
- default_item => selected item if any
- list => item list
- default_button => (optional) 1: Select (any other values Cancel)
-
-=head3 OUTPUT
-
- undef: if Cancel button has been pressed
- selected item: if Select button has been pressed
-
-=head3 DESCRIPTION
-
- This function create a dialog with a combobox in which to
- choose an item from a given list.
-
-=cut
-
-#=============================================================
-
-sub ask_fromList {
- my ($self, $info) = @_;
-
- die "Missing dialog information" if (!$info);
- die "Title is mandatory" if (! exists $info->{title});
- die "Header is mandatory" if (! exists $info->{header});
- die "List is mandatory" if (! exists $info->{list} );
- my $list = $info->{list};
- die "At least one element is mandatory into list" if (scalar(@$list) < 1);
-
- my $choice = undef;
- my $factory = yui::YUI::widgetFactory;
-
- ## push application title
- my $appTitle = yui::YUI::app()->applicationTitle();
- ## set new title to get it in dialog
- yui::YUI::app()->setApplicationTitle($info->{title});
-
- my $dlg = $factory->createPopupDialog($yui::YDialogNormalColor);
- my $layout = $factory->createVBox($dlg);
-
- my $combo = $factory->createComboBox($layout, $info->{header}, 0);
-
- my $listInfo;
- $listInfo->{default_item} = $info->{default_item} if $info->{default_item};
- $listInfo->{item_list} = $info->{list};
- my $itemColl = $self->arrayListToYItemCollection($listInfo);
- $combo->addItems($itemColl);
-
- my $align = $factory->createRight($layout);
- my $hbox = $factory->createHBox($align);
- my $selectButton = $factory->createPushButton($hbox, $self->loc->N("Select"));
- my $cancelButton = $factory->createPushButton($hbox, $self->loc->N("Cancel"));
-
- if (exists $info->{default_button} ) {
- my $dflBtn = ($info->{default_button} == 1) ? $selectButton : $cancelButton;
- $dlg->setDefaultButton($selectButton);
- }
-
- while (1) {
- my $event = $dlg->waitForEvent();
-
- my $eventType = $event->eventType();
- #event type checking
- if ($eventType == $yui::YEvent::CancelEvent) {
- last;
- }
- elsif ($eventType == $yui::YEvent::WidgetEvent) {
- # widget selected
- my $widget = $event->widget();
-
- if ($widget == $cancelButton) {
- last;
- }
- elsif ($widget == $selectButton) {
- my $item = $combo->selectedItem();
- $choice = $item->label() if ($item);
- last;
- }
- }
- }
-
- destroy $dlg;
-
- #restore old application title
- yui::YUI::app()->setApplicationTitle($appTitle);
-
- return $choice;
-}
-
-#=============================================================
-
-=head2 ask_multiple_fromList
-
-=head3 INPUT
-
-$info: HASH, information to be passed to the dialog.
- title => dialog title
- header => combobox header
- default_item => selected item if any
- list => item list
- default_button => (optional) 1: Select (any other values Cancel)
-
-=head3 LIST
-
-list is an array of hashes like this
-
- {
- id => unique identifier for this particular item,
- text => "descriptive text"
- val => reference to the boolean value
- }
-
-
-=head3 OUTPUT
-
- undef: if Cancel button has been pressed
- selected items: ArrayRef of the selected ids, if Select button has been pressed
-
-=head3 DESCRIPTION
-
-This function create a dialog with variable checkboxes in which to
-choose the items from a given list.
-
-Warning: to use only for a reduced set of items because of no scroll available
-
-=cut
-
-#=============================================================
-
-sub ask_multiple_fromList {
- my ($self, $info) = @_;
-
- die "Missing dialog information" if (!$info);
- die "Title is mandatory" if (! exists $info->{title});
- die "Header is mandatory" if (! exists $info->{header});
- die "List is mandatory" if (! exists $info->{list} );
- die "At least one element is mandatory into list" if (scalar(@{$info->{list}}) < 1);
-
- my $selections = [];
- my $factory = yui::YUI::widgetFactory;
-
- ## push application title
- my $appTitle = yui::YUI::app()->applicationTitle();
- ## set new title to get it in dialog
- yui::YUI::app()->setApplicationTitle($info->{title});
-
- my $dlg = $factory->createPopupDialog($yui::YDialogNormalColor);
- my $layout = $factory->createVBox($dlg);
-
- my @ckbox_array = ();
-
- for my $item(@{$info->{list}})
- {
- my $ckbox = $factory->createCheckBox(
- $factory->createLeft($factory->createHBox($layout)),
- $item->{text},
- ${$item->{val}}
- );
- $ckbox->setNotify(1);
- push @ckbox_array, {
- id => $item->{id},
- widget => \$ckbox,
- };
- $ckbox->DISOWN();
- }
-
- my $align = $factory->createRight($layout);
- my $hbox = $factory->createHBox($align);
- my $selectButton = $factory->createPushButton($hbox, $self->loc->N("Select"));
- my $cancelButton = $factory->createPushButton($hbox, $self->loc->N("Cancel"));
-
- if (exists $info->{default_button} ) {
- my $dflBtn = ($info->{default_button} == 1) ? $selectButton : $cancelButton;
- $dlg->setDefaultButton($selectButton);
- }
-
- while (1) {
- my $event = $dlg->waitForEvent();
-
- my $eventType = $event->eventType();
- #event type checking
- if ($eventType == $yui::YEvent::CancelEvent) {
- last;
- }
- elsif ($eventType == $yui::YEvent::WidgetEvent) {
- # widget selected
- my $widget = $event->widget();
-
- if ($widget == $cancelButton) {
- $selections = undef;
- last;
- }
- elsif ($widget == $selectButton) {
- foreach my $ckbox (@ckbox_array)
- {
- if(${$ckbox->{widget}}->value())
- {
- # yui::YUI::ui()->blockEvents();
- push @{$selections}, $ckbox->{id};
- # yui::YUI::ui()->unblockEvents();
- }
- }
- last;
- }
- }
- }
-
- destroy $dlg;
-
- #restore old application title
- yui::YUI::app()->setApplicationTitle($appTitle);
-
- return $selections;
-}
-
-#=============================================================
-
-=head2 AboutDialog
-
-=head3 INPUT
-
- $info: HASH containing optional information needed to get info for dialog.
- name => the application name
- version => the application version
- license => the application license, the short length one (e.g. GPLv2, GPLv3, LGPLv2+, etc)
- authors => the string providing the list of authors; it could be html-formatted
- description => the string providing a brief description of the application
- logo => the string providing the file path for the application logo (high-res image)
- icon => the string providing the file path for the application icon (low-res image)
- credits => the application credits, they can be html-formatted
- information => other extra informations, they can be html-formatted
- dialog_mode => 1: classic style dialog, any other as tabbed style dialog
-
-=head3 DESCRIPTION
-
- About dialog implementation, this dialog can be used by
- modules, to show authors, license, credits, etc.
-
-=cut
-
-#=============================================================
-
-sub AboutDialog {
- my ($self, $info) = @_;
-
- die "Missing dialog information" if (!$info);
-
-
- yui::YUI::widgetFactory;
- my $factory = yui::YExternalWidgets::externalWidgetFactory("mga");
- $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory);
-
- my $name = (exists $info->{name}) ? $info->{name} : "";
- my $version = (exists $info->{version}) ? $info->{version} : "";
- my $license = (exists $info->{license}) ? $info->{license} : "";
- my $authors = (exists $info->{authors}) ? $info->{authors} : "";
- my $description = (exists $info->{description}) ? $info->{description} : "";
- my $logo = (exists $info->{logo}) ? $info->{logo} : "";
- my $icon = (exists $info->{icon}) ? $info->{icon} : "";
- my $credits = (exists $info->{credits}) ? $info->{credits} : "";
- my $information = (exists $info->{information}) ? $info->{information} : "";
- my $dialog_mode = $yui::YMGAAboutDialog::TABBED;
- if (exists $info->{dialog_mode}) {
- $dialog_mode = $yui::YMGAAboutDialog::CLASSIC if ($info->{dialog_mode} == 1);
- }
-
- my $dlg = $factory->createAboutDialog($name, $version, $license,
- $authors, $description, $logo,
- $icon, $credits, $information
- );
-
- $dlg->show($dialog_mode);
-
- $dlg = undef;
-
- return 1;
-}
-
-#=============================================================
-
-=head2 hashTreeToYItemCollection
-
-=head3 INPUT
-
- $treeInfo: HASH reference containing
- parent ==> YItem parent (if not root object)
- collection ==> YItemCollection (mandatory)
- default_item ==> Selected item (if any)
- default_item_separator ==> If default item is passed and is a path like string
- the separator is needed to match the selected item, using
- the full pathname instead leaf (e.g. root/subroot/leaf).
- Default separator is also needed if '$treeInfo->{icons} entry is passed
- to match the right icon to set (e.g. using the full pathname).
- hash_tree ==> HASH reference containing the path tree representation
- icons ==> HASH reference containing item icons e.g.
- {
- root => 'root_icon_pathname',
- root/subroot => 'root_subroot_icon_pathname',
- ....
- }
- Do not add it if no icons are wanted.
- default_icon ==> icon pathname to a default icon for all the items that are
- not into $treeInfo->{icons} or if $treeInfo->{icons} is not
- defined. Leave undef if no default icon is wanted
-
-=head3 DESCRIPTION
-
- This function add to the given $treeInfo->{collection} new tree items from
- the the given $treeInfo->{hash_tree}
-
-=cut
-
-#=============================================================
-
-sub hashTreeToYItemCollection {
- my ($self, $treeInfo) = @_;
-
- die "Collection is mandatory" if !($treeInfo->{collection});
- die "Hash tree is mandatory" if !($treeInfo->{hash_tree});
-
- my $treeLine = $treeInfo->{parent};
- my $item;
- foreach my $key (sort keys %{$treeInfo->{hash_tree}}) {
- if ($treeInfo->{parent}) {
- $item = new yui::YTreeItem ($treeLine, $key);
- $item->DISOWN();
- }
- else {
- if ($treeLine) {
- if ( $treeLine->label() eq $key) {
- $item = $treeLine;
- }
- else {
- $treeInfo->{collection}->push($treeLine);
- $item = $treeLine = new yui::YTreeItem ($key);
- $item->DISOWN();
- }
- }
- else {
- $item = $treeLine = new yui::YTreeItem ($key);
- $item->DISOWN();
- }
- }
-
- # building full path name
- my $label = $key;
- if (exists $treeInfo->{default_item_separator}) {
- my $parent = $item;
- while($parent = $parent->parent()) {
- $label = $parent->label() . $treeInfo->{default_item_separator} . $label ;
- }
- }
- my $icon = undef;
- $icon = $treeInfo->{default_icon} if defined($treeInfo->{default_icon});
- $icon = $treeInfo->{icons}->{$label} if defined($treeInfo->{icons}) && defined($treeInfo->{icons}->{$label});
-
- $item->setIconName($icon) if $icon;
-
- ### select item
- if ($treeInfo->{default_item}) {
- if ($treeInfo->{default_item} eq $label) {
- $item->setSelected(1) ;
- $item->setOpen(1);
- my $parent = $item;
- while($parent = $parent->parent()) {
- $parent->setOpen(1);
- }
- }
- }
-
- if ($treeInfo->{hash_tree}->{$key} && keys %{$treeInfo->{hash_tree}->{$key}}) {
- my %tf;
- $tf{collection} = $treeInfo->{collection};
- $tf{parent} = $item;
- $tf{default_item} = $treeInfo->{default_item} if $treeInfo->{default_item};
- $tf{default_item_separator} = $treeInfo->{default_item_separator} if $treeInfo->{default_item_separator};
- $tf{hash_tree} = $treeInfo->{hash_tree}->{$key};
- $tf{icons} = $treeInfo->{icons};
- $self->hashTreeToYItemCollection(\%tf);
- }
- else {
- if (! $treeInfo->{parent}) {
- $treeInfo->{collection}->push($treeLine);
- $treeLine = undef;
- }
- }
- }
- if (! $treeInfo->{parent}) {
- $treeInfo->{collection}->push($treeLine) if $treeLine;
- }
-}
-
-
-#=============================================================
-
-=head2 ask_fromTreeList
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- header => TreeView header
- list => path item list
- min_size => minimum dialog size in the libYUI meaning
- HASH {width => w, height => h}
- default_item => selected item if any
- item_separator => item separator default "/"
- skip_path => if set item is returned without its original path,
- just as a leaf (default use full path)
- any_item_selection => allow to select any item, not just leaves (default just leaves)
- default_button => (optional) 1: Select (any other values Cancel)
-
-=head3 OUTPUT
-
- undef: if Cancel button has been pressed
- selected item: if Select button has been pressed
-
-=head3 DESCRIPTION
-
- This function create a dialog with a combobox in which to
- choose an item from a given list.
-
-=cut
-
-#=============================================================
-
-sub ask_fromTreeList {
- my ($self, $info) = @_;
-
- die "Missing dialog information" if (!$info);
- die "Title is mandatory" if (! exists $info->{title});
- die "Header is mandatory" if (! exists $info->{header});
- die "List is mandatory" if (! exists $info->{list} );
- my $list = $info->{list};
- die "At least one element is mandatory into list" if (scalar(@$list) < 1);
-
- my $choice = undef;
- my $factory = yui::YUI::widgetFactory;
-
- ## push application title
- my $appTitle = yui::YUI::app()->applicationTitle();
- ## set new title to get it in dialog
- yui::YUI::app()->setApplicationTitle($info->{title});
- my $minWidth = 80;
- my $minHeight = 25;
-
- if (exists $info->{min_size}) {
- $minWidth = $info->{min_size}->{width} if $info->{min_size}->{width};
- $minHeight = $info->{min_size}->{height} if $info->{min_size}->{height};
- }
-
- my $dlg = $factory->createPopupDialog($yui::YDialogNormalColor);
- my $minSize = $factory->createMinSize( $dlg, $minWidth, $minHeight );
- my $layout = $factory->createVBox($minSize);
-
- my $treeWidget = $factory->createTree($layout, $info->{header});
-
- my $treeInfo;
- $treeInfo->{collection} = new yui::YItemCollection;
- $treeInfo->{default_item} = $info->{default_item} if $info->{default_item};
- if ($treeInfo->{default_item} && $info->{item_separator}) {
- if (index($treeInfo->{default_item}, $info->{item_separator}) != -1) {
- $treeInfo->{default_item_separator} = $info->{item_separator};
- }
- }
- my $list2Convert;
- $list2Convert->{paths} = $info->{list};
- $list2Convert->{separator} = $info->{item_separator} if $info->{item_separator};
- $treeInfo->{hash_tree} = ManaTools::Shared::pathList2hash($list2Convert);
-
- $self->hashTreeToYItemCollection($treeInfo);
- $treeWidget->addItems($treeInfo->{collection});
-
- my $align = $factory->createRight($layout);
- my $hbox = $factory->createHBox($align);
- my $selectButton = $factory->createPushButton($hbox, $self->loc->N("Select"));
- my $cancelButton = $factory->createPushButton($hbox, $self->loc->N("Cancel"));
-
- if (exists $info->{default_button} ) {
- my $dflBtn = ($info->{default_button} == 1) ? $selectButton : $cancelButton;
- $dlg->setDefaultButton($selectButton);
- }
-
- while (1) {
- my $event = $dlg->waitForEvent();
-
- my $eventType = $event->eventType();
- #event type checking
- if ($eventType == $yui::YEvent::CancelEvent) {
- last;
- }
- elsif ($eventType == $yui::YEvent::WidgetEvent) {
- # widget selected
- my $widget = $event->widget();
-
- if ($widget == $cancelButton) {
- last;
- }
- elsif ($widget == $selectButton) {
- my $item = $treeWidget->selectedItem();
- my $getChoice = 1;
- if (!exists $info->{any_item_selection} || $info->{any_item_selection} != 0) {
- if ($item) {
- $getChoice = (!$item->hasChildren());
- }
- }
- if ($info->{skip_path} && $info->{skip_path} != 0) {
- $choice = $item->label() if ($item && $getChoice);
- }
- else {
- if ($getChoice) {
- my $separator = exists $info->{item_separator} ? $info->{item_separator} : '/';
- if ($item) {
- $choice = $item->label();
- my $parent = $item;
- while($parent = $parent->parent()) {
- $choice = $parent->label() . $separator . $choice ;
- }
- }
- }
- }
-
- last;
- }
- }
- }
-
- destroy $dlg;
-
- #restore old application title
- yui::YUI::app()->setApplicationTitle($appTitle);
-
- return $choice;
-}
-
-
-#=============================================================
-
-=head2 select_fromList
-
-=head3 INPUT
-
- $info: HASH, information to be passed to the dialog.
- title => dialog title
- info_label => optional info text
- header => column header hash reference{
- text_column => text column header
- check_column =>
- }
- list => item list hash reference
- containing {
- text => item text
- selected => 0 ur undefined means unchecked
- }
-
-=head3 OUTPUT
-
- selection: list of selected items
-
-=head3 DESCRIPTION
-
- This function create a dialog cotaining a table with a list of
- items to be checked. The list of the checked items is returned.
-
-=cut
-
-#=============================================================
-
-sub select_fromList {
- my ($self, $info) = @_;
-
- die "Missing dialog information" if (!$info);
- die "Title is mandatory" if (! exists $info->{title});
- die "Header is mandatory" if (! exists $info->{header});
- die "Header text column is mandatory" if (! $info->{header}->{text_column});
- die "List is mandatory" if (! exists $info->{list} );
- my $list = $info->{list};
- die "At least one element is mandatory into list" if (scalar(@$list) < 1);
-
- my $selection = [];
-
- my $mageiaPlugin = "mga";
- my $factory = yui::YUI::widgetFactory;
- my $mgaFactory = yui::YExternalWidgets::externalWidgetFactory($mageiaPlugin);
- $mgaFactory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($mgaFactory);
-
- ## push application title
- my $appTitle = yui::YUI::app()->applicationTitle();
- ## set new title to get it in dialog
- yui::YUI::app()->setApplicationTitle($info->{title});
-
- my $dlg = $factory->createPopupDialog($yui::YDialogNormalColor);
- my $layout = $factory->createVBox($dlg);
-
- if ($info->{info_label}) {
- $factory->createLabel($layout, $info->{info_label});
- }
-
- my $yTableHeader = new yui::YTableHeader();
- $yTableHeader->addColumn($info->{header}->{text_column}, $yui::YAlignBegin);
- $yTableHeader->addColumn($info->{header}->{check_column} || '', $yui::YAlignBegin);
-
- ## service list (serviceBox)
- my $selectionTable = $mgaFactory->createCBTable(
- $layout,
- $yTableHeader,
- $yui::YCBTableCheckBoxOnLastColumn
- );
- $selectionTable->setImmediateMode(1);
- $selectionTable->setWeight($yui::YD_HORIZ, 75);
-
- $selectionTable->startMultipleChanges();
- $selectionTable->deleteAllItems();
- my $itemCollection = new yui::YItemCollection;
- ## NOTE do not sort to preserve item indexes
- foreach (@{$list}) {
- my $text = $_->{text} || die "item text is mandatory";
-
- my $item = new yui::YCBTableItem($text);
- $item->check( $_->{checked} );
- $itemCollection->push($item);
- $item->DISOWN();
- }
- $selectionTable->addItems($itemCollection);
- $selectionTable->doneMultipleChanges();
-
- my $align = $factory->createRight($layout);
- my $hbox = $factory->createHBox($align);
- $factory->createVSpacing($hbox, 1.0);
- my $okButton = $factory->createPushButton($hbox, $self->loc->N("Ok"));
- $dlg->setDefaultButton($okButton);
- $dlg->recalcLayout();
-
- while (1) {
- my $event = $dlg->waitForEvent();
-
- my $eventType = $event->eventType();
- #event type checking
- if ($eventType == $yui::YEvent::CancelEvent) {
- last;
- }
- elsif ($eventType == $yui::YEvent::WidgetEvent) {
- # widget selected
- my $widget = $event->widget();
-
- if ($widget == $okButton) {
- last;
- }
- elsif ($widget == $selectionTable) {
- my $wEvent = yui::toYWidgetEvent($event);
- if ($wEvent->reason() == $yui::YEvent::ValueChanged) {
- my $item = $selectionTable->changedItem();
- if ($item) {
- my $index = $item->index();
- $list->[$index]->{checked} = $item->checked();
- }
- }
- }
- }
- }
-
- destroy $dlg;
-
- #restore old application title
- yui::YUI::app()->setApplicationTitle($appTitle);
-
- foreach (@{$list}) {
- push @{$selection}, $_->{text} if $_->{checked};
- }
-
- return $selection;
-}
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-
-1;
-
diff --git a/lib/AdminPanel/Shared/Hosts.pm b/lib/AdminPanel/Shared/Hosts.pm
deleted file mode 100644
index d3b7fc9c..00000000
--- a/lib/AdminPanel/Shared/Hosts.pm
+++ /dev/null
@@ -1,216 +0,0 @@
-# vim: set et ts=4 sw=4:
-#*****************************************************************************
-#
-# Copyright (c) 2013-2015 Matteo Pasotti <matteo.pasotti@gmail.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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 ManaTools::Shared::Hosts;
-
-use Moose;
-use diagnostics;
-use Config::Hosts;
-use Net::DBus;
-use utf8;
-
-# costants by Config::Hosts
-my $is_ip = 1;
-my $is_host = -1;
-my $is_none = 0;
-
-has 'configHosts' => (
- is => 'rw',
- init_arg => undef,
- builder => '_initialize'
-);
-
-has 'dbusConnectionParams' => (
- is => 'ro',
- isa => 'HashRef',
- builder => '_initDBusConnectionParams',
-);
-
-sub _initialize {
- my $self = shift();
- $self->configHosts(Config::Hosts->new());
-}
-
-sub _initDBusConnectionParams {
- my $self = shift();
- my %dbusConnParams = ( 'servicePath' => 'org.freedesktop.hostname1', 'objectPath' => '/org/freedesktop/hostname1' );
- return \%dbusConnParams;
-}
-
-=pod
-
-=head2 _getHosts
-
-=head3 OUTPUT
-
- @result: array of hashes; each one of them represent a host definition from the hosts configuration file
-
- NOTE: the 'hosts' item into each hash is an array: it contains the hostname and -eventually- the aliases
-
-=head3 DESCRIPTION
-
-retrieve data from the hosts file (/etc/hosts) using the Config::Hosts module
-
-=cut
-
-sub _getHosts {
- my $self = shift();
- # $self->configHosts(Config::Hosts->new());
- my $hosts = $self->configHosts->read_hosts();
- my @result = ();
- while( my ($key, $value) = each(%{$hosts})){
- if($self->configHosts->determine_ip_or_host($key) == $is_ip){
- my $tmp = {};
- $tmp = $self->configHosts->query_host($key);
- $tmp->{'ip'} = $key;
- push @result,$tmp;
- }
- }
- return @result;
-}
-
-sub _insertHost {
- my $self = shift();
- # remember that the order matters!
- my $ip = shift();
- my @host_definitions = @_;
- # $self->configHosts = Config::Hosts->new();
- return $self->configHosts->insert_host(ip => $ip, hosts => @host_definitions);
-}
-
-sub _dropHost {
- my $self = shift();
- my $host_ip = shift();
- return $self->configHosts->delete_host($host_ip);
-}
-
-sub _modifyHost {
- my $self = shift();
- my $host_ip = shift();
- my @host_definitions = @_;
- return $self->configHosts->update_host($host_ip, hosts => @host_definitions);
-}
-
-sub _writeHosts {
- my $self = shift();
- return $self->configHosts->write_hosts();
-}
-
-sub _dbus_connection {
- my $self = shift();
- my %params = %{$self->dbusConnectionParams()};
- my $bus = Net::DBus->system;
- my $service = $bus->get_service($params{'servicePath'});
- my $object = $service->get_object($params{'objectPath'});
- return $object;
-}
-
-sub _dbus_inquiry {
- my $self = shift();
- my $required_field = shift();
- my $object = $self->_dbus_connection();
- my %params = %{$self->dbusConnectionParams()};
- my $properties = $object->GetAll($params{'servicePath'});
- return $properties->{$required_field} if(defined($properties->{$required_field}));
- return 0;
-}
-
-sub _dbus_setup {
- my $self = shift();
- my $attribute = shift();
- my $value = shift();
- my $object = $self->_dbus_connection();
- if($attribute eq "Hostname")
- {
- $object->SetHostname($value,1);
- }
- elsif($attribute eq "PrettyHostname")
- {
- $object->SetPrettyHostname($value,1);
- }
- elsif($attribute eq "StaticHostname")
- {
- $object->SetStaticHostname($value,1);
- }
- elsif($attribute eq "Chassis")
- {
- $object->SetChassis($value,1);
- }
- elsif($attribute eq "IconName")
- {
- $object->SetIconName($value,1);
- }
-}
-
-sub _getLocalHostName {
- my $self = shift();
- return $self->_dbus_inquiry('Hostname');
-}
-
-sub _getLocalPrettyHostName {
- my $self = shift();
- return $self->_dbus_inquiry('PrettyHostname');
-}
-
-sub _getLocalStaticHostName {
- my $self = shift();
- return $self->_dbus_inquiry('StaticHostname');
-}
-
-sub _getLocalChassis {
- my $self = shift();
- return $self->_dbus_inquiry('Chassis');
-}
-
-sub _getLocalIconName {
- my $self = shift();
- return $self->_dbus_inquiry('IconName');
-}
-
-sub _setLocalHostName {
- my $self = shift();
- my $hostname = shift();
- $self->_dbus_setup('Hostname',$hostname);
-}
-
-sub _setLocalPrettyHostName {
- my $self = shift();
- my $value = shift();
- $self->_dbus_setup('PrettyHostname',$value);
-}
-
-sub _setLocalStaticHostName {
- my $self = shift();
- my $value = shift();
- $self->_dbus_setup('StaticHostname',$value);
-}
-
-sub _setLocalIconName {
- my $self = shift();
- my $value = shift();
- $self->_dbus_setup('IconName',$value);
-}
-
-sub _setLocalChassis {
- my $self = shift();
- my $value = shift();
- $self->_dbus_setup('Chassis',$value);
-}
-
-1;
diff --git a/lib/AdminPanel/Shared/JournalCtl.pm b/lib/AdminPanel/Shared/JournalCtl.pm
deleted file mode 100644
index 11945384..00000000
--- a/lib/AdminPanel/Shared/JournalCtl.pm
+++ /dev/null
@@ -1,141 +0,0 @@
-# vim: set et ts=4 sw=4:
-package ManaTools::Shared::JournalCtl;
-
-#============================================================= -*-perl-*-
-
-=head1 NAME
-
-ManaTools::Shared::JournalCtl - journalctl perl wrapper
-
-=head1 SYNOPSIS
-
- my $log = ManaTools::Shared::JournalCtl->new();
- my @log_content = $log->getLog();
-
-=head1 DESCRIPTION
-
-This module wraps journalctl allowing some running options and provides the
-output log content.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command:
-
-perldoc ManaTools::Shared::JournalCtl
-
-
-=head1 AUTHOR
-
-Angelo Naselli <anaselli@linux.it>
-
-=head1 COPYRIGHT and LICENSE
-
-Copyright (C) 2014-2015, Angelo Naselli.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License version 2, as
-published by the Free Software Foundation.
-
-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.
-
-=head1 METHODS
-
-=cut
-
-use Moose;
-
-use diagnostics;
-
-
-has 'this_boot' => (
- is => 'rw',
- isa => 'Int',
- default => 0,
-);
-
-has 'since' => (
- is => 'rw',
- isa => 'Str',
- default => "",
-);
-
-has 'until' => (
- is => 'rw',
- isa => 'Str',
- default => "",
-);
-
-has 'priority' => (
- is => 'rw',
- isa => 'Str',
- default => "",
-);
-
-has 'unit' => (
- is => 'rw',
- isa => 'Str',
- default => "",
-);
-
-#=============================================================
-
-=head2 getLog
-
-=head3 INPUT
-
-Input_Parameter: in_par_description
-
-=head3 OUTPUT
-
-\@content: ARRAYREF containing the log content.
-
-=head3 DESCRIPTION
-
-This methods gets the log using the provided options
-
-=cut
-
-#=============================================================
-
-sub getLog {
- my $self = shift;
-
- my $params = "--no-pager -q";
- if ($self->this_boot == 1) {
- $params .= " -b";
- }
- if ($self->since ne "") {
- $params .= " --since=" . '"' . $self->since . '"';
- }
- if ($self->until ne "") {
- $params .= " --until=" . '"' . $self->until .'"';
- }
- if ($self->unit ne "") {
- $params .= " --unit=" . $self->unit;
- }
- if ($self->priority ne "") {
- $params .= " --priority=" . $self->priority;
- }
-
- $ENV{'PATH'} = '/usr/sbin:/usr/bin';
- my $jctl = "/usr/bin/journalctl " . $params;
-
- # TODO remove or add to log
- print " Running " . $jctl . "\n";
- my @content = `$jctl`;
-
- return \@content;
-}
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-
-1;
diff --git a/lib/AdminPanel/Shared/Locales.pm b/lib/AdminPanel/Shared/Locales.pm
deleted file mode 100644
index ec546141..00000000
--- a/lib/AdminPanel/Shared/Locales.pm
+++ /dev/null
@@ -1,280 +0,0 @@
-# vim: set et ts=4 sw=4:
-package ManaTools::Shared::Locales;
-#============================================================= -*-perl-*-
-
-=head1 NAME
-
-ManaTools::Shared::Locales - Class to manage locales
-
-=head1 SYNOPSIS
-
-use ManaTools::Shared::Locales;
-
-my $obj = ManaTools::Shared::Locales->new(domain_name => 'this_domain');
-
-print $obj->N("test string %d", 1) . "\n";
-
-=head1 DESCRIPTION
-
-This class wraps Locale::gettext to manage localization
-
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command:
-
-perldoc ManaTools::Shared::Locales
-
-=head1 SEE ALSO
-
-Locale::gettext Text::Iconv and gettext
-
-=head1 AUTHOR
-
-Angelo Naselli <anaselli@linux.it>
-
-=head1 COPYRIGHT and LICENSE
-
-Copyright (C) 2014-2015, Angelo Naselli.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License version 2, as
-published by the Free Software Foundation.
-
-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
-
-=head1 FUNCTIONS
-
-=cut
-
-
-use Moose;
-use diagnostics;
-use utf8;
-use Locale::gettext;
-use Text::Iconv;
-
-
-#=============================================================
-
-=head2 new
-
-=head3 INPUT
-
- hash ref containing
- domain_name: gettext domain name (default mpan)
- dir_name: gettext optional catalog directory (default undef)
- codeset: gettext codeset (default UTF8)
-
-=head3 DESCRIPTION
-
- new is inherited from Moose, to create a Locales object
-
-=cut
-
-#=============================================================
-
-has 'domain_name' => (
- is => 'rw',
- default => 'mpan',
-);
-
-has 'dir_name' => (
- is => 'rw',
- default => undef,
-);
-
-has 'codeset' => (
- is => 'rw',
- default => 'UTF8',
-);
-
-has 'domain' => (
- is => 'rw',
- init_arg => undef,
-);
-
-#=============================================================
-
-=head2 BUILD
-
-=head3 INPUT
-
- $self: this object
-
-=head3 DESCRIPTION
-
- The BUILD method is called after a Moose object is created.
- This method initilaizes gettext domain.
-
-=cut
-
-#=============================================================
-sub BUILD {
- my $self = shift;
-
- if ($^V ge v5.20.0) {
- require POSIX;
- POSIX::setlocale (POSIX::LC_ALL (), '');
- }
-
- $self->domain(Locale::gettext->domain_raw($self->domain_name));
- $self->domain->dir($self->dir_name) if $self->dir_name;
- $self->domain->codeset($self->codeset);
-}
-
-
-#=============================================================
-
-=head2 P
-
-=head3 INPUT
-
- $self : this object
- $s_singular: msg id singular
- $s_plural: msg id plural
- $nb: value for plural
-
-=head3 OUTPUT
-
- locale string
-
-=head3 DESCRIPTION
-
- returns the given string localized (see dngettext)
-
-=cut
-
-#=============================================================
-sub P {
- my ($self, $s_singular, $s_plural, $nb, @para) = @_;
-
- sprintf($self->domain->nget($s_singular, $s_plural, $nb), @para);
-}
-
-#=============================================================
-
-=head2 N
-
-=head3 INPUT
-
- $self : this object
- $s: msg id
-
-=head3 OUTPUT
-
- locale string
-
-=head3 DESCRIPTION
-
- returns the given string localized (see dgettext)
-
-=cut
-
-#=============================================================
-sub N {
- my ($self, $s, @para) = @_;
-
- sprintf($self->domain->get($s), @para);
-}
-
-#=============================================================
-
-=head2 N_
-
-=head3 INPUT
-
- $self : this object
- $s: msg id
-
-=head3 OUTPUT
-
- msg id
-
-=head3 DESCRIPTION
-
- returns the given string
-
-=cut
-
-#=============================================================
-sub N_ {
- my $self = shift;
-
- $_[0];
-}
-
-
-#=============================================================
-
-=head2 from_utf8
-
-=head3 INPUT
-
- $self: this object
- $s: string to be converted
-
-=head3 OUTPUT\
-
- $converted: converted string
-
-=head3 DESCRIPTION
-
- convert from utf-8 to current locale
-
-=cut
-
-#=============================================================
-sub from_utf8 {
- my ($self, $s) = @_;
-
- my $converter = Text::Iconv->new("utf-8", undef);
- my $converted = $converter->convert($s);
-
- return $converted;
-}
-
-
-#=============================================================
-
-=head2 to_utf8
-
-=head3 INPUT
-
- $self: this object
- $s: string to be converted
-
-=head3 OUTPUT\
-
- $converted: converted string
-
-=head3 DESCRIPTION
-
- convert to utf-8 from current locale
-
-=cut
-
-#=============================================================
-sub to_utf8 {
- my ($self, $s) = @_;
-
- my $converter = Text::Iconv->new(undef, "utf-8");
- my $converted = $converter->convert($s);
-
- return $converted;
-}
-
-
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-
-1;
diff --git a/lib/AdminPanel/Shared/Proxy.pm b/lib/AdminPanel/Shared/Proxy.pm
deleted file mode 100644
index 6accbb77..00000000
--- a/lib/AdminPanel/Shared/Proxy.pm
+++ /dev/null
@@ -1,36 +0,0 @@
-# vim: set et ts=4 sw=4:
-#*****************************************************************************
-#
-# Copyright (c) 2013-2015 Matteo Pasotti <matteo.pasotti@gmail.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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 ManaTools::Shared::Proxy;
-
-use Moose;
-use diagnostics;
-use utf8;
-
-has 'network' => (
- is => 'rw',
- init_arg => undef,
- builder => '_initialize'
-);
-
-sub _initialize {
- my $self = shift();
-}
-
-1;
diff --git a/lib/AdminPanel/Shared/RunProgram.pm b/lib/AdminPanel/Shared/RunProgram.pm
deleted file mode 100644
index 042f5594..00000000
--- a/lib/AdminPanel/Shared/RunProgram.pm
+++ /dev/null
@@ -1,352 +0,0 @@
-package ManaTools::Shared::RunProgram;
-
-use strict;
-use MDK::Common;
-use Sys::Syslog;
-use MDK::Common::File qw(cat_);
-
-use Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(
- set_default_timeout
- run_or_die
- rooted_or_die
- get_stdout
- get_stdout_raw
- rooted_get_stdout
- run
- raw
- rooted
-);
-
-=head1 SYNOPSYS
-
-B<rManaTools::Shared::RunProgram> enables to:
-
-=over 4
-
-=item * run programs in foreground or in background,
-
-=item * to retrieve their stdout or stderr
-
-=item * ...
-
-=back
-
-Most functions exits in a normal form & a rooted one. e.g.:
-
-=over 4
-
-=item * C<run()> & C<rooted()>
-
-=item * C<get_stdout()> & C<rooted_get_stdout()>
-
-=back
-
-Most functions exits in a normal form & one that die. e.g.:
-
-=over 4
-
-=item * C<run()> & C<run_or_die()>
-
-=item * C<rooted()> & C<rooted_or_die()>
-
-=back
-
-=head1 Functions
-
-=over
-
-=cut
-
-1;
-
-my $default_timeout = 10 * 60;
-
-=item set_default_timeout($seconds)
-
-Alters defaults timeout (eg for harddrake service)
-
-=cut
-
-sub set_default_timeout {
- my ($seconds) = @_;
- $default_timeout = $seconds;
-}
-
-=item run_or_die($name, @args)
-
-Runs $name with @args parameterXs. Dies if it exit code is not 0.
-
-=cut
-
-sub run_or_die {
- my ($name, @args) = @_;
- run($name, @args) or die "$name failed\n";
-}
-
-=item rooted_or_die($root, $name, @args)
-
-Similar to run_or_die() but runs in chroot in $root
-
-=cut
-
-sub rooted_or_die {
- my ($root, $name, @args) = @_;
- rooted($root, $name, @args) or die "$name failed\n";
-}
-
-=item get_stdout($name, @args)
-
-Similar to run_or_die() but return stdout of program:
-
-=over 4
-
-=item * a list of lines in list context
-
-=item * a string of concatenated lines in scalar context
-
-=back
-
-=cut
-
-sub get_stdout {
- my ($name, @args) = @_;
- my @r;
- run($name, '>', \@r, @args) or return;
- wantarray() ? @r : join('', @r);
-}
-
-=item get_stdout_raw($options, $name, @args)
-
-Similar to get_stdout() but allow to pass options to raw()
-
-=cut
-
-sub get_stdout_raw {
- my ($options, $name, @args) = @_;
- my @r;
- raw($options, $name, '>', \@r, @args) or return;
- wantarray() ? @r : join('', @r);
-}
-
-=item rooted_get_stdout($root, $name, @args)
-
-Similar to get_stdout() but runs in chroot in $root
-
-=cut
-
-sub rooted_get_stdout {
- my ($root, $name, @args) = @_;
- my @r;
- rooted($root, $name, '>', \@r, @args) or return;
- wantarray() ? @r : join('', @r);
-}
-
-=item run($name, @args)
-
-Runs $name with @args parameters.
-
-=cut
-
-sub run {
- raw({}, @_);
-}
-
-=item rooted($root, $name, @args)
-
-Similar to run() but runs in chroot in $root
-
-=cut
-
-sub rooted {
- my ($root, $name, @args) = @_;
- raw({ root => $root }, $name, @args);
-}
-
-=item raw($options, $name, @args)
-
-The function used by all the other, making every combination possible.
-Runs $name with @args parameters. $options is a hash ref that can contains:
-
-=over 4
-
-=item * B<root>: $name will be chrooted in $root prior to run
-
-=item * B<as_user>: $name will be run as $ENV{USERHELPER_UID} or with the UID of parent process. Implies I<setuid>
-
-=item * B<sensitive_arguments>: parameters will be hidden in logs (b/c eg there's a password)
-
-=item * B<detach>: $name will be run in the background. Default is foreground
-
-=item * B<chdir>: $name will be run in a different default directory
-
-=item * B<setuid>: contains a getpwnam(3) struct ; $name will be with droped privileges ;
-make sure environment is set right and keep a copy of the X11 cookie
-
-=item * B<timeout>: execution of $name will be aborted after C<timeout> seconds
-
-=back
-
-eg:
-
-=over 4
-
-=item * C<< ManaTools::Shared::RunProgram::raw({ root => $::prefix, sensitive_arguments => 1 }, "echo -e $user->{password} | cryptsetup luksFormat $device"); >>
-
-=item * C<< ManaTools::Shared::RunProgram::raw({ detach => 1 }, '/etc/rc.d/init.d/dm', '>', '/dev/null', '2>', '/dev/null', 'restart'); >>
-
-=back
-
-=cut
-
-sub raw {
- my ($options, $name, @args) = @_;
- my $root = $options->{root} || '';
- my $real_name = ref($name) ? $name->[0] : $name;
-
- my ($stdout_raw, $stdout_mode, $stderr_raw, $stderr_mode);
- ($stdout_mode, $stdout_raw, @args) = @args if $args[0] =~ /^>>?$/;
- ($stderr_mode, $stderr_raw, @args) = @args if $args[0] =~ /^2>>?$/;
-
- my $home;
- if ($options->{as_user}) {
- my $uid;
- $uid = $ENV{USERHELPER_UID} && getpwuid($ENV{USERHELPER_UID});
- $uid ||= _get_parent_uid();
- $options->{setuid} = getpwnam($uid) if $uid;
- my ($full_user) = grep { $_->[2] eq $uid } list_passwd();
- $home = $full_user->[7] if $full_user;
- }
- local $ENV{HOME} = $home if $home;
-
- my $args = $options->{sensitive_arguments} ? '<hidden arguments>' : join(' ', @args);
- Sys::Syslog::syslog('info|local1', "running: $real_name $args" . ($root ? " with root $root" : ""));
-
- return if $root && $<;
-
- $root ? ($root .= '/') : ($root = '');
-
- my $tmpdir = sub {
- my $dir = $< != 0 ? "$ENV{HOME}/tmp" : -d '/root' ? '/root/tmp' : '/tmp';
- -d $dir or mkdir($dir, 0700);
- $dir;
- };
- my $stdout = $stdout_raw && (ref($stdout_raw) ? $tmpdir->() . "/.drakx-stdout.$$" : "$root$stdout_raw");
- my $stderr = $stderr_raw && (ref($stderr_raw) ? $tmpdir->() . "/.drakx-stderr.$$" : "$root$stderr_raw");
-
- #- checking if binary exist to avoid clobbering stdout file
- my $rname = $real_name =~ /(.*?)[\s\|]/ ? $1 : $real_name;
- if (! ($rname =~ m!^/!
- ? -x "$root$rname" || $root && -l "$root$rname" #- handle non-relative symlink which can be broken when non-rooted
- : whereis_binary($rname, $root))) {
- Sys::Syslog::syslog('warning', "program not found: $real_name");
-
- return;
- }
-
- if (my $pid = fork()) {
- if ($options->{detach}) {
- $pid;
- } else {
- my $ok;
- add2hash_($options, { timeout => $default_timeout });
- eval {
- local $SIG{ALRM} = sub { die "ALARM" };
- my $remaining = $options->{timeout} && $options->{timeout} ne 'never' && alarm($options->{timeout});
- waitpid $pid, 0;
- $ok = $? == -1 || ($? >> 8) == 0;
- alarm $remaining;
- };
- if ($@) {
- Sys::Syslog::syslog('warning', "ERROR: killing runaway process (process=$real_name, pid=$pid, args=@args, error=$@)");
- kill 9, $pid;
- return;
- }
-
- if ($stdout_raw && ref($stdout_raw)) {
- if (ref($stdout_raw) eq 'ARRAY') {
- @$stdout_raw = cat_($stdout);
- } else {
- $$stdout_raw = cat_($stdout);
- }
- unlink $stdout;
- }
- if ($stderr_raw && ref($stderr_raw)) {
- if (ref($stderr_raw) eq 'ARRAY') {
- @$stderr_raw = cat_($stderr);
- } else {
- $$stderr_raw = cat_($stderr);
- }
- unlink $stderr;
- }
- $ok;
- }
- } else {
- if ($options->{setuid}) {
- require POSIX;
- my ($logname, $home) = (getpwuid($options->{setuid}))[0,7];
- $ENV{LOGNAME} = $logname if $logname;
-
- # if we were root and are going to drop privilege, keep a copy of the X11 cookie:
- if (!$> && $home) {
- # FIXME: it would be better to remove this but most callers are using 'detach => 1'...
- my $xauth = chomp_(`mktemp $home/.Xauthority.XXXXX`);
- system('cp', '-a', $ENV{XAUTHORITY}, $xauth);
- system('chown', $logname, $xauth);
- $ENV{XAUTHORITY} = $xauth;
- }
-
- # drop privileges:
- POSIX::setuid($options->{setuid});
- }
-
- sub _die_exit {
- Sys::Syslog::syslog('warning', $_[0]);
- POSIX::_exit(128);
- }
- if ($stderr && $stderr eq 'STDERR') {
- } elsif ($stderr) {
- $stderr_mode =~ s/2//;
- open STDERR, "$stderr_mode $stderr" or _die_exit("ManaTools::Shared::RunProgram cannot output in $stderr (mode `$stderr_mode')");
- } elsif ($::isInstall) {
- open STDERR, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or _die_exit("ManaTools::Shared::RunProgram cannot log, give me access to /tmp/ddebug.log");
- }
- if ($stdout && $stdout eq 'STDOUT') {
- } elsif ($stdout) {
- open STDOUT, "$stdout_mode $stdout" or _die_exit("ManaTools::Shared::RunProgram cannot output in $stdout (mode `$stdout_mode')");
- } elsif ($::isInstall) {
- open STDOUT, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or _die_exit("ManaTools::Shared::RunProgram cannot log, give me access to /tmp/ddebug.log");
- }
-
- $root and chroot $root;
- chdir($options->{chdir} || "/");
-
- my $ok = ref $name ? do {
- exec { $name->[0] } $name->[1], @args;
- } : do {
- exec $name, @args;
- };
- if (!$ok) {
- _die_exit("exec of $real_name failed: $!");
- }
- }
-
-}
-
-=item get_parent_uid()
-
-Returns UID of the parent process.
-
-=cut
-
-sub _get_parent_uid() {
- cat_('/proc/' . getppid() . '/status') =~ /Uid:\s*(\d+)/ ? $1 : undef;
-}
-
-
-
-#- Local Variables:
-#- mode:cperl
-#- tab-width:8
-#- End:
diff --git a/lib/AdminPanel/Shared/Services.pm b/lib/AdminPanel/Shared/Services.pm
deleted file mode 100644
index abef8c31..00000000
--- a/lib/AdminPanel/Shared/Services.pm
+++ /dev/null
@@ -1,955 +0,0 @@
-# vim: set et ts=4 sw=4:
-package ManaTools::Shared::Services;
-#============================================================= -*-perl-*-
-
-=head1 NAME
-
-ManaTools::Shared::Services - shares the API to manage services
-
-=head1 SYNOPSIS
-
-use ManaTools::Shared::Services;
-
-my $serv = ManaTools::Shared::Services->new();
-
-my ($l, $on_services) = $serv->services();
-
-=head1 DESCRIPTION
-
- This module aims to share all the API to manage system services,
- to be used from GUI applications or console.
-
- From the original code drakx services.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command:
-
-perldoc ManaTools::Shared::Services
-
-=head1 SEE ALSO
-
-ManaTools::Shared
-
-=head1 AUTHOR
-
-Angelo Naselli <anaselli@linux.it>
-
-=head1 COPYRIGHT and LICENSE
-
-Copyright (C) 2013-2015, Angelo Naselli.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License version 2, as
-published by the Free Software Foundation.
-
-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
-
-=head1 FUNCTIONS
-
-=cut
-
-
-use Moose;
-
-use Sys::Syslog;
-use Net::DBus;
-use Net::DBus::Annotation qw(:auth);
-use File::Basename;
-
-use ManaTools::Shared::Locales;
-use MDK::Common::Func qw(find);
-use MDK::Common::File;
-use MDK::Common::DataStructure qw(member);
-use ManaTools::Shared::RunProgram qw(rooted);
-
-has 'loc' => (
- is => 'rw',
- init_arg => undef,
- builder => '_localeInitialize'
-);
-
-
-sub _localeInitialize {
- my $self = shift();
-
- # TODO fix domain binding for translation
- $self->loc(ManaTools::Shared::Locales->new(domain_name => 'libDrakX') );
- # TODO if we want to give the opportunity to test locally add dir_name => 'path'
-}
-
-
-has 'dbus_systemd1_service' => (
- is => 'rw',
- init_arg => undef,
- lazy => 1,
- builder => '_dbusServiceInitialize'
-);
-
-sub _dbusServiceInitialize {
- my $self = shift();
-
- my $bus = Net::DBus->system;
- $self->dbus_systemd1_service($bus->get_service("org.freedesktop.systemd1"));
-}
-
-
-has 'dbus_systemd1_object' => (
- is => 'rw',
- init_arg => undef,
- lazy => 1,
- builder => '_dbusObjectInitialize'
-);
-
-sub _dbusObjectInitialize {
- my $self = shift();
-
- $self->dbus_systemd1_object($self->dbus_systemd1_service->get_object("/org/freedesktop/systemd1"));
-}
-
-
-has 'service_info' => (
- is => 'rw',
- traits => ['Hash'],
- isa => 'HashRef',
- handles => {
- set_service_info => 'set',
- get_service_info => 'get',
- service_info_pairs => 'kv',
- },
- init_arg => undef,
- lazy => 1,
- builder => '_serviceInfoInitialization'
-);
-
-sub _serviceInfoInitialization {
- my $self = shift();
-
- my %services = ();
- if ($self->_running_systemd()) {
- my $object = $self->dbus_systemd1_object;
- my $properties = $object->ListUnits();
-
- foreach my $s (@{$properties}) {
- my $name = $s->[0];
- if (index($name, ".service") != -1) {
- my $st = eval{$object->GetUnitFileState($name)} if $name !~ /.*\@.*$/g;
- $name =~ s|.service||;
- if (!$st) {
- if ($name !~ /.*\@$/g &&
- (-e "/usr/lib/systemd/system/$name.service" or -e "/etc/rc.d/init.d/$name") &&
- ! -l "/usr/lib/systemd/system/$name.service") {
- $st = 'enabled';
- }
- }
- if ($st && $st ne 'static') {
- $services{$name} = {
- 'name' => $s->[0],
- 'description' => $s->[1],
- 'load_state' => $s->[2],
- 'active_state' => $s->[3],
- 'sub_state' => $s->[4],
- 'unit_path' => $s->[6],
- 'enabled' => $st eq 'enabled',
- };
- }
- }
- }
-
- my $unit_files = $object->ListUnitFiles();
- foreach my $s (@{$unit_files}) {
- my $name = $s->[0];
- my $st = $s->[1];
- if (index($name, ".service") != -1) {
- $name = File::Basename::basename($name, ".service");
- if (!$services{$name} &&
- $name !~ /.*\@$/g &&
- (-e $s->[0] or -e "/etc/rc.d/init.d/$name") &&
- ! -l $s->[0] && ($st eq "disabled" || $st eq "enabled")) {
- my $wantedby = $self->_WantedBy($s->[0]);
- if ($wantedby) {
- my $descr = $self->getUnitProperty($name, 'Description');
-
- $services{$name} = {
- 'name' => $name,
- 'description' => $descr,
- 'enabled' => $st eq "enabled",
- };
- }
- }
- }
- }
- }
-
- return \%services;
-}
-
-#=============================================================
-
-=head2 description
-
-=head3 INPUT
-
-name: Service Name
-
-=head3 OUTPUT
-
-Description: Service description
-
-=head3 DESCRIPTION
-
-THis function return the description for the given service
-
-=cut
-
-#=============================================================
-sub description {
- my ($self, $name) = @_;
-
- my %services = (
-acpid => $self->loc->N_("Listen and dispatch ACPI events from the kernel"),
-alsa => $self->loc->N_("Launch the ALSA (Advanced Linux Sound Architecture) sound system"),
-anacron => $self->loc->N_("Anacron is a periodic command scheduler."),
-apmd => $self->loc->N_("apmd is used for monitoring battery status and logging it via syslog.
-It can also be used for shutting down the machine when the battery is low."),
-atd => $self->loc->N_("Runs commands scheduled by the at command at the time specified when
-at was run, and runs batch commands when the load average is low enough."),
-'avahi-deamon' => $self->loc->N_("Avahi is a ZeroConf daemon which implements an mDNS stack"),
-chronyd => $self->loc->N_("An NTP client/server"),
-cpufreq => $self->loc->N_("Set CPU frequency settings"),
-crond => $self->loc->N_("cron is a standard UNIX program that runs user-specified programs
-at periodic scheduled times. vixie cron adds a number of features to the basic
-UNIX cron, including better security and more powerful configuration options."),
-cups => $self->loc->N_("Common UNIX Printing System (CUPS) is an advanced printer spooling system"),
-dm => $self->loc->N_("Launches the graphical display manager"),
-fam => $self->loc->N_("FAM is a file monitoring daemon. It is used to get reports when files change.
-It is used by GNOME and KDE"),
-g15daemon => $self->loc->N_("G15Daemon allows users access to all extra keys by decoding them and
-pushing them back into the kernel via the linux UINPUT driver. This driver must be loaded
-before g15daemon can be used for keyboard access. The G15 LCD is also supported. By default,
-with no other clients active, g15daemon will display a clock. Client applications and
-scripts can access the LCD via a simple API."),
-gpm => $self->loc->N_("GPM adds mouse support to text-based Linux applications such the
-Midnight Commander. It also allows mouse-based console cut-and-paste operations,
-and includes support for pop-up menus on the console."),
-haldaemon => $self->loc->N_("HAL is a daemon that collects and maintains information about hardware"),
-harddrake => $self->loc->N_("HardDrake runs a hardware probe, and optionally configures
-new/changed hardware."),
-httpd => $self->loc->N_("Apache is a World Wide Web server. It is used to serve HTML files and CGI."),
-inet => $self->loc->N_("The internet superserver daemon (commonly called inetd) starts a
-variety of other internet services as needed. It is responsible for starting
-many services, including telnet, ftp, rsh, and rlogin. Disabling inetd disables
-all of the services it is responsible for."),
-ip6tables => $self->loc->N_("Automates a packet filtering firewall with ip6tables"),
-iptables => $self->loc->N_("Automates a packet filtering firewall with iptables"),
-irqbalance => $self->loc->N_("Evenly distributes IRQ load across multiple CPUs for enhanced performance"),
-keytable => $self->loc->N_("This package loads the selected keyboard map as set in
-/etc/sysconfig/keyboard. This can be selected using the kbdconfig utility.
-You should leave this enabled for most machines."),
-kheader => $self->loc->N_("Automatic regeneration of kernel header in /boot for
-/usr/include/linux/{autoconf,version}.h"),
-kudzu => $self->loc->N_("Automatic detection and configuration of hardware at boot."),
-'laptop-mode' => $self->loc->N_("Tweaks system behavior to extend battery life"),
-linuxconf => $self->loc->N_("Linuxconf will sometimes arrange to perform various tasks
-at boot-time to maintain the system configuration."),
-lpd => $self->loc->N_("lpd is the print daemon required for lpr to work properly. It is
-basically a server that arbitrates print jobs to printer(s)."),
-lvs => $self->loc->N_("Linux Virtual Server, used to build a high-performance and highly
-available server."),
-mandi => $self->loc->N_("Monitors the network (Interactive Firewall and wireless"),
-mdadm => $self->loc->N_("Software RAID monitoring and management"),
-messagebus => $self->loc->N_("DBUS is a daemon which broadcasts notifications of system events and other messages"),
-msec => $self->loc->N_("Enables MSEC security policy on system startup"),
-named => $self->loc->N_("named (BIND) is a Domain Name Server (DNS) that is used to resolve host names to IP addresses."),
-netconsole => $self->loc->N_("Initializes network console logging"),
-netfs => $self->loc->N_("Mounts and unmounts all Network File System (NFS), SMB (Lan
-Manager/Windows), and NCP (NetWare) mount points."),
-network => $self->loc->N_("Activates/Deactivates all network interfaces configured to start
-at boot time."),
-'network-auth' => $self->loc->N_("Requires network to be up if enabled"),
-'network-up' => $self->loc->N_("Wait for the hotplugged network to be up"),
-nfs => $self->loc->N_("NFS is a popular protocol for file sharing across TCP/IP networks.
-This service provides NFS server functionality, which is configured via the
-/etc/exports file."),
-nfslock => $self->loc->N_("NFS is a popular protocol for file sharing across TCP/IP
-networks. This service provides NFS file locking functionality."),
-ntpd => $self->loc->N_("Synchronizes system time using the Network Time Protocol (NTP)"),
-numlock => $self->loc->N_("Automatically switch on numlock key locker under console
-and Xorg at boot."),
-oki4daemon => $self->loc->N_("Support the OKI 4w and compatible winprinters."),
-partmon => $self->loc->N_("Checks if a partition is close to full up"),
-pcmcia => $self->loc->N_("PCMCIA support is usually to support things like ethernet and
-modems in laptops. It will not get started unless configured so it is safe to have
-it installed on machines that do not need it."),
-portmap => $self->loc->N_("The portmapper manages RPC connections, which are used by
-protocols such as NFS and NIS. The portmap server must be running on machines
-which act as servers for protocols which make use of the RPC mechanism."),
-portreserve => $self->loc->N_("Reserves some TCP ports"),
-postfix => $self->loc->N_("Postfix is a Mail Transport Agent, which is the program that moves mail from one machine to another."),
-random => $self->loc->N_("Saves and restores system entropy pool for higher quality random
-number generation."),
-rawdevices => $self->loc->N_("Assign raw devices to block devices (such as hard disk drive
-partitions), for the use of applications such as Oracle or DVD players"),
-resolvconf => $self->loc->N_("Nameserver information manager"),
-routed => $self->loc->N_("The routed daemon allows for automatic IP router table updated via
-the RIP protocol. While RIP is widely used on small networks, more complex
-routing protocols are needed for complex networks."),
-rstatd => $self->loc->N_("The rstat protocol allows users on a network to retrieve
-performance metrics for any machine on that network."),
-rsyslog => $self->loc->N_("Syslog is the facility by which many daemons use to log messages to various system log files. It is a good idea to always run rsyslog."),
-rusersd => $self->loc->N_("The rusers protocol allows users on a network to identify who is
-logged in on other responding machines."),
-rwhod => $self->loc->N_("The rwho protocol lets remote users get a list of all of the users
-logged into a machine running the rwho daemon (similar to finger)."),
-saned => $self->loc->N_("SANE (Scanner Access Now Easy) enables to access scanners, video cameras, ..."),
-shorewall => $self->loc->N_("Packet filtering firewall"),
-smb => $self->loc->N_("The SMB/CIFS protocol enables to share access to files & printers and also integrates with a Windows Server domain"),
-sound => $self->loc->N_("Launch the sound system on your machine"),
-'speech-dispatcherd' => $self->loc->N_("layer for speech analysis"),
-sshd => $self->loc->N_("Secure Shell is a network protocol that allows data to be exchanged over a secure channel between two computers"),
-syslog => $self->loc->N_("Syslog is the facility by which many daemons use to log messages
-to various system log files. It is a good idea to always run syslog."),
-'udev-post' => $self->loc->N_("Moves the generated persistent udev rules to /etc/udev/rules.d"),
-usb => $self->loc->N_("Load the drivers for your usb devices."),
-vnStat => $self->loc->N_("A lightweight network traffic monitor"),
-xfs => $self->loc->N_("Starts the X Font Server."),
-xinetd => $self->loc->N_("Starts other deamons on demand."),
- );
-
- my $s = $services{$name};
- if ($s) {
- $s = $self->loc->N($s);
- }
- elsif ($self->get_service_info($name)) {
- $s = $self->get_service_info($name)->{description};
- }
- else {
- my $file = "/usr/lib/systemd/system/$name.service";
- if (-e $file) {
- $s = MDK::Common::File::cat_($file);
- $s = $s =~ /^Description=(.*)/mg ? $1 : '';
- } else {
- $file = MDK::Common::Func::find { -e $_ } map { "$_/$name" } '/etc/rc.d/init.d', '/etc/init.d', '/etc/xinetd.d';
- $s = MDK::Common::File::cat_($file);
- $s =~ s/\\\s*\n#\s*//mg;
- $s =
- $s =~ /^#\s+(?:Short-)?[dD]escription:\s+(.*?)^(?:[^#]|# {0,2}\S)/sm ? $1 :
- $s =~ /^#\s*(.*?)^[^#]/sm ? $1 : '';
-
- $s =~ s/#\s*//mg;
- }
- }
- $s =~ s/\n/ /gm; $s =~ s/\s+$//;
- $s;
-}
-
-
-#=============================================================
-
-=head2 set_service
-
-=head3 INPUT
-
- $service: Service name
- $enable: enable/disable service
-
-=head3 DESCRIPTION
-
- This function enable/disable at boot the given service
-
-=cut
-
-#=============================================================
-sub set_service {
- my ($self, $service, $enable) = @_;
-
- my @xinetd_services = map { $_->[0] } $self->xinetd_services();
-
- if (MDK::Common::DataStructure::member($service, @xinetd_services)) {
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- ManaTools::Shared::RunProgram::rooted("", "/usr/sbin/chkconfig", $enable ? "--add" : "--del", $service);
- } elsif ($self->_running_systemd() || $self->_has_systemd()) {
- $service = $service . ".service";
- my $dbus_object = $self->dbus_systemd1_object;
- if ($enable) {
- $dbus_object->EnableUnitFiles(dbus_auth_interactive, [$service], 0, 1);
- }
- else {
- $dbus_object->DisableUnitFiles(dbus_auth_interactive, [$service], 0);
- }
- # reload local cache
- $self->_systemd_services(1);
- } else {
- my $script = "/etc/rc.d/init.d/$service";
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- ManaTools::Shared::RunProgram::rooted("", "/usr/sbin/chkconfig", $enable ? "--add" : "--del", $service);
- #- FIXME: handle services with no chkconfig line and with no Default-Start levels in LSB header
- if ($enable && MDK::Common::File::cat_("$script") =~ /^#\s+chkconfig:\s+-/m) {
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- ManaTools::Shared::RunProgram::rooted("", "/usr/sbin/chkconfig", "--level", "35", $service, "on");
- }
- }
-}
-
-sub _run_action {
- my ($self, $service, $action) = @_;
- if ($self->_running_systemd()) {
- my $object = $self->dbus_systemd1_object;
- if ($action eq 'start') {
- $object->StartUnit(dbus_auth_interactive, "$service.service", 'fail');
- }
- elsif ($action eq 'stop') {
- $object->StopUnit(dbus_auth_interactive, "$service.service", 'fail');
- }
- else {
- $object->RestartUnit(dbus_auth_interactive, "$service.service", 'fail');
- }
- # reload local cache
- $self->_systemd_services(1);
- } else {
- $ENV{PATH} = "/usr/bin:/usr/sbin:/etc/rc.d/init.d/";
- ManaTools::Shared::RunProgram::rooted("", "/etc/rc.d/init.d/$service", $action);
- }
-}
-
-sub _running_systemd {
- my $self = shift;
-
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- ManaTools::Shared::RunProgram::rooted("", '/usr/bin/mountpoint', '-q', '/sys/fs/cgroup/systemd');
-}
-
-sub _has_systemd {
- my $self = shift;
-
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- ManaTools::Shared::RunProgram::rooted("", '/usr/bin/rpm', '-q', 'systemd');
-}
-
-#=============================================================
-
-=head2 xinetd_services
-
-=head3 OUTPUT
-
- xinetd_services: All the xinetd services
-
-=head3 DESCRIPTION
-
- This functions returns all the xinetd services in the system.
- NOTE that xinetd *must* be enable at boot to get this info
-
-=cut
-
-#=============================================================
-sub xinetd_services {
- my $self = shift;
-
- my @xinetd_services = ();
-
- #avoid warning if xinetd is not installed and either enabled
- my $ser_info = $self->get_service_info('xinetd');
- if ($ser_info && $ser_info->{enabled} eq "1") {
- local $ENV{LANGUAGE} = 'C';
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- foreach (ManaTools::Shared::RunProgram::rooted_get_stdout("", '/usr/sbin/chkconfig', '--list', '--type', 'xinetd')) {
- if (my ($xinetd_name, $on_off) = m!^\t(\S+):\s*(on|off)!) {
- push @xinetd_services, [ $xinetd_name, $on_off eq 'on' ];
- }
- }
- }
- return @xinetd_services;
-}
-
-sub _systemd_services {
- my ($self, $reload) = @_;
-
- if ($reload) {
- $self->service_info($self->_serviceInfoInitialization());
- }
-
- my @services;
- for my $pair ( $self->service_info_pairs) {
- my $name = $pair->[0];
- my $info = $pair->[1];
- push @services, [$name, $info->{'enabled'}];
- }
-
- return @services;
-
-}
-
-sub _legacy_services {
- my $self = shift;
-
- local $ENV{LANGUAGE} = 'C';
- my @services;
- my $has_systemd = $self->_has_systemd();
- if ($has_systemd) {
- # The system not using systemd but will be at next boot. This is
- # is typically the case in the installer. In this mode we must read
- # as much as is practicable from the native systemd unit files and
- # combine that with information from chkconfig regarding legacy sysvinit
- # scripts (which systemd will parse and include when running)
- Sys::Syslog::syslog('info|local1', "Detected systemd installed. Using fake service+chkconfig introspection.");
- foreach (glob_("/usr/lib/systemd/system/*.service")) {
- my ($name) = m!([^/]*).service$!;
-
- # We only look at non-template, non-symlinked service files
- if (!(/.*\@\.service$/g) && ! -l $_) {
- # Limit ourselves to "standard" targets
- my $wantedby = MDK::Common::File::cat_($_) =~ /^WantedBy=(graphical|multi-user).target$/sm ? $1 : '';
- if ($wantedby) {
- # Exclude if enabled statically
- # Note DO NOT use -e when testing for files that could
- # be symbolic links as this will fail under a chroot
- # setup where -e will fail if the symlink target does
- # exist which is typically the case when viewed outside
- # of the chroot.
- if (!-l "/usr/lib/systemd/system/$wantedby.target.wants/$name.service") {
- push @services, [ $name, !!-l "/etc/systemd/system/$wantedby.target.wants/$name.service" ];
- }
- }
- }
- }
- } else {
- Sys::Syslog::syslog('info|local1', "Could not detect systemd. Using chkconfig service introspection.");
- }
-
- # Regardless of whether we expect to use systemd on next boot, we still
- # need to instrospect information about non-systemd native services.
- my $runlevel;
- my $on_off;
- if (!$::isInstall) {
- $runlevel = (split " ", `/sbin/runlevel`)[1];
- }
- foreach (ManaTools::Shared::RunProgram::rooted_get_stdout("", '/sbin/chkconfig', '--list', '--type', 'sysv')) {
- if (my ($name, $l) = m!^(\S+)\s+(0:(on|off).*)!) {
- # If we expect to use systemd (i.e. installer) only show those
- # sysvinit scripts which are not masked by a native systemd unit.
- my $has_systemd_unit = $self->_systemd_unit_exists($name);
- if (!$has_systemd || !$has_systemd_unit) {
- if ($::isInstall) {
- $on_off = $l =~ /\d+:on/g;
- } else {
- $on_off = $l =~ /$runlevel:on/g;
- }
- push @services, [ $name, $on_off ];
- }
- }
- }
- @services;
-}
-
-#- returns:
-#--- the listref of installed services
-#--- the listref of "on" services
-#=============================================================
-
-=head2 services
-
-=head3 INPUT
-
- $reload: load service again
-
-=head3 OUTPUT
-
- @l: all the system services
- @on_services: all the services that start at boot
-
-=head3 DESCRIPTION
-
- This function returns two lists, all the system service and
- all the active ones.
-
-=cut
-
-#=============================================================
-
-
-sub services {
- my ($self, $reload) = @_;
-
- my @Services;
- if ($self->_running_systemd()) {
- @Services = $self->_systemd_services($reload);
- } else {
- @Services = $self->_legacy_services();
- }
-
- my @l = $self->xinetd_services();
- push @l, @Services;
- @l = sort { $a->[0] cmp $b->[0] } @l;
- [ map { $_->[0] } @l ], [ map { $_->[0] } grep { $_->[1] } @l ];
-}
-
-
-# if we loaded service info, then exists
-sub _systemd_unit_exists {
- my ($self, $name) = @_;
-
- return defined ($self->get_service_info($name));
-}
-
-#=============================================================
-
-=head2 service_exists
-
-=head3 INPUT
-
- $service: Service name
-
-=head3 OUTPUT
-
- 0/1: if the service exists
-
-=head3 DESCRIPTION
-
- This function checks if a service is installed by looking for
- its unit or init.d service
-
-=cut
-
-#=============================================================
-
-sub service_exists {
- my ($self, $service) = @_;
- $self->_systemd_unit_exists($service) or -x "/etc/rc.d/init.d/$service";
-}
-
-#=============================================================
-
-=head2 restart
-
-=head3 INPUT
-
- $service: Service to restart
-
-=head3 DESCRIPTION
-
- This function restarts a given service
-
-=cut
-
-#=============================================================
-
-
-sub restart {
- my ($self, $service) = @_;
- # Exit silently if the service is not installed
- $self->service_exists($service) or return 1;
- $self->_run_action($service, "restart");
-}
-
-#=============================================================
-
-=head2 restart_or_start
-
-=head3 INPUT
-
- $service: Service to restart or start
-
-=head3 DESCRIPTION
-
- This function starts a given service if it is not running,
- it restarts that otherwise
-
-=cut
-
-#=============================================================
-
-sub restart_or_start {
- my ($self, $service) = @_;
- # Exit silently if the service is not installed
- $self->service_exists($service) or return 1;
- $self->_run_action($service, $self->is_service_running($service) ? "restart" : "start");
-}
-
-
-#=============================================================
-
-=head2 startService
-
-=head3 INPUT
-
- $service: Service to start
-
-=head3 DESCRIPTION
-
- This function starts a given service
-
-=cut
-
-#=============================================================
-
-sub startService {
- my ($self, $service) = @_;
- # Exit silently if the service is not installed
- $self->service_exists($service) or return 1;
- $self->_run_action($service, "start");
-}
-
-#=============================================================
-
-=head2 start_not_running_service
-
-=head3 INPUT
-
- $service: Service to start
-
-=head3 DESCRIPTION
-
- This function starts a given service if not running
-
-=cut
-
-#=============================================================
-
-sub start_not_running_service {
- my ($self, $service) = @_;
- # Exit silently if the service is not installed
- $self->service_exists($service) or return 1;
- $self->is_service_running($service) || $self->_run_action($service, "start");
-}
-
-#=============================================================
-
-=head2 stopService
-
-=head3 INPUT
-
- $service: Service to stop
-
-=head3 DESCRIPTION
-
- This function stops a given service
-
-=cut
-
-#=============================================================
-sub stopService {
- my ($self, $service) = @_;
- # Exit silently if the service is not installed
- $self->service_exists($service) or return 1;
- $self->_run_action($service, "stop");
-}
-
-#=============================================================
-
-=head2 is_service_running
-
-=head3 INPUT
-
- $service: Service to check
-
-=head3 DESCRIPTION
-
- This function returns if the given service is running
-
-=cut
-
-#=============================================================
-
-sub is_service_running {
- my ($self, $service) = @_;
- # Exit silently if the service is not installed
- $self->service_exists($service) or return 0;
- my $out;
- if ($self->_running_systemd()) {
- my $ser_info = $self->get_service_info($service);
- $out = $ser_info->{active_state} eq 'active' if $ser_info->{active_state};
- } else {
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- $out = ManaTools::Shared::RunProgram::rooted("", '/usr/sbin/service', $service, 'status');
- }
- return $out;
-}
-
-#=============================================================
-
-=head2 starts_on_boot
-
-=head3 INPUT
-
- $service: Service name
-
-
-=head3 DESCRIPTION
-
- This function returns if the given service starts at boot
-
-=cut
-
-#=============================================================
-sub starts_on_boot {
- my ($self, $service) = @_;
- my (undef, $on_services) = $self->services();
- MDK::Common::DataStructure::member($service, @$on_services);
-}
-
-#=============================================================
-
-=head2 start_service_on_boot
-
-=head3 INPUT
-
- $service: Service name
-
-
-=head3 DESCRIPTION
-
- This function set the given service active at boot
-
-=cut
-
-#=============================================================
-sub start_service_on_boot {
- my ($self, $service) = @_;
- $self->set_service($service, 1);
-}
-
-#=============================================================
-
-=head2 do_not_start_service_on_boot
-
-=head3 INPUT
-
- $service: Service name
-
-
-=head3 DESCRIPTION
-
- This function set the given service disabled at boot
-
-=cut
-
-#=============================================================
-sub do_not_start_service_on_boot {
- my ($self, $service) = @_;
- $self->set_service($service, 0);
-}
-
-#=============================================================
-
-=head2 enable
-
-=head3 INPUT
-
- $service: Service name
- $o_dont_apply: do not start it now
-
-=head3 DESCRIPTION
-
- This function set the given service active at boot
- and restarts it if o_dont_apply is not given
-
-=cut
-
-#=============================================================
-sub enable {
- my ($self, $service, $o_dont_apply) = @_;
- $self->start_service_on_boot($service);
- $self->restart_or_start($service) unless $o_dont_apply;
-}
-
-#=============================================================
-
-=head2 disable
-
-=head3 INPUT
-
- $service: Service name
- $o_dont_apply: do not stop it now
-
-=head3 DESCRIPTION
-
- This function set the given service disabled at boot
- and stops it if o_dont_apply is not given
-
-=cut
-
-#=============================================================
-sub disable {
- my ($self, $service, $o_dont_apply) = @_;
- $self->do_not_start_service_on_boot($service);
- $self->stopService($service) unless $o_dont_apply;
-}
-
-#=============================================================
-
-=head2 set_status
-
-=head3 INPUT
-
- $service: Service name
- $enable: Enable/disable
- $o_dont_apply: do not start it now
-
-=head3 DESCRIPTION
-
- This function set the given service to enable/disable at boot
- and restarts/stops it if o_dont_apply is not given
-
-=cut
-
-#=============================================================
-sub set_status {
- my ($self, $service, $enable, $o_dont_apply) = @_;
- if ($enable) {
- $self->enable($service, $o_dont_apply);
- } else {
- $self->disable($service, $o_dont_apply);
- }
-}
-
-# NOTE $service->get_object("/org/freedesktop/systemd1/unit/$name_2eservice");
-# has empty WantedBy property if disabled
-sub _WantedBy {
- my ($self, $path_service) = @_;
-
- my $wantedby = MDK::Common::File::cat_($path_service) =~ /^WantedBy=(graphical|multi-user).target$/sm ? $1 : '';
-
- return $wantedby;
-}
-
-#=============================================================
-
-=head2 getUnitProperty
-
-=head3 INPUT
-
- $unit: unit name
- $property: property name
-
-=head3 OUTPUT
-
- $property_value: property value
-
-=head3 DESCRIPTION
-
- This method returns the requested property value
-
-=cut
-
-#=============================================================
-sub getUnitProperty {
- my ($self, $unit, $property) = @_;
-
- my $name = $unit . ".service";
- $name =~ s|-|_2d|g;
- $name =~ s|\.|_2e|g;
- my $service = $self->dbus_systemd1_service;
- my $unit_object = $service->get_object("/org/freedesktop/systemd1/unit/" . $name);
- my $property_value = eval {$unit_object->Get("org.freedesktop.systemd1.Unit", $property)} || "";
-
- return $property_value;
-}
-
-1;
diff --git a/lib/AdminPanel/Shared/Shorewall.pm b/lib/AdminPanel/Shared/Shorewall.pm
deleted file mode 100644
index f82c542c..00000000
--- a/lib/AdminPanel/Shared/Shorewall.pm
+++ /dev/null
@@ -1,271 +0,0 @@
-package ManaTools::Shared::Shorewall; # $Id: shorewall.pm 254244 2009-03-18 22:54:32Z eugeni $
-
-use detect_devices;
-use network::network;
-use ManaTools::Shared::RunProgram;
-use ManaTools::Shared::Services;
-use MDK::Common::Func qw(if_ partition map_each);
-use MDK::Common::File qw(cat_ substInFile output_with_perm);
-use MDK::Common::Various qw(to_bool);
-use MDK::Common::DataStructure qw(is_empty_array_ref);
-use List::Util qw(any);
-use List::MoreUtils qw(uniq);
-use log;
-
-my $shorewall_root = "/etc/shorewall";
-
-sub check_iptables() {
- -f "$::prefix/etc/sysconfig/iptables" ||
- $::isStandalone && do {
- system('modprobe iptable_nat');
- -x '/sbin/iptables' && listlength(`/sbin/iptables -t nat -nL`) > 8;
- };
-}
-
-sub set_config_file {
- my ($file, $ver, @l) = @_;
-
- my $done;
- substInFile {
- my $last_line = /^#LAST LINE/ && $_;
- if (!$done && ($last_line || eof)) {
- $_ = join('', map { join("\t", @$_) . "\n" } @l);
- $_ .= $last_line if $last_line;
- $done = 1;
- } else {
- $_ = '' unless
- /^#/ || $file eq 'rules' && /^SECTION/;
- }
- } "$::prefix${shorewall_root}${ver}/$file";
-}
-
-sub get_config_file {
- my ($file, $o_ver) = @_;
- map { [ split ' ' ] } grep { !/^#/ } cat_("$::prefix${shorewall_root}${o_ver}/$file");
-}
-
-# Note: Called from drakguard and drakfirewall.pm...
-# Deliberately not adding shorewall6 support here for now
-sub set_in_file {
- my ($file, $enabled, @list) = @_;
- my $done;
- substInFile {
- my $last_line = /^#LAST LINE/ && $_;
- foreach my $l (@list) { s|^$l\n|| }
- if (!$done && $enabled && ($last_line || eof)) {
- $_ = join('', map { "$_\n" } @list);
- $_ .= $last_line if $last_line;
- $done = 1;
- }
- } "$::prefix${shorewall_root}/$file";
-}
-
-sub dev_to_shorewall {
- my ($dev) = @_;
- $dev =~ /^ippp/ && "ippp+" ||
- $dev =~ /^ppp/ && "ppp+" ||
- $dev;
-}
-
-sub get_net_zone_interfaces {
- my ($interfacesfile, $_net, $all_intf) = @_;
- if(ref($interfacesfile) eq "ARRAY")
- {
- #- read shorewall configuration first
- my @interfaces = map { $_->[1] } grep { $_->[0] eq 'net' } $interfacesfile;
- }
- else
- {
- my @interfaces = undef;
- }
- #- else try to find the best interface available
- @interfaces ? @interfaces : @{$all_intf || []};
-}
-
-sub add_interface_to_net_zone {
- my ($conf, $interface) = @_;
- if (!member($interface, @{$conf->{net_zone}})) {
- push @{$conf->{net_zone}}, $interface;
- @{$conf->{loc_zone}} = grep { $_ ne $interface } @{$conf->{loc_zone}};
- }
-}
-
-sub read_ {
- my ($o_ver) = @_;
- my $ver = '';
- $ver = $o_ver if $o_ver;
- #- read old rules file if config is not moved to rules.drakx yet
- my @rules = get_config_file(-f "$::prefix${shorewall_root}${ver}/rules.drakx" ? 'rules.drakx' : 'rules', $ver);
- my $services = ManaTools::Shared::Services->new();
- my %conf = (disabled => !$services->starts_on_boot("shorewall${ver}"),
- version => $ver,
- ports => join(' ', map {
- my $e = $_;
- map { "$_/$e->[3]" } split(',', $e->[4]);
- } grep { $_->[0] eq 'ACCEPT' && $_->[1] eq 'net' } @rules),
- );
- push @{$conf{accept_local_users}{$_->[4]}}, $_->[8] foreach grep { $_->[0] eq 'ACCEPT+' } @rules;
- $conf{redirects}{$_->[3]}{$_->[4]} = $_->[2] foreach grep { $_->[0] eq 'REDIRECT' } @rules;
-
- if (my ($e) = get_config_file('masq', $ver)) {
- ($conf{masq}{net_interface}, $conf{masq}{subnet}) = @$e;
- }
-
- my @policy = get_config_file('policy', $ver);
- $conf{log_net_drop} = @policy ? (any { $_->[0] eq 'net' && $_->[1] eq 'all' && $_->[2] eq 'DROP' && $_->[3] } @policy) : 1;
-
- return \%conf;
-
- # get_zones has been moved to ManaTools::Module::Firewall cause it requires
- # user interaction thus it should be logically separated by shorewall
- # get_zones(\%conf);
- # get_config_file('zones', $ver) && \%conf;
- # consequently, to read shorewall conf
- # you have to do something like this now (within Module::Firewall)
- # my $conf = ManaTools::Shared::Shorewall::read_();
- # OPTIONAL: my $self->get_zones(\$conf)
- # my $shorewall = ManaTools::Shared::Shorewall::get_config_file('zones', '') && $conf;
-}
-
-sub ports_by_proto {
- my ($ports) = @_;
- my %ports_by_proto;
- foreach (split ' ', $ports) {
- m!^(\d+(?::\d+)?)/(udp|tcp|icmp)$! or die "bad port $_\n";
- push @{$ports_by_proto{$2}}, $1;
- }
- \%ports_by_proto;
-}
-
-#=============================================================
-
-=head2 write_
-
-=head3 INPUT
-
- $conf: HASH, contains the configuration to write
-
- $action: Str, possible values are "keep" or "drop"
-
-=head3 OUTPUT
-
- 0: requires user interaction
- 1: everything has been done
-
-=head3 DESCRIPTION
-
-This function stores the configuration for shorewall inside
-the proper files.
-
-=head3 NOTES
-
-if write_ is called without the $action parameter it can return 0
-(i.e. user interaction requested) when the firewall configuration
-has been manually changed.
-
-In that case the developer will have to handle this request by providing
-two choices within the domain (keep | drop) and then recall write_ with
-the choosen behaviour.
-
-=cut
-
-#=============================================================
-
-sub write_ {
- my ($conf, $action) = @_;
- my $ver = $conf->{version} || '';
- my $use_pptp = any { /^ppp/ && cat_("$::prefix/etc/ppp/peers/$_") =~ /pptp/ } @{$conf->{net_zone}};
- my $ports_by_proto = ports_by_proto($conf->{ports});
- my $has_loc_zone = to_bool(@{$conf->{loc_zone} || []});
-
- my ($include_drakx, $other_rules) = partition { $_ eq "INCLUDE\trules.drakx\n" } grep { !/^(#|SECTION)/ } cat_("$::prefix${shorewall_root}${ver}/rules");
- #- warn if the config is already in rules.drakx and additionnal rules are configured
- if (!is_empty_array_ref($include_drakx) && !is_empty_array_ref($other_rules)) {
- if(!defined($action) || ManaTools::Shared::trim($action) eq "")
- {
- return 0; # user interaction requested
- }
- my %actions = (
- keep => N("Keep custom rules"),
- drop => N("Drop custom rules"),
- );
- #- reset the rules files if the user has chosen to drop modifications
- undef $include_drakx if $action eq 'drop';
- }
-
- my $interface_settings = sub {
- my ($zone, $interface) = @_;
- [ $zone, $interface, 'detect', if_(detect_devices::is_bridge_interface($interface), 'bridge') ];
- };
-
- set_config_file('zones', $ver,
- if_($has_loc_zone, [ 'loc', 'ipv' . ($ver || '4') ]),
- [ 'net', 'ipv' . ($ver || '4') ],
- [ 'fw', 'firewall' ],
- );
- set_config_file('interfaces', $ver,
- (map { $interface_settings->('net', $_) } @{$conf->{net_zone}}),
- (map { $interface_settings->('loc', $_) } @{$conf->{loc_zone} || []}),
- );
- set_config_file('policy', $ver,
- if_($has_loc_zone, [ 'loc', 'net', 'ACCEPT' ], [ 'loc', 'fw', 'ACCEPT' ], [ 'fw', 'loc', 'ACCEPT' ]),
- [ 'fw', 'net', 'ACCEPT' ],
- [ 'net', 'all', 'DROP', if_($conf->{log_net_drop}, 'info') ],
- [ 'all', 'all', 'REJECT', 'info' ],
- );
- if (is_empty_array_ref($include_drakx)) {
- #- make sure the rules.drakx config is read, erasing user modifications
- set_config_file('rules', $ver, [ 'INCLUDE', 'rules.drakx' ]);
- }
- output_with_perm("$::prefix${shorewall_root}${ver}/" . 'rules.drakx', 0600, map { join("\t", @$_) . "\n" } (
- if_($use_pptp, [ 'ACCEPT', 'fw', 'loc:10.0.0.138', 'tcp', '1723' ]),
- if_($use_pptp, [ 'ACCEPT', 'fw', 'loc:10.0.0.138', 'gre' ]),
- (map_each { [ 'ACCEPT', 'net', 'fw', $::a, join(',', @$::b), '-' ] } %$ports_by_proto),
- (map_each {
- if_($::b, map { [ 'ACCEPT+', 'fw', 'net', 'tcp', $::a, '-', '-', '-', $_ ] } @$::b);
- } %{$conf->{accept_local_users}}),
- (map {
- my $proto = $_;
- #- WARNING: won't redirect ports from the firewall system if a local zone exists
- #- set redirect_fw_only to workaround
- map_each {
- map { [ 'REDIRECT', $_, $::b, $proto, $::a, '-' ] } 'fw', if_($has_loc_zone, 'loc');
- } %{$conf->{redirects}{$proto}};
- } keys %{$conf->{redirects}}),
- ));
- set_config_file('masq', $ver, if_(exists $conf->{masq}, [ $conf->{masq}{net_interface}, $conf->{masq}{subnet} ]));
-
- my $services = ManaTools::Shared::Services->new();
- if ($conf->{disabled}) {
- $services->disable('shorewall', $::isInstall);
- run_program::rooted($::prefix, '/sbin/shorewall', 'clear') unless $::isInstall;
- } else {
- $services->enable('shorewall', $::isInstall);
- }
- return 1;
-}
-
-sub set_redirected_ports {
- my ($conf, $proto, $dest, @ports) = @_;
- if (@ports) {
- $conf->{redirects}{$proto}{$_} = $dest foreach @ports;
- } else {
- my $r = $conf->{redirects}{$proto};
- @ports = grep { $r->{$_} eq $dest } keys %$r;
- delete $r->{$_} foreach @ports;
- }
-}
-
-sub update_interfaces_list {
- my ($o_intf) = @_;
- if (!$o_intf || !member($o_intf, map { $_->[1] } get_config_file('interfaces'))) {
- my $shorewall = ManaTools::Shared::Shorewall::read_();
- $shorewall && !$shorewall->{disabled} and ManaTools::Shared::Shorewall::write_($shorewall);
- }
- if (!$o_intf || !member($o_intf, map { $_->[1] } get_config_file('interfaces', 6))) {
- my $shorewall6 = ManaTools::Shared::Shorewall::read_(undef, 6);
- $shorewall6 && !$shorewall6->{disabled} and ManaTools::Shared::Shorewall::write_($shorewall6);
- }
-}
-
-1;
diff --git a/lib/AdminPanel/Shared/TimeZone.pm b/lib/AdminPanel/Shared/TimeZone.pm
deleted file mode 100644
index efb49a29..00000000
--- a/lib/AdminPanel/Shared/TimeZone.pm
+++ /dev/null
@@ -1,799 +0,0 @@
-# vim: set et ts=4 sw=4:
-package ManaTools::Shared::TimeZone;
-
-#============================================================= -*-perl-*-
-
-=head1 NAME
-
-ManaTools::Shared::TimeZone - module to manage TimeZone settings
-
-=head1 SYNOPSIS
-
- my $tz = ManaTools::Shared::TimeZone->new();
-
-
-=head1 DESCRIPTION
-
-This module allows to manage time zone settings.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command:
-
-perldoc ManaTools::Shared::TimeZone
-
-
-=head1 AUTHOR
-
-Angelo Naselli <anaselli@linux.it>
-
-=head1 COPYRIGHT and LICENSE
-
-Copyright (C) 2014-2015, Angelo Naselli.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License version 2, as
-published by the Free Software Foundation.
-
-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.
-
-=head1 METHODS
-
-=cut
-
-
-use diagnostics;
-use strict;
-
-use Moose;
-
-use DateTime::TimeZone;
-use Net::DBus;
-
-use ManaTools::Shared::Locales;
-use ManaTools::Shared::Services;
-
-use MDK::Common::File qw(cat_ output_p substInFile);
-use MDK::Common::Func qw(find if_);
-
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 timezone_prefix
-
- optional parameter to set the system timezone directory,
- default value is /usr/share/zoneinfo
-
-=cut
-
-#=============================================================
-
-has 'timezone_prefix' => (
- is => 'rw',
- isa => 'Str',
- default => "/usr/share/zoneinfo",
-);
-
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 ntp_configuration_file
-
- optional parameter to set the ntp server configuration file,
- default value is /etc/[chrony|ntp].conf
-
-=cut
-
-#=============================================================
-
-has 'ntp_configuration_file' => (
- is => 'rw',
- isa => 'Str',
- builder => '_ntp_configuration_file_init',
-);
-
-sub _ntp_configuration_file_init {
- my $self = shift;
-
- if (-f "/etc/chrony.conf") {
- return "/etc/chrony.conf";
- }
- return "/etc/ntp.conf";
-}
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 ntp_conf_dir
-
- optional parameter to set ntp configuration directory,
- default value is /etc/ntp
-
-=cut
-
-#=============================================================
-
-has 'ntp_conf_dir' => (
- is => 'rw',
- isa => 'Str',
- lazy => 1,
- default => "/etc/ntp",
-);
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 ntp_program
-
- optional parameter to set the ntp program that runs into the
- system, default value is [chrony|ntp]
-
-=cut
-
-#=============================================================
-has 'ntp_program' => (
- is => 'rw',
- isa => 'Str',
- builder => '_ntp_program_init',
-);
-
-sub _ntp_program_init {
- my $self = shift;
-
- if (-f "/etc/chrony.conf") {
- return "chrony";
- }
- return "ntp";
-}
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 installer_or_livecd
-
- To inform the back-end that is working during installer or
- livecd. Useful if Time zone setting and using fix_system
- to use the real time clock (see setLocalRTC and
- writeConfiguration).
-
-=cut
-
-#=============================================================
-has 'installer_or_livecd' => (
- is => 'rw',
- isa => 'Bool',
- default => 0,
-);
-
-#=== globals ===
-
-has 'sh_services' => (
- is => 'rw',
- init_arg => undef,
- lazy => 1,
- builder => '_SharedServicesInitialize'
-);
-
-sub _SharedServicesInitialize {
- my $self = shift();
-
- $self->sh_services(ManaTools::Shared::Services->new() );
-}
-
-
-has 'dbus_timedate1_service' => (
- is => 'rw',
- init_arg => undef,
- lazy => 1,
- builder => '_dbusTimeDateInitialize'
-);
-
-sub _dbusTimeDateInitialize {
- my $self = shift();
-
- my $bus = Net::DBus->system;
- $self->dbus_timedate1_service($bus->get_service("org.freedesktop.timedate1"));
-}
-
-
-has 'dbus_timedate1_object' => (
- is => 'rw',
- init_arg => undef,
- lazy => 1,
- builder => '_dbusObjectInitialize'
-);
-
-sub _dbusObjectInitialize {
- my $self = shift();
-
- $self->dbus_timedate1_object($self->dbus_timedate1_service->get_object("/org/freedesktop/timedate1"));
-}
-
-
-has 'servername_config_suffix' => (
- is => 'ro',
- isa => 'Str',
- lazy => 1,
- builder => '_servername_config_suffix_init',
-);
-
-sub _servername_config_suffix_init {
- my $self = shift;
-
- return " iburst" if ($self->ntp_program eq "chrony");
-
- return "";
-}
-
-has 'loc' => (
- is => 'rw',
- lazy => 1,
- init_arg => undef,
- builder => '_localeInitialize'
-);
-
-sub _localeInitialize {
- my $self = shift;
-
- # TODO fix domain binding for translation
- $self->loc(ManaTools::Shared::Locales->new(domain_name => 'libDrakX') );
- # TODO if we want to give the opportunity to test locally add dir_name => 'path'
-}
-
-
-has 'ntp_servers' => (
- traits => ['Hash'],
- is => 'rw',
- isa => 'HashRef',
- lazy => 1,
- handles => {
- get_ntp_server => 'get',
- ntp_server_pairs => 'kv',
- },
- init_arg => undef,
- builder => '_buildNTPServers'
-);
-
-sub _buildNTPServers {
- my $self = shift;
-
- my %ntpServersHash;
- $ntpServersHash{"-"} = {
- $self->loc->N_("Global") => "pool.ntp.org",
- };
- $ntpServersHash{Global} = {
- $self->loc->N_("Africa") => "africa.pool.ntp.org",
- $self->loc->N_("Asia") => "asia.pool.ntp.org",
- $self->loc->N_("Europe") => "europe.pool.ntp.org",
- $self->loc->N_("North America") => "north-america.pool.ntp.org",
- $self->loc->N_("Oceania") => "oceania.pool.ntp.org",
- $self->loc->N_("South America") => "south-america.pool.ntp.org",
- };
- $ntpServersHash{Africa} = {
- $self->loc->N_("South Africa") => "za.pool.ntp.org",
- $self->loc->N_("Tanzania") => "tz.pool.ntp.org",
- };
- $ntpServersHash{Asia} = {
- $self->loc->N_("Bangladesh") => "bd.pool.ntp.org",
- $self->loc->N_("China") => "cn.pool.ntp.org",
- $self->loc->N_("Hong Kong") => "hk.pool.ntp.org",
- $self->loc->N_("India") => "in.pool.ntp.org",
- $self->loc->N_("Indonesia") => "id.pool.ntp.org",
- $self->loc->N_("Iran") => "ir.pool.ntp.org",
- $self->loc->N_("Israel") => "il.pool.ntp.org",
- $self->loc->N_("Japan") => "jp.pool.ntp.org",
- $self->loc->N_("Korea") => "kr.pool.ntp.org",
- $self->loc->N_("Malaysia") => "my.pool.ntp.org",
- $self->loc->N_("Philippines") => "ph.pool.ntp.org",
- $self->loc->N_("Singapore") => "sg.pool.ntp.org",
- $self->loc->N_("Taiwan") => "tw.pool.ntp.org",
- $self->loc->N_("Thailand") => "th.pool.ntp.org",
- $self->loc->N_("Turkey") => "tr.pool.ntp.org",
- $self->loc->N_("United Arab Emirates") => "ae.pool.ntp.org",
- };
- $ntpServersHash{Europe} = {
- $self->loc->N_("Austria") => "at.pool.ntp.org",
- $self->loc->N_("Belarus") => "by.pool.ntp.org",
- $self->loc->N_("Belgium") => "be.pool.ntp.org",
- $self->loc->N_("Bulgaria") => "bg.pool.ntp.org",
- $self->loc->N_("Czech Republic") => "cz.pool.ntp.org",
- $self->loc->N_("Denmark") => "dk.pool.ntp.org",
- $self->loc->N_("Estonia") => "ee.pool.ntp.org",
- $self->loc->N_("Finland") => "fi.pool.ntp.org",
- $self->loc->N_("France") => "fr.pool.ntp.org",
- $self->loc->N_("Germany") => "de.pool.ntp.org",
- $self->loc->N_("Greece") => "gr.pool.ntp.org",
- $self->loc->N_("Hungary") => "hu.pool.ntp.org",
- $self->loc->N_("Ireland") => "ie.pool.ntp.org",
- $self->loc->N_("Italy") => "it.pool.ntp.org",
- $self->loc->N_("Lithuania") => "lt.pool.ntp.org",
- $self->loc->N_("Luxembourg") => "lu.pool.ntp.org",
- $self->loc->N_("Netherlands") => "nl.pool.ntp.org",
- $self->loc->N_("Norway") => "no.pool.ntp.org",
- $self->loc->N_("Poland") => "pl.pool.ntp.org",
- $self->loc->N_("Portugal") => "pt.pool.ntp.org",
- $self->loc->N_("Romania") => "ro.pool.ntp.org",
- $self->loc->N_("Russian Federation") => "ru.pool.ntp.org",
- $self->loc->N_("Slovakia") => "sk.pool.ntp.org",
- $self->loc->N_("Slovenia") => "si.pool.ntp.org",
- $self->loc->N_("Spain") => "es.pool.ntp.org",
- $self->loc->N_("Sweden") => "se.pool.ntp.org",
- $self->loc->N_("Switzerland") => "ch.pool.ntp.org",
- $self->loc->N_("Ukraine") => "ua.pool.ntp.org",
- $self->loc->N_("United Kingdom") => "uk.pool.ntp.org",
- $self->loc->N_("Yugoslavia") => "yu.pool.ntp.org",
- };
- $ntpServersHash{"North America"} = {
- $self->loc->N_("Canada") => "ca.pool.ntp.org",
- $self->loc->N_("Guatemala") => "gt.pool.ntp.org",
- $self->loc->N_("Mexico") => "mx.pool.ntp.org",
- $self->loc->N_("United States") => "us.pool.ntp.org",
- };
- $ntpServersHash{Oceania} = {
- $self->loc->N_("Australia") => "au.pool.ntp.org",
- $self->loc->N_("New Zealand") => "nz.pool.ntp.org",
- };
- $ntpServersHash{"South America"} = {
- $self->loc->N_("Argentina") => "ar.pool.ntp.org",
- $self->loc->N_("Brazil") => "br.pool.ntp.org",
- $self->loc->N_("Chile") => "cl.pool.ntp.org",
- };
-
- return \%ntpServersHash;
-}
-
-
-#=============================================================
-
-=head2 get_timezone_prefix
-
-=head3 OUTPUT
-
-timezone_prefix: directory in which time zone files are
-
-=head3 DESCRIPTION
-
-Return the timezone directory (defualt: /usr/share/zoneinfo)
-
-=cut
-
-#=============================================================
-sub get_timezone_prefix {
- my $self = shift;
-
- return $self->timezone_prefix;
-}
-
-#=============================================================
-
-=head2 getTimeZones
-
-=head3 INPUT
-
- $from_system: if present and its value is not 0 checks into timezone_prefix
- directory and gets the list from there
-
-=head3 OUTPUT
-
- @l: ARRAY containing sorted time zones
-
-=head3 DESCRIPTION
-
- This method returns the available timezones
-
-=cut
-
-#=============================================================
-sub getTimeZones {
- my ($self, $from_system) = @_;
-
- if ($from_system and $from_system != 0) {
- require MDK::Common::DataStructure;
- require MDK::Common::Various;
- my $tz_prefix = $self->get_timezone_prefix();
- open(my $F, "cd $tz_prefix && find [A-Z]* -noleaf -type f |");
- my @l = MDK::Common::DataStructure::difference2([ MDK::Common::Various::chomp_(<$F>) ], [ 'ROC', 'PRC' ]);
- close $F or die "cannot list the available zoneinfos";
- return sort @l;
- }
-
- return DateTime::TimeZone->all_names;
-}
-
-#=============================================================
-
-=head2 setTimeZone
-
-=head3 INPUT
-
- $new_time_zone: New time zone to be set
-
-=head3 DESCRIPTION
-
- This method get the new time zone to set and performs
- the setting
-
-=cut
-
-#=============================================================
-sub setTimeZone {
- my ($self, $new_time_zone) = @_;
-
- die "Time zone value required" if !defined($new_time_zone);
-
- my $object = $self->dbus_timedate1_object;
- $object->SetTimezone($new_time_zone, 1);
-}
-
-#=============================================================
-
-=head2 getTimeZone
-
-=head3 OUTPUT
-
- $timezone: current time zone
-
-=head3 DESCRIPTION
-
- This method returns the current timezone setting
-
-=cut
-
-#=============================================================
-sub getTimeZone {
- my ($self) = @_;
-
- my $object = $self->dbus_timedate1_object;
-
- return $object->Get("org.freedesktop.timedate1", 'Timezone') || "";
-}
-
-
-#=============================================================
-
-=head2 setLocalRTC
-
-=head3 INPUT
-
- $enable: bool value enable/disable real time clock as
- localtime
- $fix_system: bool read or not the real time clock
-
-=head3 DESCRIPTION
-
- This method enables/disables the real time clock as
- localtime (e.g. disable means set the rtc to UTC).
- NOTE from dbus:
- Use SetLocalRTC() to control whether the RTC is in
- local time or UTC. It is strongly recommended to maintain
- the RTC in UTC. Some OSes (Windows) however maintain the
- RTC in local time which might make it necessary to enable
- this feature. However, this creates various problems as
- daylight changes might be missed. If fix_system is passed
- "true" the time from the RTC is read again and the system
- clock adjusted according to the new setting.
- If fix_system is passed "false" the system time is written
- to the RTC taking the new setting into account.
- Use fix_system=true in installers and livecds where the
- RTC is probably more reliable than the system time.
- Use fix_system=false in configuration UIs that are run during
- normal operation and where the system clock is probably more
- reliable than the RTC.
-
-=cut
-
-#=============================================================
-sub setLocalRTC {
- my ($self, $enable, $fix_system) = @_;
-
- die "Localtime enable/disable value required" if !defined($enable);
-
- $fix_system = 0 if !defined($fix_system);
- my $object = $self->dbus_timedate1_object;
- $object->SetLocalRTC($enable, $fix_system, 1) ;
-}
-
-#=============================================================
-
-=head2 getLocalRTC
-
-=head3 OUTPUT
-
- $localRTC: 1 if RTC is localtime 0 for UTC
-
-=head3 DESCRIPTION
-
- This method returns the RTC localtime setting
-
-=cut
-
-#=============================================================
-sub getLocalRTC {
- my $self = shift;
-
- my $object = $self->dbus_timedate1_object;
-
- return $object->Get("org.freedesktop.timedate1", 'LocalRTC') ? 1 : 0;
-}
-
-
-#=============================================================
-
-=head2 setTime
-
-=head3 INPUT
-
- $sec_since_epoch: Time in seconds since 1/1/1970
-
-=head3 DESCRIPTION
-
- This method set the system time and sets the RTC also
-
-=cut
-
-#=============================================================
-sub setTime {
- my ($self, $sec_since_epoch) = @_;
-
- die "second since epoch required" if !defined($sec_since_epoch);
-
- my $object = $self->dbus_timedate1_object;
- my $usec = $sec_since_epoch* 1000000;
-
- $object->SetTime($usec, 0, 1);
-}
-
-#=============================================================
-
-=head2 readConfiguration
-
-=head3 OUTPUT
-
- hash reference containing:
- UTC => HW clock is set as UTC
- ZONE => Time Zone set
-
-=head3 DESCRIPTION
-
- This method returns the time zone system settings as hash
- reference
-
-=cut
-
-#=============================================================
-sub readConfiguration {
- my $self = shift;
-
- my $prefs = {};
- $prefs->{'ZONE'} = $self->getTimeZone();
- $prefs->{'UTC'} = $self->getLocalRTC() ? 0 : 1;
-
- return $prefs;
-}
-
-
-#=============================================================
-
-=head2 writeConfiguration
-
-=head3 INPUT
-
- $info: hash containing:
- UTC => HW clock is set as UTC
- ZONE => Time Zone
-
-=head3 DESCRIPTION
-
- This method sets the passed Time Zone configuration.
- If installer_or_livecd attribute is set fix_system is
- passed to setLocalRTC
-
-=cut
-
-#=============================================================
-sub writeConfiguration {
- my ($self, $info) = @_;
-
- die "UTC field required" if !defined($info->{UTC});
- die "ZONE field required" if !defined($info->{ZONE});
-
- my $localRTC = $info->{UTC} ? 0 : 1;
- $self->setLocalRTC(
- $localRTC,
- $self->installer_or_livecd
- );
-
- $self->setTimeZone(
- $info->{ZONE}
- );
-}
-
-
-#left for back compatibility
-sub _get_ntp_server_tree {
- my ($self, $zone) = @_;
- $zone = "-" if ! $zone;
- my $ns = $self->get_ntp_server($zone);
- return if !$ns;
-
- map {
- $ns->{$_} => (
- $self->get_ntp_server($_) ?
- $zone ?
- $self->loc->N($_) . "|" . $self->loc->N("All servers") :
- $self->loc->N("All servers") :
- $self->loc->N($zone) . "|" . $self->loc->N($_)
- ),
- $self->_get_ntp_server_tree($_)
- } keys %{$ns};
-}
-
-#=============================================================
-
-=head2 ntpServers
-
-=head3 OUTPUT
-
- HASHREF containing ntp_server => zone info
-
-=head3 DESCRIPTION
-
- This method returns an hash ref containing pairs ntp-server, zone
-
-=cut
-
-#=============================================================
-sub ntpServers {
- my ($self) = @_;
- # FIXME: missing parameter:
- +{$self->_get_ntp_server_tree()};
-}
-
-
-#=============================================================
-
-=head2 ntpCurrentServer
-
-=head3 INPUT
-
-Input_Parameter: in_par_description
-
-=head3 DESCRIPTION
-
-Returns the current ntp server address read from configuration file
-
-=cut
-
-#=============================================================
-
-sub ntpCurrentServer {
- my $self = shift;
-
- MDK::Common::Func::find { $_ ne '127.127.1.0' } map { MDK::Common::Func::if_(/^\s*server\s+(\S*)/, $1) } MDK::Common::File::cat_($self->ntp_configuration_file);
-}
-
-#=============================================================
-
-=head2 isNTPRunning
-
-=head3 DESCRIPTION
-
- This method just returns if the given ntp server is running
-
-=cut
-
-#=============================================================
-sub isNTPRunning {
- my $self = shift;
-
- # TODO is that valid for any ntp program? adding ntp_service_name parameter
- my $ntpd = $self->ntp_program . 'd';
-
- return $self->sh_services->is_service_running($ntpd);
-}
-
-#=============================================================
-
-=head2 setNTPServer
-
-=head3 INPUT
-
-$server: server address to be configured
-
-=head3 DESCRIPTION
-
-This method writes into NTP configuration file new server address
-settings
-
-=cut
-
-#=============================================================
-sub setNTPServer {
- my ($self, $server) = @_;
-
- my $f = $self->ntp_configuration_file;
- -f $f or return;
- return if (!$server);
-
- # TODO is that valid for any ntp program? adding ntp_service_name parameter
- my $ntpd = $self->ntp_program . 'd';
-
- ManaTools::Shared::disable_x_screensaver();
- if ($self->isNTPRunning()) {
- $self->sh_services->stopService($ntpd);
- }
-
- my $pool_match = qr/\.pool\.ntp\.org$/;
- my @servers = $server =~ $pool_match ? (map { "$_.$server" } 0 .. 2) : $server;
-
- my $added = 0;
- my $servername_config_suffix = $self->servername_config_suffix ? $self->servername_config_suffix : " ";
- MDK::Common::File::substInFile {
- if (/^#?\s*server\s+(\S*)/ && $1 ne '127.127.1.0') {
- $_ = $added ? $_ =~ $pool_match ? undef : "#server $1\n" : join('', map { "server $_$servername_config_suffix\n" } @servers);
- $added = 1;
- }
- } $f;
- if ($self->ntp_program eq "ntp") {
- my $ntp_prefix = $self->ntp_conf_dir;
- MDK::Common::File::output_p("$ntp_prefix/step-tickers", join('', map { "$_\n" } @servers));
- }
-
- # enable but do not start the service
- $self->sh_services->set_status($ntpd, 1, 1);
- if ($ntpd eq "chronyd") {
- $self->sh_services->startService($ntpd);
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- # Wait up to 30s for sync
- system('/usr/bin/chronyc', 'waitsync', '30', '0.1');
- } else {
- $ENV{PATH} = "/usr/bin:/usr/sbin";
- system('/usr/sbin/ntpdate', $server);
- $self->sh_services->startService($ntpd);
- }
-
- ManaTools::Shared::enable_x_screensaver();
-}
-
-#=============================================================
-
-=head2 disableAndStopNTP
-
-=head3 DESCRIPTION
-
- Disable and stop the ntp server
-
-=cut
-
-#=============================================================
-sub disableAndStopNTP {
- my $self = shift;
-
- # TODO is that valid for any ntp program? adding ntp_service_name parameter
- my $ntpd = $self->ntp_program . 'd';
-
- # also stop the service without dont_apply parameter
- $self->sh_services->set_status($ntpd, 0);
-}
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-
-1;
-
-
diff --git a/lib/AdminPanel/Shared/Users.pm b/lib/AdminPanel/Shared/Users.pm
deleted file mode 100644
index 83c6061c..00000000
--- a/lib/AdminPanel/Shared/Users.pm
+++ /dev/null
@@ -1,1612 +0,0 @@
-# vim: set et ts=4 sw=4:
-package ManaTools::Shared::Users;
-#============================================================= -*-perl-*-
-
-=head1 NAME
-
-ManaTools::Shared::Users - backend to manage users
-
-=head1 SYNOPSIS
-
- my $userBackEnd = ManaTools::Shared::Users->new();
- my $userInfo = $userManager->getUserInfo('username');
-
-=head1 DESCRIPTION
-
-This module gives a low level access to the system user management it uses libUSER module.
-
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command:
-
-perldoc ManaTools::Shared::Users
-
-=head1 SEE ALSO
-
-libUSER
-
-=head1 AUTHOR
-
-Angelo Naselli <anaselli@linux.it>
-
-=head1 COPYRIGHT and LICENSE
-
-Copyright (C) 2014-2015, Angelo Naselli.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License version 2, as
-published by the Free Software Foundation.
-
-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
-
-=head1 METHODS
-
-=cut
-
-use Moose;
-use diagnostics;
-
-use Config::Auto;
-use Data::Password::Meter;
-use IO::All;
-use File::Basename;
-use File::Copy;
-use File::Remove 'remove';
-
-## USER is from userdrake
-use USER;
-use English;
-use POSIX qw/ceil/;
-
-use ManaTools::Shared::Locales;
-use ManaTools::Shared;
-
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 face_dir
-
- optional parameter to set the system face icon directory,
- default value is /usr/share/mga/faces/
-
-=cut
-
-#=============================================================
-
-has 'face_dir' => (
- is => 'rw',
- isa => 'Str',
- default => "/usr/share/mga/faces/",
-);
-
-#=============================================================
-
-=head2 new - optional parameters
-
-=head3 user_face_dir
-
- optional parameter to set the user face icon directory,
- default value is /usr/share/mga/faces/
-
-=cut
-
-#=============================================================
-has 'user_face_dir' => (
- is => 'rw',
- isa => 'Str',
- default => "/usr/share/faces/",
-);
-
-
-has 'loc' => (
- is => 'rw',
- init_arg => undef,
- builder => '_localeInitialize'
-);
-
-
-sub _localeInitialize {
- my $self = shift();
-
- # TODO fix domain binding for translation
- $self->loc(ManaTools::Shared::Locales->new(domain_name => 'userdrake') );
- # TODO if we want to give the opportunity to test locally add dir_name => 'path'
-}
-
-## Used by USER (for getting values? TODO need explanations, where?)
-has 'USER_GetValue' => (
- default => -65533,
- is => 'ro',
- isa => 'Int',
- init_arg => undef,
-);
-
-## Used by USER (for getting values? TODO need explanations, where?)
-has 'ctx' => (
- is => 'ro',
- init_arg => undef,
- builder => '_USERInitialize',
-);
-
-sub _USERInitialize {
- my $self = shift;
-
- # $EUID: effective user identifier
- if ($EUID == 0) {
- return USER::ADMIN->new;
- }
-
- return undef;
-}
-
-## min (custom) UID was 500 now is 1000, let's change in a single point
-has 'min_UID' => (
- default => 1000,
- is => 'ro',
- isa => 'Int',
- init_arg => undef,
-);
-
-## min (custom) GID was 500 now should be 1000 as for users
-has 'min_GID' => (
- default => 1000,
- is => 'ro',
- isa => 'Int',
- init_arg => undef,
-);
-
-#=============================================================
-
-=head2 BUILD
-
-=head3 INPUT
-
- $self: this object
-
-=head3 DESCRIPTION
-
- The BUILD method is called after a Moose object is created,
- Into this method new optional parameters are tested once,
- instead of into any other methods.
-
-=cut
-
-#=============================================================
-sub BUILD {
- my $self = shift;
-
- die "Missing face directory" if (! -d $self->face_dir);
- die "Missing user face directory" if (! -d $self->user_face_dir);
-
- $self->face_dir($self->face_dir . "/") if (substr($self->face_dir, -1) ne "/");
- $self->user_face_dir($self->user_face_dir . "/") if (substr($self->user_face_dir, -1) ne "/");
-
-}
-
-
-=head2 facedir
-
-=head3 OUTPUT
-
- path to directory containing face icon
-
-=head3 DESCRIPTION
-
- Return the directory containing face icons.
-
-=cut
-
-#=============================================================
-
-sub facedir {
- my $self = shift;
-
- return $self->face_dir;
-}
-
-
-#=============================================================
-
-=head2 userfacedir
-
-=head3 OUTPUT
-
- path to directory containing user face icons
-
-=head3 DESCRIPTION
-
- Return the directory containing user face icons.
-
-=cut
-
-#=============================================================
-
-sub userfacedir {
- my $self = shift;
-
- return $self->user_face_dir;
-}
-
-
-#=============================================================
-
-=head2 face2png
-
-=head3 INPUT
-
- $face: face icon name (usually username)
-
-=head3 OUTPUT
-
- pathname to $face named icon with png extension
-
-=head3 DESCRIPTION
-
- This method returns the face icon pathname related to username
-
-=cut
-
-#=============================================================
-
-sub face2png {
- my ($self, $face) = @_;
-
- return $self->face_dir . $face . ".png" if $face;
-}
-
-#=============================================================
-
-=head2 facenames
-
-
-=head3 OUTPUT
-
- $namelist: ARRAY reference containing the face name list
-
-=head3 DESCRIPTION
-
- Retrieves the list of icon name from facesdir()
-
-=cut
-
-#=============================================================
-
-sub facenames {
- my $self = shift;
-
- my $dir = $self->face_dir;
- my @files = io->dir($dir)->all_files;
- my @l = grep { /^[A-Z]/ } @files;
- my @namelist = map { my $f = fileparse($_->filename, qr/\Q.png\E/) } (@l ? @l : @files);
-
- return \@namelist;
-}
-
-#=============================================================
-
-=head2 addKdmIcon
-
-=head3 INPUT
-
- $user: username to add
- $icon: chosen icon for username $user
-
-
-=head3 DESCRIPTION
-
- Add a $user named icon to $self->user_face_dir. It just copies
- $icon to $self->user_face_dir, naming it as $user
-
-=cut
-
-#=============================================================
-
-sub addKdmIcon {
- my ($self, $user, $icon) = @_;
-
- if ($icon && $user) {
- my $icon_name = $self->face_dir . $icon . ".png";
- my $dest = $self->user_face_dir . $user . ".png";
-
- eval { copy($icon_name, $dest) } ;
- }
-}
-
-#=============================================================
-
-=head2 removeKdmIcon
-
-=head3 INPUT
-
- $user: username icon to remove
-
-=head3 DESCRIPTION
-
- Remove a $user named icon from $self->user_face_dir
-
-=cut
-
-#=============================================================
-sub removeKdmIcon {
- my ($self, $user) = @_;
-
- if ($user) {
- my $icon_name = $self->user_face_dir . $user . ".png";
- eval { remove($icon_name) } ;
- }
-}
-
-
-#=============================================================
-
-=head2 _valid
-
-=head3 INPUT
-
- $name: User or Group name
- $name_length: Max length of $name (default 32)
-
-=head3 OUTPUT
-
- 1, locale "Ok" if valid
- 0, and explanation string if not valid:
- - Name field is empty please provide a name
- - The name must contain only lower cased latin letters, numbers, '.', '-' and '_'
- - Name is too long
-
-=head3 DESCRIPTION
-
- this internal method return if a name is compliant to
- a group or user name.
-
-=cut
-
-#=============================================================
-
-sub _valid {
- my ($self, $name, $name_length) = @_;
-
- return (0, $self->loc->N("Name field is empty please provide a name")) if (!$name );
-
- $name_length = 32 if !$name_length;
-
- $name =~ /^[a-z]+?[a-z0-9_\-\.]*?$/ or do {
- return (0, $self->loc->N("The name must start with a letter and contain only lower cased latin letters, numbers, '.', '-' and '_'"));
- };
-
- return (0, $self->loc->N("Name is too long. Maximum length is %d", $name_length)) if (! (length($name) <= $name_length));
-
- return (1, $self->loc->N("Ok"));
-}
-
-#=============================================================
-
-=head2 valid_username
-
-=head3 INPUT
-
- $username: user name to check
-
-=head3 OUTPUT
-
- 1 if valid, 0 if not (see _valid)
-
-=head3 DESCRIPTION
-
- Checks the valididty of the string $username
-
-=cut
-
-#=============================================================
-
-sub valid_username {
- my ($self, $username) = @_;
-
- return $self->_valid($username, 32);
-}
-
-#=============================================================
-
-=head2 valid_groupname
-
-=head3 INPUT
-
- $groupname: user name to check
-
-=head3 OUTPUT
-
- 1 if valid, 0 if not (see _valid)
-
-=head3 DESCRIPTION
-
- Checks the valididty of the string $groupname
-
-=cut
-
-#=============================================================
-sub valid_groupname {
- my ($self, $groupname) = @_;
-
- return $self->_valid($groupname, 16);
-}
-
-
-#=============================================================
-
-=head2 updateOrDelUsersInGroup
-
-=head3 INPUT
-
- $name: username
-
-=head3 DESCRIPTION
-
- Fixes user deletion into groups.
-
-=cut
-
-#=============================================================
-sub updateOrDelUserInGroup {
- my ($self, $name) = @_;
- my $groups = $self->ctx->GroupsEnumerateFull;
- foreach my $g (@$groups) {
- my $members = $g->MemberName(1, 0);
- if (ManaTools::Shared::inArray($name, $members)) {
- eval { $g->MemberName($name, 2) };
- eval { $self->ctx->GroupModify($g) };
- }
- }
-}
-
-
-#=============================================================
-
-=head2 getGoups
-
-=head3 OUTPUT
-
- $groups: ARRAY reference containing all the groups
-
-=head3 DESCRIPTION
-
- This method return the configured groups
-
-=cut
-
-#=============================================================
-sub getGoups {
- my $self = shift;
-
- return $self->ctx->GroupsEnumerate;
-}
-
-
-#=============================================================
-
-=head2 groupNameExists
-
-=head3 INPUT
-
- $groupname: the name of the group to check
-
-=head3 OUTPUT
-
- if group exists
-
-=head3 DESCRIPTION
-
- This method return if a given group exists
-
-=cut
-
-#=============================================================
-sub groupNameExists {
- my ($self, $groupname) = @_;
-
- return 0 if (!defined($groupname));
-
- return (defined($self->ctx->LookupGroupByName($groupname)));
-}
-
-#=============================================================
-
-=head2 groupIDExists
-
-=head3 INPUT
-
- $group: the id of the group to check
-
-=head3 OUTPUT
-
- if group exists
-
-=head3 DESCRIPTION
-
- This method return if a given group exists
-
-=cut
-
-#=============================================================
-sub groupIDExists {
- my ($self, $group) = @_;
-
- return 0 if (!defined($group));
-
- return (defined($self->ctx->LookupGroupById($group)));
-}
-
-
-#=============================================================
-
-=head2 groupID
-
-=head3 INPUT
-
- $groupname: group name
-
-=head3 OUTPUT
-
- groupid or undef
-
-=head3 DESCRIPTION
-
- This method returns the group id for the group name
-
-=cut
-
-#=============================================================
-sub groupID {
- my ($self, $groupname) = @_;
-
- my $gr = $self->ctx->LookupGroupByName($groupname);
- return $gr->Gid($self->USER_GetValue) if ($gr);
-
- return undef;
-}
-
-#=============================================================
-
-=head2 groupName
-
-=head3 INPUT
-
- $gid group identifier
-
-=head3 OUTPUT
-
- group name or undef
-
-=head3 DESCRIPTION
-
- This method returns the group name for the given group
- identifier
-
-=cut
-
-#=============================================================
-sub groupName {
- my ($self, $gid) = @_;
-
- my $gr = $self->ctx->LookupGroupById($gid);
- return $gr->GroupName($self->USER_GetValue) if ($gr);
-
- return undef;
-}
-
-
-#=============================================================
-
-=head2 addGroup
-
-=head3 INPUT
-
- $params: HASH reference containing:
- groupname => name of teh group to be added
- gid => group id of the group to be added
- is_system => is a system group?
-
-=head3 OUTPUT
-
- $gid the actual group id
-
-=head3 DESCRIPTION
-
- This method add a group to system
-
-=cut
-
-#=============================================================
-sub addGroup {
- my ($self, $params) = @_;
-
- my $is_system = defined($params->{is_system}) ?
- $params->{is_system} :
- 0;
-
- return -1 if !defined($params->{groupname});
-
- my $groupEnt = $self->ctx->InitGroup($params->{groupname}, $is_system);
-
- return -1 if !defined($groupEnt);
-
- $groupEnt->Gid($params->{gid}) if defined($params->{gid});
-
- $self->ctx->GroupAdd($groupEnt);
-
- return $groupEnt->Gid($self->USER_GetValue);
-}
-
-#=============================================================
-
-=head2 groupMembers
-
-=head3 INPUT
-
- $groupname: The group name
-
-=head3 OUTPUT
-
- $members: ARRAY reference containing all the user belonging
- to the given $groupname
-
-=head3 DESCRIPTION
-
- This method gets the group name and returns the users
- belonging to it
-
-=cut
-
-#=============================================================
-sub groupMembers {
- my ($self, $groupname) = @_;
-
- return $groupname if !defined($groupname);
-
- my $members = $self->ctx->EnumerateUsersByGroup($groupname);
-
- return $members;
-}
-
-
-#=============================================================
-
-=head2 isPrimaryGroup
-
-=head3 INPUT
-
- $groupname: the name of the group
-
-=head3 OUTPUT
-
- $username: undef if it is primary group or the username for
- which the group is the primary one.
-
-=head3 DESCRIPTION
-
- This methods check if the given group name is primary group
- for any users belonging to the group
-
-=cut
-
-#=============================================================
-sub isPrimaryGroup {
- my ($self, $groupname) = @_;
-
- return $groupname if !defined($groupname);
-
- my $groupEnt = $self->ctx->LookupGroupByName($groupname);
- my $members = $self->ctx->EnumerateUsersByGroup($groupname);
- foreach my $username (@$members) {
- my $userEnt = $self->ctx->LookupUserByName($username);
- if ($userEnt && $userEnt->Gid($self->USER_GetValue) == $groupEnt->Gid($self->USER_GetValue)) {
- return $username;
- }
- }
- return undef;
-}
-
-
-#=============================================================
-
-=head2 deleteGroup
-
-=head3 INPUT
-
- $groupname: in_par_description
-
-=head3 OUTPUT
-
- 0: if error occurred
- 1: if removed
-
-=head3 DESCRIPTION
-
- This method remove the group from the system
-
-=cut
-
-#=============================================================
-sub deleteGroup {
- my ($self, $groupname) = @_;
-
- return 0 if !defined($groupname);
-
- my $groupEnt = $self->ctx->LookupGroupByName($groupname);
- eval { $self->ctx->GroupDel($groupEnt) };
- return 0 if $@;
-
- return 1;
-}
-
-
-
-#=============================================================
-
-=head2 modifyGroup
-
-=head3 INPUT
-
- $groupInfo: HASH reference containing:
- old_groupname => old name of the group (if renaming)
- groupname => group name
- members => users belonging to the group
-
-=head3 OUTPUT
-
- $retval => HASH reference
- status => 1 (ok) 0 (error)
- error => error message if status is 0
-
-=head3 DESCRIPTION
-
- This method modifies the group groupname
-
-=cut
-
-#=============================================================
-sub modifyGroup {
- my ($self, $groupInfo) = @_;
-
- die "group name is mandatory" if !defined($groupInfo->{groupname});
-
- my $groupEnt = defined($groupInfo->{old_groupname}) ?
- $self->ctx->LookupGroupByName($groupInfo->{old_groupname}) :
- $self->ctx->LookupGroupByName($groupInfo->{groupname});
-
- my $orig_groupname = $groupInfo->{groupname};
- if (defined($groupInfo->{old_groupname}) &&
- $groupInfo->{old_groupname} ne $groupInfo->{groupname}) {
- $groupEnt->GroupName($groupInfo->{groupname});
- $orig_groupname = $groupInfo->{old_groupname};
- }
-
- my $members = $groupInfo->{members};
- my $gid = $groupEnt->Gid($self->USER_GetValue);
- my $users = $self->getUsers();
- my @susers = sort(@{$users});
-
- foreach my $user (@susers) {
- my $uEnt = $self->ctx->LookupGroupByName($user);
- if ($uEnt) {
- my $ugid = $uEnt->Gid($self->USER_GetValue);
- my $m = $self->ctx->EnumerateUsersByGroup($orig_groupname);
- if (MDK::Common::DataStructure::member($user, @{$members})) {
- if (!ManaTools::Shared::inArray($user, $m)) {
- if ($ugid != $gid) {
- eval { $groupEnt->MemberName($user, 1) };
- }
- }
- }
- else {
- if (ManaTools::Shared::inArray($user, $m)) {
- if ($ugid == $gid) {
- return {
- status => 0,
- error =>$self->loc->N("You cannot remove user <%s> from their primary group", $user)
- };
- }
- else {
- eval { $groupEnt->MemberName($user, 2) };
- }
- }
- }
- }
- }
-
- $self->ctx->GroupModify($groupEnt);
-
- return {status => 1,};
-}
-
-#=============================================================
-
-=head2 getGroupsInfo
-
- $options: HASH reference containing
- groupname_filter => groupname search string
- filter_system => hides system groups
-
-=head3 OUTPUT
-
- $groupsInfo: HASH reference containing
- groupname-1 => {
- gid => group identifier
- members => ARRAY of username
- }
- groupname-2 => {
- ...
- }
-
-=head3 DESCRIPTION
-
- This method get group information (all groups or the
- filtered ones)
-
-=cut
-
-#=============================================================
-sub getGroupsInfo {
- my ($self, $options) = @_;
-
- my $groupsInfo = {};
- return $groupsInfo if !defined $self->ctx;
-
- my $strfilt = $options->{groupname_filter} if exists($options->{groupname_filter});
- my $filtergroups = $options->{filter_system} if exists($options->{filter_system});
-
- my $groups = $self->ctx->GroupsEnumerateFull;
-
- my @GroupReal;
- LOOP: foreach my $g (@{$groups}) {
- my $gid = $g->Gid($self->USER_GetValue);
- next LOOP if $filtergroups && $gid <= 499 || $gid == 65534;
- if ($filtergroups && $gid > 499 && $gid < $self->min_GID) {
- my $groupname = $g->GroupName($self->USER_GetValue);
- my $l = $self->ctx->LookupUserByName($groupname);
- if (!defined($l)) {
- my $members = $self->ctx->EnumerateUsersByGroup($groupname);
- next LOOP if !scalar(@{$members});
- foreach my $username (@$members) {
- my $userEnt = $self->ctx->LookupUserByName($username);
- next LOOP if $userEnt->HomeDir($self->USER_GetValue) =~ /^\/($|var\/|run\/)/ || $userEnt->LoginShell($self->USER_GetValue) =~ /(nologin|false)$/;
- }
- }
- else {
- next LOOP if $l->HomeDir($self->USER_GetValue) =~ /^\/($|var\/|run\/)/ || $l->LoginShell($self->USER_GetValue) =~ /(nologin|false)$/;
- }
- }
- push @GroupReal, $g if $g->GroupName($self->USER_GetValue) =~ /^\Q$strfilt/;
- }
-
- foreach my $g (@GroupReal) {
- my $groupname = $g->GroupName($self->USER_GetValue);
- my $u_b_g = $self->ctx->EnumerateUsersByGroup($groupname);
- my $group_id = $g->Gid($self->USER_GetValue);
-
- $groupsInfo->{"$groupname"} = {
- gid => $group_id,
- members => $u_b_g,
- };
- }
-
- return $groupsInfo;
-}
-
-#=============================================================
-
-=head2 getUsers
-
-=head3 OUTPUT
-
- $users: ARRAY reference containing all the users
-
-=head3 DESCRIPTION
-
- This method return the configured users
-
-=cut
-
-#=============================================================
-sub getUsers {
- my $self = shift;
-
- return $self->ctx->UsersEnumerate;
-}
-
-#=============================================================
-
-=head2 getUserInfo
-
-=head3 INPUT
-
- $username: user name
-
-=head3 OUTPUT
-
- $userInfo: HASH reference containing
- {
- uid => user identifier
- gid => group identifier
- fullname => user full name
- home => home directory
- shell => user shell
- expire => shadow expire time
- locked => is locked?
- exp_min => shadow Min
- exp_max => shadow Max
- exp_warn => shadow Warn
- exp_inact => shadow Inact
- last_change => Shadow last change
- members => groups the user belongs to
- }
-
-=head3 DESCRIPTION
-
- This method get all the information for the given user
-
-=cut
-
-#=============================================================
-sub getUserInfo {
- my ($self, $username) = @_;
-
- my $userInfo = {};
- return $userInfo if !defined $self->ctx;
-
- my $userEnt = $self->ctx->LookupUserByName($username);
- return $userInfo if !defined($userEnt);
-
- my $fullname = $userEnt->Gecos($self->USER_GetValue);
- utf8::decode($fullname);
- $userInfo->{fullname} = $fullname;
- $userInfo->{shell} = $userEnt->LoginShell($self->USER_GetValue);
- $userInfo->{home} = $userEnt->HomeDir($self->USER_GetValue);
- $userInfo->{uid} = $userEnt->Uid($self->USER_GetValue);
- $userInfo->{gid} = $userEnt->Gid($self->USER_GetValue);
- $userInfo->{expire} = $userEnt->ShadowExpire($self->USER_GetValue);
- $userInfo->{locked} = $self->ctx->IsLocked($userEnt);
-
- $userInfo->{exp_min} = $userEnt->ShadowMin($self->USER_GetValue);
- $userInfo->{exp_max} = $userEnt->ShadowMax($self->USER_GetValue);
- $userInfo->{exp_warn} = $userEnt->ShadowWarn($self->USER_GetValue);
- $userInfo->{exp_inact} = $userEnt->ShadowInact($self->USER_GetValue);
- $userInfo->{last_change} = $userEnt->ShadowLastChange($self->USER_GetValue);
- $userInfo->{members} = $self->ctx->EnumerateGroupsByUser($username);
-
- return $userInfo;
-}
-
-#=============================================================
-
-=head2 getUsersInfo
-
-=head3 INPUT
-
- $options: HASH reference containing
- username_filter => username search string
- filter_system => hides system users
-
-=head3 OUTPUT
-
- $usersInfo: HASH reference containing
- username-1 => {
- uid => user identifier
- group => primary group name
- gid => group identifier
- fullname => user full name
- home => home directory
- shell => user shell
- status => login status (locked, expired, etc)
- }
- username-2 => {
- ...
- }
-
-=head3 DESCRIPTION
-
- This method get user information (all users or filtered ones)
-
-=cut
-
-#=============================================================
-sub getUsersInfo {
- my ($self, $options) = @_;
-
- my $usersInfo = {};
- return $usersInfo if !defined $self->ctx;
-
- my $strfilt = $options->{username_filter} if exists($options->{username_filter});
- my $filterusers = $options->{filter_system} if exists($options->{filter_system});
-
- my ($users, $group, $groupnm, $expr);
- $users = $self->ctx->UsersEnumerateFull;
-
- my @UserReal;
- LOOP: foreach my $l (@{$users}) {
- my $uid = $l->Uid($self->USER_GetValue);
- next LOOP if $filterusers && $uid <= 499 || $uid == 65534;
- next LOOP if $filterusers && $uid > 499 && $uid < $self->min_UID &&
- ($l->HomeDir($self->USER_GetValue) =~ /^\/($|var\/|run\/)/ || $l->LoginShell($self->USER_GetValue) =~ /(nologin|false)$/);
- push @UserReal, $l if $l->UserName($self->USER_GetValue) =~ /^\Q$strfilt/;
- }
- my $i;
- my $itemColl = new yui::YItemCollection;
- foreach my $l (@UserReal) {
- $i++;
- my $uid = $l->Uid($self->USER_GetValue);
- if (!defined $uid) {
- warn "bogus user at line $i\n";
- next;
- }
- my $gid = $l->Gid($self->USER_GetValue);
- $group = $self->ctx->LookupGroupById($gid);
- $groupnm = '';
- $expr = $self->computeLockExpire($l);
- $group and $groupnm = $group->GroupName($self->USER_GetValue);
- my $fulln = $l->Gecos($self->USER_GetValue);
- utf8::decode($fulln);
- my $username = $l->UserName($self->USER_GetValue);
- my $shell = $l->LoginShell($self->USER_GetValue);
- my $homedir = $l->HomeDir($self->USER_GetValue);
- $usersInfo->{"$username"} = {
- uid => $uid,
- group => $groupnm,
- gid => $gid,
- fullname => $fulln,
- home => $homedir,
- status => $expr,
- shell => $shell,
- };
- }
-
- return $usersInfo;
-}
-
-#=============================================================
-
-=head2 getUserHome
-
-=head3 INPUT
-
- $username: given user name
-
-=head3 OUTPUT
-
- $homedir: user home directory
-
-=head3 DESCRIPTION
-
- This method return the home directory belonging to the given
- username
-
-=cut
-
-#=============================================================
-sub getUserHome {
- my ($self, $username) = @_;
-
- return $username if !defined($username);
-
- my $userEnt = $self->ctx->LookupUserByName($username);
- my $homedir = $userEnt->HomeDir($self->USER_GetValue);
-
- return $homedir;
-}
-
-#=============================================================
-
-=head2 userNameExists
-
-=head3 INPUT
-
- $username: the name of the user to check
-
-=head3 OUTPUT
-
- if user exists
-
-=head3 DESCRIPTION
-
- This method return if a given user exists
-
-=cut
-
-#=============================================================
-sub userNameExists {
- my ($self, $username) = @_;
-
- return 0 if (!defined($username));
-
- return (defined($self->ctx->LookupUserByName($username)));
-}
-
-#=============================================================
-
-=head2 computeLockExpire
-
-=head3 INPUT
-
- $l: login user info
-
-=head3 OUTPUT
-
- $status: Locked, Expired, or empty string
-
-=head3 DESCRIPTION
-
- This method returns if the login is Locked, Expired or ok.
- Note this function is meant for internal use only
-
-=cut
-
-#=============================================================
-sub computeLockExpire {
- my ( $self, $l ) = @_;
- my $ep = $l->ShadowExpire($self->USER_GetValue);
- my $tm = ceil(time()/(24*60*60));
- $ep = -1 if int($tm) <= $ep;
- my $status = $self->ctx->IsLocked($l) ? $self->loc->N("Locked") : ($ep != -1 ? $self->loc->N("Expired") : '');
- return $status;
-}
-
-#=============================================================
-
-=head2 addUser
-
-=head3 INPUT
-
- $params: HASH reference containing:
- username => name of teh user to be added
- uid => user id of the username to be added
- is_system => is a system user?
- homedir => user home directory
- donotcreatehome => do not create the home directory
- shell => user shall
- fullname => user full name
- gid => group id for the user
- shadowMin => min time password validity
- shadowMax => max time password validity
- shadowInact =>
- shadowWarn =>
- password => user password
-
-=head3 OUTPUT
-
- 0 if errors 1 if ok
-
-=head3 DESCRIPTION
-
- This method add a user to system
-
-=cut
-
-#=============================================================
-sub addUser {
- my ($self, $params) = @_;
-
- return 0 if !defined($params->{username});
-
- my $is_system = defined($params->{is_system}) ?
- $params->{is_system} :
- 0;
-
- my $userEnt = $self->ctx->InitUser($params->{username}, $is_system);
- return 0 if !defined($userEnt);
-
-
- $userEnt->HomeDir($params->{homedir}) if defined($params->{homedir});
- $userEnt->Uid($params->{uid}) if defined($params->{uid});
- $userEnt->Gecos($params->{fullname}) if defined($params->{fullname});
- $userEnt->LoginShell($params->{shell}) if defined($params->{shell});
- $userEnt->Gid($params->{gid}) if defined ($params->{gid});
- my $shd = defined ($params->{shadowMin}) ? $params->{shadowMin} : -1;
- $userEnt->ShadowMin($shd);
- $shd = defined ($params->{shadowMax}) ? $params->{shadowMax} : 99999;
- $userEnt->ShadowMax($shd);
- $shd = defined ($params->{shadowWarn}) ? $params->{shadowWarn} : -1;
- $userEnt->ShadowWarn($shd);
- $shd = defined ($params->{shadowInact}) ? $params->{shadowInact} : -1;
- $userEnt->ShadowInact($shd);
- $self->ctx->UserAdd($userEnt, $is_system, $params->{donotcreatehome});
- $self->ctx->UserSetPass($userEnt, $params->{password});
-
- return 1;
-}
-
-
-#=============================================================
-
-=head2 modifyUser
-
-=head3 INPUT
-
- $userInfo: HASH reference containing:
- old_username => old name of the user (if renaming)
- username => user name
- fullname => full name of teh user
- password => password
- homedir => home directory
- shell => user shell
- members => groups the user belongs to
- gid => primary group identifier
- lockuser => lock user
- acc_expires => account expire time - containing:
- exp_y => year
- exp_m => month
- exp_d => day
- password_expires => password expire time - containing:
- exp_min => min
- exp_max => max
- exp_warn => when warn
- exp_inact => when inactive
-
-=head3 DESCRIPTION
-
- This method modifies the group groupname
-
-=cut
-
-#=============================================================
-sub modifyUser {
- my ($self, $userInfo) = @_;
-
- die "user name is mandatory" if !defined($userInfo->{username});
- die "primary group identifier is mandatory" if !defined($userInfo->{gid});
- die "a valid group identifier is mandatory" if $userInfo->{gid} < 0;
-
- if (defined($userInfo->{acc_expires})) {
- die "expiring year is mandatory" if !defined($userInfo->{acc_expires}->{exp_y});
- die "expiring month is mandatory" if !defined($userInfo->{acc_expires}->{exp_m});
- die "expiring day is mandatory" if !defined($userInfo->{acc_expires}->{exp_d});
- }
- if (defined($userInfo->{password_expires})) {
- die "password expiring min is mandatory" if !($userInfo->{password_expires}->{exp_min});
- die "password expiring max is mandatory" if !($userInfo->{password_expires}->{exp_max});
- die "password expiring warn is mandatory" if !($userInfo->{password_expires}->{exp_warn});
- die "password expiring inactive is mandatory" if !($userInfo->{password_expires}->{exp_inact});
- }
- my $userEnt = defined($userInfo->{old_username}) ?
- $self->ctx->LookupUserByName($userInfo->{old_username}) :
- $self->ctx->LookupUserByName($userInfo->{username});
-
- my $orig_username = $userInfo->{username};
- if (defined($userInfo->{old_username}) &&
- $userInfo->{old_username} ne $userInfo->{username}) {
- $userEnt->UserName($userInfo->{username});
- $orig_username = $userInfo->{old_username};
- }
-
- # $userEnt->UserName($userInfo->{username});
- $userEnt->Gecos($userInfo->{fullname}) if defined($userInfo->{fullname});
- $userEnt->HomeDir($userInfo->{homedir}) if defined($userInfo->{homedir});
- $userEnt->LoginShell($userInfo->{shell}) if defined($userInfo->{shell});
-
-
- my $username = $userEnt->UserName($self->USER_GetValue);
- my $grps = $self->getGoups();
- my @sgroups = sort @{$grps};
-
- my $members = $userInfo->{members};
- foreach my $group (@sgroups) {
- my $gEnt = $self->ctx->LookupGroupByName($group);
- my $ugid = $gEnt->Gid($self->USER_GetValue);
- my $m = $gEnt->MemberName(1,0);
- if (MDK::Common::DataStructure::member($group, @$members)) {
- if (!ManaTools::Shared::inArray($username, $m) && $userInfo->{gid} != $ugid) {
- eval { $gEnt->MemberName($username, 1) };
- $self->ctx->GroupModify($gEnt);
- }
- }
- else {
- if (ManaTools::Shared::inArray($username, $m)) {
- eval { $gEnt->MemberName($username, 2) };
- $self->ctx->GroupModify($gEnt);
- }
- }
- }
-
- $userEnt->Gid($userInfo->{gid}) if defined($userInfo->{gid});
-
- if (defined($userInfo->{acc_expires})) {
- my $yr = $userInfo->{acc_expires}->{exp_y};
- my $mo = $userInfo->{acc_expires}->{exp_m};
- my $dy = $userInfo->{acc_expires}->{exp_d};
- my $Exp = _ConvTime($dy, $mo, $yr);
- $userEnt->ShadowExpire($Exp);
- }
- else {
- $userEnt->ShadowExpire(ceil(-1))
- }
- if (defined($userInfo->{password_expires})) {
- my $allowed = $userInfo->{password_expires}->{exp_min};
- my $required = $userInfo->{password_expires}->{exp_max};
- my $warning = $userInfo->{password_expires}->{exp_warn};
- my $inactive = $userInfo->{password_expires}->{exp_inact};
- $userEnt->ShadowMin($allowed);
- $userEnt->ShadowMax($required);
- $userEnt->ShadowWarn($warning);
- $userEnt->ShadowInact($inactive);
- }
- else {
- $userEnt->ShadowMin(-1);
- $userEnt->ShadowMax(99999);
- $userEnt->ShadowWarn(-1);
- $userEnt->ShadowInact(-1);
- }
-
- $self->ctx->UserSetPass($userEnt, $userInfo->{password}) if defined($userInfo->{password});
- $self->ctx->UserModify($userEnt);
-
- if ($userInfo->{lockuser}) {
- !$self->ctx->IsLocked($userEnt) and $self->ctx->Lock($userEnt);
- }
- else {
- $self->ctx->IsLocked($userEnt) and $self->ctx->UnLock($userEnt);
- }
-
- return 1;
-}
-
-
-#=============================================================
-
-=head2 deleteUser
-
-=head3 INPUT
-
- $username: username to be deleted
- $options: HASH reference containing
- clean_home => if home has to be removed
- clean_spool => if sppol has to be removed
-
-=head3 OUTPUT
-
- error string or undef if no errors occurred
-
-=head3 DESCRIPTION
-
- This method delete a user from the system.
-
-=cut
-
-#=============================================================
-sub deleteUser {
- my ($self, $username, $options) = @_;
-
- return $username if !defined($username);
-
- my $userEnt = $self->ctx->LookupUserByName($username);
-
- $self->ctx->UserDel($userEnt);
- $self->updateOrDelUserInGroup($username);
- #Let's check out the user's primary group
- my $usergid = $userEnt->Gid($self->USER_GetValue);
- my $groupEnt = $self->ctx->LookupGroupById($usergid);
- if ($groupEnt) {
- my $member = $groupEnt->MemberName(1, 0);
- # TODO check if 499 is ok nowadays
- if (scalar(@$member) == 0 && $groupEnt->Gid($self->USER_GetValue) > 499) {
- $self->ctx->GroupDel($groupEnt);
- }
- }
- if (defined($options)) {
- ## testing jusr if exists also undef is allowed
- ## as valid option
- if (exists($options->{clean_home})) {
- eval { $self->ctx->CleanHome($userEnt) };
- return $@ if $@;
- }
- if (exists($options->{clean_spool})) {
- eval { $self->ctx->CleanSpool($userEnt) };
- return $@ if $@;
- }
- }
- return undef;
-}
-
-#=============================================================
-
-=head2 getUserShells
-
-
-=head3 OUTPUT
-
- GetUserShells: from libUSER
-
-=head3 DESCRIPTION
-
- This method returns the available shell
-
-=cut
-
-#=============================================================
-
-sub getUserShells {
- my $self = shift;
-
- return $self->ctx->GetUserShells;
-}
-#=============================================================
-
-=head2 GetFaceIcon
-
-=head3 INPUT
-
- $name: icon name for the given username
- $next: if passed means getting next icon from the given $name
-
-=head3 OUTPUT
-
- $user_icon: icon name
-
-=head3 DESCRIPTION
-
- This method returns the icon for the given user ($name) or the
- following one if $next is passed
-
-=cut
-
-#=============================================================
-sub GetFaceIcon {
- my ($self, $name, $next) = @_;
- my $icons = $self->facenames();
- my $i;
- my $current_icon;
- # remove shortcut "&" from label
- $name =~ s/&// if ($name);
- my $user_icon = $self->user_face_dir . $name . ".png" if ($name);
- if ($name) {
- $user_icon = $self->face2png($name) unless(-e $user_icon);
- }
- if ($name && -e $user_icon) {
- my $current_md5 = ManaTools::Shared::md5sum($user_icon);
- my $found = 0;
- for ($i = 0; $i < scalar(@$icons); $i++) {
- if (ManaTools::Shared::md5sum($self->face2png($icons->[$i])) eq $current_md5) {
- $found = 1;
- last;
- }
- }
- if ($found) { #- current icon found in @icons, select it
- $current_icon = $icons->[$i];
- } else { #- add and select current icon in @icons
- push @$icons, $user_icon;
- $current_icon = $user_icon;
- $i = scalar(@$icons) - 1;
- }
- } else {
- #- no icon yet, select a random one
- $current_icon = $icons->[$i = rand(scalar(@$icons))];
- }
-
- if ($next) {
- $current_icon = $icons->[$i = defined $icons->[$i+1] ? $i+1 : 0];
- }
- return $current_icon;
-}
-
-
-#=============================================================
-
-=head2 strongPassword
-
-=head3 INPUT
-
- $passwd: password to be checked
-
-=head3 OUTPUT
-
- 1: if password is strong
- 0: if password is weak
-
-=head3 DESCRIPTION
-
- Check for a strong password
-
-=cut
-
-#=============================================================
-sub strongPassword {
- my ($self, $passwd, $threshold) = @_;
-
- return 0 if !$passwd;
-
- my $pwdm = $threshold ? Data::Password::Meter->new($threshold) : Data::Password::Meter->new();
-
- # Check a password
- return $pwdm->strong($passwd);
-}
-
-
-# TODO methods not tested in Users.t
-
-#=============================================================
-
-=head2 weakPasswordForSecurityLevel
-
-=head3 INPUT
-
- $passwd: password to check
-
-=head3 OUTPUT
-
- 1: if the password is too weak for security level
-
-=head3 DESCRIPTION
-
- Check the security level set if /etc/security/msec/security.conf
- exists and the level is not 'standard' and if the password
- is not at least 6 characters return true
-
-=cut
-
-#=============================================================
-sub weakPasswordForSecurityLevel {
- my ($self, $passwd) = @_;
-
- my $sec_conf_file = "/etc/security/msec/security.conf";
- if (-e $sec_conf_file) {
- my $prefs = Config::Auto::parse($sec_conf_file);
- my $level = $prefs->{BASE_LEVEL};
- if ($level eq 'none' or $level eq 'standard') {
- return 0;
- }
- elsif (length($passwd) < 6) {
- return 1;
- }
- }
-
- return 0;
-}
-
-
-#=============================================================
-
-=head2 Add2UsersGroup
-
-=head3 INPUT
-
- $name: username
-
-=head3 OUTPUT
-
- $gid: group id
-
-=head3 DESCRIPTION
-
- Adds the given username $name to 'users' group
-
-=cut
-
-#=============================================================
-sub Add2UsersGroup {
- my ($self, $name) = @_;
-
- my $usersgroup = $self->ctx->LookupGroupByName('users');
- $usersgroup->MemberName($name, 1);
- return $usersgroup->Gid($self->USER_GetValue);
-}
-
-sub _ConvTime {
- my ($day, $month, $year) = @_;
- my ($tm, $days, $mon, $yr);
- $mon = $month - 1; $yr = $year - 1900;
- $tm = POSIX::mktime(0, 0, 0, $day, $mon, $yr);
- $days = ceil($tm / (24 * 60 * 60));
- return $days;
-}
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-1;