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