aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ManaTools/Shared
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ManaTools/Shared')
-rw-r--r--lib/ManaTools/Shared/Firewall.pm35
-rw-r--r--lib/ManaTools/Shared/GUI.pm1118
-rw-r--r--lib/ManaTools/Shared/Hosts.pm216
-rw-r--r--lib/ManaTools/Shared/JournalCtl.pm141
-rw-r--r--lib/ManaTools/Shared/Locales.pm280
-rw-r--r--lib/ManaTools/Shared/Proxy.pm36
-rw-r--r--lib/ManaTools/Shared/RunProgram.pm352
-rw-r--r--lib/ManaTools/Shared/Services.pm955
-rw-r--r--lib/ManaTools/Shared/Shorewall.pm271
-rw-r--r--lib/ManaTools/Shared/TimeZone.pm799
-rw-r--r--lib/ManaTools/Shared/Users.pm1612
11 files changed, 5815 insertions, 0 deletions
diff --git a/lib/ManaTools/Shared/Firewall.pm b/lib/ManaTools/Shared/Firewall.pm
new file mode 100644
index 0000000..f5a6c45
--- /dev/null
+++ b/lib/ManaTools/Shared/Firewall.pm
@@ -0,0 +1,35 @@
+# 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/ManaTools/Shared/GUI.pm b/lib/ManaTools/Shared/GUI.pm
new file mode 100644
index 0000000..6c6144d
--- /dev/null
+++ b/lib/ManaTools/Shared/GUI.pm
@@ -0,0 +1,1118 @@
+# 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/ManaTools/Shared/Hosts.pm b/lib/ManaTools/Shared/Hosts.pm
new file mode 100644
index 0000000..d3b7fc9
--- /dev/null
+++ b/lib/ManaTools/Shared/Hosts.pm
@@ -0,0 +1,216 @@
+# 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/ManaTools/Shared/JournalCtl.pm b/lib/ManaTools/Shared/JournalCtl.pm
new file mode 100644
index 0000000..1194538
--- /dev/null
+++ b/lib/ManaTools/Shared/JournalCtl.pm
@@ -0,0 +1,141 @@
+# 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/ManaTools/Shared/Locales.pm b/lib/ManaTools/Shared/Locales.pm
new file mode 100644
index 0000000..ec54614
--- /dev/null
+++ b/lib/ManaTools/Shared/Locales.pm
@@ -0,0 +1,280 @@
+# 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/ManaTools/Shared/Proxy.pm b/lib/ManaTools/Shared/Proxy.pm
new file mode 100644
index 0000000..6accbb7
--- /dev/null
+++ b/lib/ManaTools/Shared/Proxy.pm
@@ -0,0 +1,36 @@
+# 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/ManaTools/Shared/RunProgram.pm b/lib/ManaTools/Shared/RunProgram.pm
new file mode 100644
index 0000000..042f559
--- /dev/null
+++ b/lib/ManaTools/Shared/RunProgram.pm
@@ -0,0 +1,352 @@
+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/ManaTools/Shared/Services.pm b/lib/ManaTools/Shared/Services.pm
new file mode 100644
index 0000000..abef8c3
--- /dev/null
+++ b/lib/ManaTools/Shared/Services.pm
@@ -0,0 +1,955 @@
+# 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/ManaTools/Shared/Shorewall.pm b/lib/ManaTools/Shared/Shorewall.pm
new file mode 100644
index 0000000..f82c542
--- /dev/null
+++ b/lib/ManaTools/Shared/Shorewall.pm
@@ -0,0 +1,271 @@
+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/ManaTools/Shared/TimeZone.pm b/lib/ManaTools/Shared/TimeZone.pm
new file mode 100644
index 0000000..efb49a2
--- /dev/null
+++ b/lib/ManaTools/Shared/TimeZone.pm
@@ -0,0 +1,799 @@
+# 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/ManaTools/Shared/Users.pm b/lib/ManaTools/Shared/Users.pm
new file mode 100644
index 0000000..83c6061
--- /dev/null
+++ b/lib/ManaTools/Shared/Users.pm
@@ -0,0 +1,1612 @@
+# 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;
generated by cgit v1.2.1 (git 2.21.0) at 2024-04-29 11:50:08 +0000