Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Projets publics
Ravada-Mirror
Commits
8c764135
Commit
8c764135
authored
May 27, 2016
by
Francesc Guasch
Browse files
LDAP add user and login works
parent
dc7f55a2
Changes
5
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
8c764135
...
...
@@ -6,4 +6,4 @@ blib
pm_to_blib
t/db
db
ldap.conf
t/ravada_
ldap.conf
docs/INSTALL.md
View file @
8c764135
...
...
@@ -9,6 +9,7 @@ Clone the sources:
##Debian
-
mysql-server
-
libauthen-passphrase-perl
-
libdbd-mysql-perl
-
libdbi-perl
-
libdbix-connector-perl
...
...
lib/Ravada.pm
View file @
8c764135
...
...
@@ -30,7 +30,6 @@ our $FILE_CONFIG = "/etc/ravada.conf";
our
$CONNECTOR
;
our
$CONFIG
=
{};
_init_config
(
$FILE_CONFIG
)
if
-
e
$FILE_CONFIG
;
_connect_dbh
();
...
...
@@ -59,9 +58,12 @@ Internal constructor
sub
BUILD
{
my
$self
=
shift
;
if
(
$self
->
config
)
{
if
(
$self
->
config
()
)
{
_init_config
(
$self
->
config
);
}
else
{
_init_config
(
$FILE_CONFIG
)
}
if
(
$self
->
connector
)
{
$CONNECTOR
=
$self
->
connector
}
else
{
...
...
lib/Ravada/Auth/LDAP.pm
View file @
8c764135
...
...
@@ -3,13 +3,20 @@ package Ravada::Auth::LDAP;
use
strict
;
use
warnings
;
use
Authen::
Passphrase
;
use
Authen::Passphrase::
SaltedDigest
;
use
Data::
Dumper
;
use
Digest::
SHA
qw(sha1_hex)
;
use
Moose
;
use
Net::
LDAP
;
use
Net::
Domain
qw(hostdomain)
;
with
'
Ravada::Auth::User
';
our
$CONFIG
=
\
$
Ravada::
CONFIG
;
our
$LDAP
;
our
$LDAP_ADMIN
;
our
$BASE
;
our
@OBJECT_CLASS
=
('
top
'
,'
organizationalPerson
'
...
...
@@ -27,8 +34,11 @@ sub BUILD {
sub
add_user
{
my
(
$name
,
$password
,
$is_admin
)
=
@_
;
_init_ldap_admin
();
my
(
$givenName
,
$sn
)
=
$name
=~
m{(\w+)\.(.*)}
;
my
$apr
=
Authen::Passphrase::
SaltedDigest
->
new
(
passphrase
=>
$password
,
algorithm
=>
"
MD5
");
my
%entry
=
(
cn
=>
$name
,
uid
=>
$name
...
...
@@ -38,10 +48,11 @@ sub add_user {
,
givenName
=>
(
$givenName
or
$name
)
,
sn
=>
(
$sn
or
$name
)
# , homeDirectory => "/home/$name"
,
userPassword
=>
$apr
->
as_rfc2307
()
);
my
$dn
=
"
cn=
$name
,
"
.
_dc_base
();
my
$mesg
=
$LDAP
->
add
(
$dn
,
attr
=>
[
%entry
]);
my
$mesg
=
$LDAP
_ADMIN
->
add
(
$dn
,
attr
=>
[
%entry
]);
if
(
$mesg
->
code
)
{
die
"
Error afegint
$name
"
.
$mesg
->
error
;
}
...
...
@@ -49,23 +60,43 @@ sub add_user {
sub
remove_user
{
my
$name
=
shift
;
my
$entry
=
_search_uid
(
$name
);
$LDAP
->
delete
(
$entry
);
_init_ldap_admin
();
my
$entry
=
search_user
(
$name
,
$LDAP_ADMIN
);
die
"
ERROR: Entry for user
$name
not found
\n
"
if
!
$entry
;
# $LDAP->delete($entry);
# warn Dumper($entry);
my
$mesg
=
$LDAP_ADMIN
->
delete
(
$entry
);
die
"
ERROR:
"
.
$mesg
->
code
.
"
:
"
.
$mesg
->
error
if
$mesg
->
code
;
# $entry->delete->update($LDAP);
}
sub
_search_uid
{
my
$username
=
shift
;
=head2 search_user
Search user by uid
my $entry = Ravada::Auth::LDAP::search_user($uid);
=cut
sub
search_user
{
my
$username
=
shift
;
_init_ldap
();
my
$ldap
=
(
shift
or
$LDAP
);
confess
"
Missing LDAP
"
if
!
$ldap
;
my
$base
=
_dc_base
();
my
$search
=
$
LDAP
->
search
(
# Search for the user
my
$search
=
$
ldap
->
search
(
# Search for the user
base
=>
$base
,
scope
=>
'
sub
',
filter
=>
"
(&(uid=
$username
))
",
attrs
=>
['
dn
']
attrs
=>
['
*
']
);
die
"
uid=
$username
not found
"
if
not
$search
->
count
;
return
if
!
$search
->
count
();
return
$search
->
entry
;
}
...
...
@@ -73,15 +104,38 @@ sub login {
my
$self
=
shift
;
my
(
$username
,
$password
)
=
(
$self
->
name
,
$self
->
password
);
my
$entry
=
_
search_u
id
(
$username
);
my
$entry
=
search_u
ser
(
$username
);
my
$user_dn
=
$entry
->
dn
;
my
$mesg
=
$LDAP
->
bind
(
$user_dn
,
password
=>
$password
);
return
1
if
!
$mesg
->
code
;
warn
"
ERROR:
"
.
$mesg
->
code
.
"
:
"
.
$mesg
->
error
.
"
: Bad credentials for
$username
";
return
;
# warn "ERROR: ".$mesg->code." : ".$mesg->error. " : Bad credentials for $username";
return
$self
->
_match_password
(
$username
,
$password
);
}
sub
_match_password
{
my
$self
=
shift
;
my
(
$cn
,
$password
)
=
@_
;
confess
"
Missing cn
"
if
!
$cn
;
confess
"
Missing password
"
if
!
$password
;
_init_ldap_admin
();
my
$user
=
search_user
(
$cn
,
$LDAP_ADMIN
);
die
"
No userPassword for
"
.
$user
->
get_value
('
uid
')
if
!
$user
->
get_value
('
userPassword
');
my
$password_ldap
=
$user
->
get_value
('
userPassword
');
warn
$user
->
get_value
('
uid
')
.
"
\n
"
.
$user
->
get_value
('
userPassword
')
.
"
\n
"
.
sha1_hex
(
$password
);
return
$user
->
get_value
('
uid
')
eq
$cn
&&
Authen::
Passphrase
->
from_rfc2307
(
$password_ldap
)
->
match
(
$password
);
}
sub
_dc_base
{
...
...
@@ -95,26 +149,42 @@ sub _dc_base {
return
$base
;
}
sub
_
ini
t_ldap
{
sub
_
connec
t_ldap
{
my
(
$cn
,
$pass
)
=
@_
;
$pass
=
''
if
!
defined
$pass
;
# TODO ping ldap and reconnect
return
$LDAP
if
$LDAP
;
my
(
$host
,
$port
)
=
('
localhost
',
389
);
$LDAP
=
Net::
LDAP
->
new
(
$host
,
port
=>
$port
,
verify
=>
'
none
')
my
$ldap
=
Net::
LDAP
->
new
(
$host
,
port
=>
$port
,
verify
=>
'
none
')
or
die
"
I can't connect to LDAP server at
$host
/
$port
: $@
";
if
(
$cn
)
{
my
$mesg
=
$
LDAP
->
bind
(
$cn
,
password
=>
$pass
);
my
$mesg
=
$
ldap
->
bind
(
$cn
,
password
=>
$pass
);
die
"
ERROR:
"
.
$mesg
->
code
.
"
:
"
.
$mesg
->
error
.
"
: Bad credentials for
$cn
\n
"
if
$mesg
->
code
;
}
return
$LDAP
;
return
$ldap
;
}
sub
_init_ldap_admin
{
return
$LDAP_ADMIN
if
$LDAP_ADMIN
;
my
(
$cn
,
$pass
);
if
(
$$CONFIG
->
{
ldap
}
)
{
(
$cn
,
$pass
)
=
(
$$CONFIG
->
{
ldap
}
->
{
cn
}
,
$$CONFIG
->
{
ldap
}
->
{
password
});
}
else
{
die
"
Missing ldap section in config file
"
.
Dumper
(
$$CONFIG
)
.
"
\n
"
}
$LDAP_ADMIN
=
_connect_ldap
(
$cn
,
$pass
);
return
$LDAP_ADMIN
;
}
sub
_init_ldap
{
return
if
$LDAP
;
$LDAP
=
_connect_ldap
();
}
sub
is_admin
{
...
...
t/65_user_ldap.t
View file @
8c764135
...
...
@@ -9,19 +9,17 @@ use YAML qw(LoadFile DumpFile);
use_ok
('
Ravada
');
use_ok
('
Ravada::Auth::LDAP
');
my
$ravada
=
Ravada
->
new
();
#connector => $test->connector);
my
$FILE_CONFIG
=
"
ldap.conf
";
my
(
$LDAP_USER
,
$LDAP_PASS
)
=
("
cn=Directory Manager
","
saysomething
");
my
$FILE_CONFIG
=
"
t/ravada_ldap.conf
";
if
(
!
-
e
$FILE_CONFIG
)
{
my
$config
=
{
cn
=>
$LDAP_USER
,
password
=>
$LDAP_PASS
};
my
(
$LDAP_USER
,
$LDAP_PASS
)
=
("
cn=Directory Manager
","
saysomething
");
my
$config
=
{
ldap
=>
{
cn
=>
$LDAP_USER
,
password
=>
$LDAP_PASS
}};
DumpFile
(
$FILE_CONFIG
,
$config
);
}
my
$config
=
LoadFile
("
ldap.conf
");
(
$LDAP_USER
,
$LDAP_PASS
)
=
(
$config
->
{
cn
}
,
$config
->
{
password
});
my
$ravada
=
Ravada
->
new
(
config
=>
'
t/ravada_ldap.conf
');
#connector => $test->connector);
my
@USERS
;
sub
test_user_fail
{
my
$user_fail
;
...
...
@@ -30,32 +28,66 @@ sub test_user_fail {
ok
(
!
$user_fail
,"
User should fail, got
"
.
Dumper
(
$user_fail
));
}
sub
test_user_
root
{
sub
test_user_
admin
{
my
(
$name
,
$pass
)
=
(
$
0
,
$$
);
Ravada::Auth::LDAP::
remove_user
(
$name
)
if
Ravada::Auth::LDAP::
search_user
(
$name
);
ok
(
!
$@
,
$@
);
my
$user
=
Ravada::Auth::LDAP::
search_user
(
$name
);
ok
(
!
$user
,"
I shouldn't find user
$name
in the LDAP server
")
or
return
;
Ravada::Auth::LDAP::
add_user
(
$name
,
$pass
,
1
);
my
$user
;
push
@USERS
,(
$name
)
;
eval
{
$user
=
Ravada::Auth::
LDAP
->
new
(
name
=>
$name
,
password
=>
$pass
)
};
diag
(
$@
);
ok
(
$user
,(
$@
or
'
Login failed
');
ok
(
$user
,(
$@
or
'
Login failed
')
)
or
return
;
ok
(
$user
->
is_admin
,"
User
"
.
$user
->
name
.
"
should be admin
"
.
Dumper
(
$user
->
{
_data
}));
}
sub
test_user
{
Ravada::Auth::LDAP::
add_user
('
mcnulty
','
jameson
');
my
$mcnulty
=
Ravada::Auth::
LDAP
->
new
(
name
=>
'
mcnulty
',
password
=>
'
jameson
');
my
$name
=
'
jimmy.mcnulty
';
if
(
Ravada::Auth::LDAP::
search_user
(
$name
)
)
{
diag
("
Removing
$name
");
Ravada::Auth::LDAP::
remove_user
(
$name
)
}
my
$user
=
Ravada::Auth::LDAP::
search_user
(
$name
);
ok
(
!
$user
,"
I shouldn't find user
$name
in the LDAP server
")
or
return
;
eval
{
Ravada::Auth::LDAP::
add_user
(
$name
,'
jameson
')
};
push
@USERS
,(
$name
);
ok
(
!
$@
,
$@
)
or
return
;
my
$mcnulty
;
eval
{
$mcnulty
=
Ravada::Auth::
LDAP
->
new
(
name
=>
$name
,
password
=>
'
jameson
')
};
ok
(
$mcnulty
)
;
ok
(
$mcnulty
,(
$@
or
"
ldap login failed for
$name
"))
or
return
;
ok
(
!
$mcnulty
->
is_admin
,"
User
"
.
$mcnulty
->
name
.
"
should not be admin
"
.
Dumper
(
$mcnulty
->
{
_data
}));
}
sub
remove_users
{
for
my
$name
(
@USERS
)
{
my
$user
=
Ravada::Auth::LDAP::
search_user
(
$name
);
next
if
!
$user
;
Ravada::Auth::LDAP::
remove_user
(
$name
);
$user
=
Ravada::Auth::LDAP::
search_user
(
$name
);
ok
(
!
$user
,"
I shouldn't find user
$name
in the LDAP server
")
or
return
;
}
}
SKIP:
{
my
$ldap
;
eval
{
$ldap
=
Ravada::Auth::LDAP::
_init_ldap
(
$LDAP_USER
,
$LDAP_PASS
)
};
eval
{
$ldap
=
Ravada::Auth::LDAP::
_init_ldap_admin
()
};
if
(
$@
=~
/Bad credentials/
)
{
diag
("
Fix admin credentials in
ldap.conf
");
diag
("
Fix admin credentials in
$FILE_CONFIG
");
}
else
{
diag
("
Skipped LDAP tests
"
.
(
$@
or
''))
if
!
$ldap
;
}
...
...
@@ -63,11 +95,10 @@ SKIP: {
skip
(
(
$@
or
"
No LDAP server found
"),
6
)
if
!
$ldap
&&
$@
!~
/Bad credentials/
;
ok
(
!
$@
)
and
do
{
eval
{
Ravada::Auth::LDAP::
remove_user
(
$
0
)
};
ok
(
!
$@
,
$@
);
test_user_root
();
test_user_admin
();
test_user_fail
();
test_user
();
# remove_users();
};
};
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment