diff options
| -rw-r--r-- | Makefile.PL | 19 | ||||
| -rw-r--r-- | lib/AdminPanel/Shared.pm | 80 | ||||
| -rw-r--r-- | lib/AdminPanel/Shared/Users.pm | 564 | ||||
| -rw-r--r-- | t/02-Users.t | 36 |
4 files changed, 583 insertions, 116 deletions
diff --git a/Makefile.PL b/Makefile.PL index 20c6efc..5671918 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -22,20 +22,23 @@ WriteMakefile( 'Test::More' => 0, }, PREREQ_PM => { - #'ABC' => 1.6, - #'Foo::Bar::Module' => 5.0401, "Moose" => 0, "Config::Auto" => 0, "Config::Hosts" => 0, # AdminPanel::Shared::Locales "Locale::gettext" => 0, "Text::Iconv" => 0, - "Date::Simple" => 0, - "File::HomeDir" => 0, - "File::ShareDir" => 0, - "Data::Password::Meter" => 0, - "Modern::Perl" => 1.03, - "autodie" => 2.20, + "Date::Simple" => 0, + "File::HomeDir" => 0, + "File::ShareDir" => 0, + "File::Copy" => 0, + "File::Remove" => 0, + "File::Basename" => 0, + "Data::Password::Meter" => 0, + "Digest::MD5" => 0, + "IO::All" => 0, + "Modern::Perl" => 1.03, + "autodie" => 2.20, }, EXE_FILES => [ qw( scripts/adminMouse scripts/adminService diff --git a/lib/AdminPanel/Shared.pm b/lib/AdminPanel/Shared.pm index 5aceca1..4755b3e 100644 --- a/lib/AdminPanel/Shared.pm +++ b/lib/AdminPanel/Shared.pm @@ -78,6 +78,8 @@ use strict; use warnings; use diagnostics; +use Digest::MD5; + use lib qw(/usr/lib/libDrakX); use common qw(N N_); @@ -247,34 +249,21 @@ This function create an OK-Cancel dialog with a 'title' and a sub ask_OkCancel { my ($title, $text) = @_; my $retVal = 0; - my $factory = yui::YUI::widgetFactory; - - my $msg_box = $factory->createPopupDialog($yui::YDialogNormalColor); - my $layout = $factory->createVBox($msg_box); - - my $align = $factory->createAlignment($layout, 3, 0); - ## title with headings true - $factory->createLabel( $align, $title, 1, 0); - $align = $factory->createLeft($layout); - $factory->createLabel( $align, $text, 0, 0); - - $align = $factory->createRight($layout); - my $hbox = $factory->createHBox($align); - my $okButton = $factory->createPushButton($hbox, N("Ok")); - my $cancelButton = $factory->createPushButton($hbox, N("Cancel")); - - my $event = $msg_box->waitForEvent(); - - my $eventType = $event->eventType(); - - if ($eventType == $yui::YEvent::WidgetEvent) { - # widget selected - my $widget = $event->widget(); - $retVal = ($widget == $okButton) ? 1 : 0; - } - - destroy $msg_box; - + yui::YUI::widgetFactory; + my $factory = yui::YExternalWidgets::externalWidgetFactory("mga"); + $factory = yui::YMGAWidgetFactory::getYMGAWidgetFactory($factory); + my $dlg = $factory->createDialogBox($yui::YMGAMessageBox::B_TWO); + $dlg->setTitle($title); + $dlg->setText($text); + $dlg->setButtonLabel(N("Ok"), $yui::YMGAMessageBox::B_ONE ); + $dlg->setButtonLabel(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; } @@ -716,4 +705,39 @@ sub member { 0; } +#============================================================= + +=head2 md5sum + +=head3 INPUT + +$filename: file for md5 calculation + +=head3 OUTPUT + +md5 sum + +=head3 DESCRIPTION + + compute MD5 for the given file + +=cut + +#============================================================= + +sub md5sum { + my @files = @_; + + my @md5 = map { + my $sum; + if (open(my $FILE, $_)) { + binmode($FILE); + $sum = Digest::MD5->new->addfile($FILE)->hexdigest; + close($FILE); + } + $sum; + } @files; + return wantarray() ? @md5 : $md5[0]; +} + 1; # End of AdminPanel::Shared diff --git a/lib/AdminPanel/Shared/Users.pm b/lib/AdminPanel/Shared/Users.pm index 411f942..d7a0988 100644 --- a/lib/AdminPanel/Shared/Users.pm +++ b/lib/AdminPanel/Shared/Users.pm @@ -1,123 +1,532 @@ -package AdminPanel::Shared::Users; +# vim: set et ts=4 sw=4: +package AdminPanel::Shared::Users; +#============================================================= -*-perl-*- + +=head1 NAME + +AdminPanel::Shared::Users - backend to manage users + +=head1 SYNOPSIS + + my $userBackEnd = AdminPanel::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 AdminPanel::Shared::Users + +=head1 SEE ALSO + +libUSER + +=head1 AUTHOR + +Angelo Naselli <anaselli@linux.it> + +=head1 COPYRIGHT and LICENSE + +Copyright (C) 2014, 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 Data::Password::Meter; +use IO::All; +use File::Basename; +use File::Copy; +use File::Remove 'remove'; + +use AdminPanel::Shared::Locales; +use AdminPanel::Shared; + +use Moose; + +#============================================================= + +=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(AdminPanel::Shared::Locales->new(domain_name => 'userdrake') ); + # TODO if we want to give the opportunity to test locally add dir_name => 'path' +} + + +#============================================================= + +=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. -#-###################################################################################### -#- misc imports -#-###################################################################################### -use common; - -# use run_program; - -use base qw(Exporter); - -our @EXPORT = qw( - facesdir - face2png - facenames - addKdmIcon - valid_username - valid_groupname - GetFaceIcon - Add2UsersGroup - strongPassword - ); - -sub facesdir() { - "$::prefix/usr/share/mga/faces/"; +=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 "/"); + +} + +#============================================================= +# use base qw(Exporter); +# +# our @EXPORT = qw( +# facesdir +# face2png +# facenames +# addKdmIcon +# valid_username +# valid_groupname +# GetFaceIcon +# Add2UsersGroup +# strongPassword +# ); +#============================================================= + +=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 ($face) = @_; - facesdir() . $face . ".png"; + 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 $dir = facesdir(); - my @l = grep { /^[A-Z]/ } all($dir); - map { if_(/(.*)\.png/, $1) } (@l ? @l : all($dir)); + 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 ($user, $icon) = @_; - my $dest = "$::prefix/usr/share/faces/$user.png"; - eval { cp_af(facesdir() . $icon . ".png", $dest) } if $icon; + 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 to add + +=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 -sub valid { - return (0, N("Name field is empty please provide a name")) if (!$_[0] ); +=head3 INPUT - $_[0] =~ /^[a-z]+?[a-z0-9_\-\.]*?$/ or do { - return (0, N("The name must contain only lower cased latin letters, numbers, `.', `-' and `_'")); + $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, N("Name is too long")) if (! (length($_[0]) <= $_[1])); - return (1, N("Ok")); + + 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 { - return valid($_[0], 32); + 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 { - return valid($_[0], 16); + my ($self, $groupname) = @_; + + return $self->_valid($groupname, 16); } -################################################## -## GetFaceIcon -## params -## -## 'name' icon name for the given name -## 'next' get next icon from the given 'name' -## -## return -## 'user_icon' icon name -## + +#============================================================= + +=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 ($name, $next) = @_; - my @icons = facenames(); + my ($self, $name, $next) = @_; + my $icons = $self->facenames(); my $i; my $current_icon; # remove shortcut "&" from label $name =~ s/&// if ($name); - my $user_icon = "$::prefix/usr/share/faces/$name.png" if ($name); + my $user_icon = $self->user_face_dir . $name . ".png" if ($name); if ($name) { - $user_icon = face2png($name) unless(-e $user_icon); + $user_icon = $self->face2png($name) unless(-e $user_icon); } if ($name && -e $user_icon) { - my $current_md5 = common::md5file($user_icon); - eval { $i = find_index { common::md5file(face2png($_)) eq $current_md5 } @icons }; - if (!$@) { #- current icon found in @icons, select it - $current_icon = $icons[$i]; + my $current_md5 = AdminPanel::Shared::md5sum($user_icon); + my $found = 0; + for ($i = 0; $i < scalar(@$icons); $i++) { + if (AdminPanel::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; + push @$icons, $user_icon; $current_icon = $user_icon; - $i = @icons - 1; + $i = scalar(@$icons) - 1; } } else { #- no icon yet, select a random one - $current_icon = $icons[$i = rand(@icons)]; + $current_icon = $icons->[$i = rand(scalar(@$icons))]; } if ($next) { - $current_icon = $icons[$i = defined $icons[$i+1] ? $i+1 : 0]; + $current_icon = $icons->[$i = defined $icons->[$i+1] ? $i+1 : 0]; } return $current_icon; } -################################################## -## Add2UsersGroup -## params -## -## 'name' username -## 'ctx' USER::ADMIN object -## -## return -## gid group id -## + +#============================================================= + +=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 in Users.t +#============================================================= + +=head2 Add2UsersGroup + +=head3 INPUT + + $name: username + $ctx: USER::ADMIN object + +=head3 OUTPUT + + $gid: group id + +=head3 DESCRIPTION + +Adds the given username $name to 'users' group + +=cut + +#============================================================= sub Add2UsersGroup { - my ($name, $ctx) = @_; + my ($self, $name, $ctx) = @_; my $GetValue = -65533; ## Used by USER (for getting values? TODO need explanations, where?) my $usersgroup = $ctx->LookupGroupByName('users'); @@ -126,12 +535,7 @@ sub Add2UsersGroup { } -sub strongPassword { - my $passwd = shift; - my $pwdm = Data::Password::Meter->new(); - - # Check a password - return $pwdm->strong($passwd); -} +no Moose; +__PACKAGE__->meta->make_immutable; 1; diff --git a/t/02-Users.t b/t/02-Users.t new file mode 100644 index 0000000..4837319 --- /dev/null +++ b/t/02-Users.t @@ -0,0 +1,36 @@ +#!perl -T +use 5.006; +use strict; +use warnings FATAL => 'all'; +use Test::More; + +BEGIN { + use_ok( 'AdminPanel::Shared::Users' ) || print "Users failed!\n"; +} + + ok( my $o = AdminPanel::Shared::Users->new({user_face_dir => '/tmp'}), 'create'); + ok( my $facedir = $o->facedir(), 'facedir' ); + diag "facedir got: < " . $facedir . " >"; + ok( my $userfacedir = $o->userfacedir(), 'userfacedir' ); + diag "userfacedir got: < " . $userfacedir . " >"; + ok( my $ipathname = $o->face2png('username'), 'face2png' ); + diag "face2png for user \'username\' got: < " . $ipathname . " >"; + ok( my $facenames = $o->facenames(), 'facenames' ); + diag "facenames got: < " . scalar(@$facenames) . " elements >"; + ok( $o->addKdmIcon('username', $facenames->[0]), 'addKdmIcon' ); + + ok( my ($val, $str) = $o->valid_username('username'), 'valid_username' ); + diag "valid_username(username) got: < " . $str . " >"; + ok(($val, $str) = $o->valid_username('3D-user'), 'not_valid_username'); + diag "valid_username(3D-user) got: < " . $str . " >"; + ok( ($val, $str) = $o->valid_groupname('groupname'), 'valid_groupname' ); + diag "valid_groupname(groupname) got: < " . $str . " >"; + ok(($val, $str) = $o->valid_groupname('g1234567890123456'), 'not_valid_groupname'); + diag "valid_groupname(g1234567890123456) got: < " . $str . " >"; + ok( my $face = $o->GetFaceIcon('username', 1), 'GetFaceIcon' ); + diag "GetFaceIcon after '" . $facenames->[0] . "' got: < ". $face ." >"; + ok( $o->strongPassword('S0meWh3r3'), 'strongPassword' ); + + ok( $o->removeKdmIcon('username'), 'removeKdmIcon' ); + +done_testing; |