Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Xavier Bachelot
lemonldap-ng
Commits
0a618cda
Commit
0a618cda
authored
Dec 21, 2009
by
Clément OUDOT
Browse files
Refactor DBI code in _DBI.pm and SMTP code in _SMTP.pm
parent
f5eb10e1
Changes
6
Hide whitespace changes
Inline
Side-by-side
modules/lemonldap-ng-portal/MANIFEST
View file @
0a618cda
...
...
@@ -83,6 +83,7 @@ lib/Lemonldap/NG/Portal/_Multi.pm
lib/Lemonldap/NG/Portal/_Proxy.pm
lib/Lemonldap/NG/Portal/_Remote.pm
lib/Lemonldap/NG/Portal/_SAML.pm
lib/Lemonldap/NG/Portal/_SMTP.pm
lib/Lemonldap/NG/Portal/_SOAP.pm
lib/Lemonldap/NG/Portal/_WebForm.pm
lib/Lemonldap/NG/Portal/AuthApache.pm
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/AuthDBI.pm
View file @
0a618cda
...
...
@@ -7,6 +7,7 @@ package Lemonldap::NG::Portal::AuthDBI;
use
Lemonldap::NG::Portal::
Simple
;
use
base
qw(Lemonldap::NG::Portal::_WebForm Lemonldap::NG::Portal::_DBI)
;
use
strict
;
our
$VERSION
=
'
0.1
';
...
...
@@ -43,49 +44,20 @@ sub authenticate {
return
PE_ERROR
unless
$dbh
;
# Check credentials
my
$table
=
$self
->
{
dbiAuthTable
};
my
$loginCol
=
$self
->
{
dbiAuthLoginCol
};
my
$passwordCol
=
$self
->
{
dbiAuthPasswordCol
};
my
$user
=
$self
->
{
user
};
my
$password
=
$self
->
{
password
};
# Prevent SQL injection
$user
=~
s/'/''/g
;
$password
=~
s/'/''/g
;
# Manage password hash
if
(
$self
->
{
dbiAuthPasswordHash
}
=~
/^(md5|sha|sha1)$/i
)
{
$self
->
lmLog
(
"
Using
"
.
uc
(
$self
->
{
dbiAuthPasswordHash
}
)
.
"
to hash password
",
'
debug
'
);
$password
=
uc
(
$self
->
{
dbiAuthPasswordHash
}
)
.
"
('
$password
')
";
}
else
{
$self
->
lmLog
(
"
No valid password hash, using clear text for password
",
'
debug
'
);
$password
=
"
'
$password
'
";
}
my
@rows
=
();
eval
{
my
$sth
=
$dbh
->
prepare
(
"
SELECT
$loginCol
FROM
$table
WHERE
$loginCol
='
$user
' AND
$passwordCol
=
$password
"
);
$sth
->
execute
();
@rows
=
$sth
->
fetchrow_array
();
};
if
(
$@
)
{
$self
->
lmLog
(
"
DBI error: $@
",
'
error
'
);
return
PE_ERROR
;
}
# Password hash
$password
=
$self
->
hash_password
(
$password
,
$self
->
{
dbiAuthPasswordHash
}
);
if
(
@rows
==
1
)
{
$self
->
lmLog
(
"
One row returned by SQL query
",
'
debug
'
);
my
$result
=
$self
->
check_password
(
$user
,
$password
);
if
(
$result
)
{
return
PE_OK
;
}
else
{
$self
->
lmLog
(
"
Bad password for
$user
",
'
error
'
);
return
PE_BADCREDENTIALS
;
}
}
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/PasswordDBDBI.pm
View file @
0a618cda
...
...
@@ -8,12 +8,14 @@ package Lemonldap::NG::Portal::PasswordDBDBI;
use
Lemonldap::NG::Portal::
Simple
;
use
Lemonldap::NG::Portal::
AuthDBI
;
#inherits
use
base
qw(Lemonldap::NG::Portal::_DBI)
;
use
strict
;
our
$VERSION
=
'
0.1
';
*passwordDBInit
=
*
Lemonldap::NG::Portal::AuthDBI::
authInit
;
## @apmethod int modifyPassword()
# Modify the password
# @return Lemonldap::NG::Portal constant
sub
modifyPassword
{
my
$self
=
shift
;
...
...
@@ -31,75 +33,27 @@ sub modifyPassword {
$self
->
{
dbiAuthPassword
}
);
return
PE_ERROR
unless
$dbh
;
my
$table
=
$self
->
{
dbiAuthTable
};
my
$loginCol
=
$self
->
{
dbiAuthLoginCol
};
my
$passwordCol
=
$self
->
{
dbiAuthPasswordCol
};
my
$user
=
$self
->
{
sessionInfo
}
->
{
_user
};
my
$password
;
my
$user
=
$self
->
{
sessionInfo
}
->
{
_user
};
# Check old passord
if
(
$self
->
{
oldpassword
}
)
{
# Manage password hash (TODO in _DBI.pm)
if
(
$self
->
{
dbiAuthPasswordHash
}
=~
/^(md5|sha|sha1)$/i
)
{
$self
->
lmLog
(
"
Using
"
.
uc
(
$self
->
{
dbiAuthPasswordHash
}
)
.
"
to hash password
",
'
debug
'
);
$password
=
uc
(
$self
->
{
dbiAuthPasswordHash
}
)
.
"
('
"
.
$self
->
{
oldpassword
}
.
"
')
";
}
else
{
$self
->
lmLog
(
"
No valid password hash, using clear text for password
",
'
debug
'
);
$password
=
"
'
"
.
$self
->
{
oldpassword
}
.
"
'
";
}
my
$sth
=
$dbh
->
prepare
(
"
SELECT
$loginCol
FROM
$table
WHERE
$loginCol
='
$user
' AND
$passwordCol
=
$password
"
);
$sth
->
execute
();
# Password hash
my
$password
=
$self
->
hash_password
(
$self
->
{
oldpassword
},
$self
->
{
dbiAuthPasswordHash
}
);
my
@rows
=
$sth
->
fetchrow_array
(
);
my
$result
=
$self
->
check_password
(
$user
,
$password
);
if
(
$#rows
eq
0
)
{
$self
->
lmLog
(
"
One row returned by SQL query
",
'
debug
'
);
}
else
{
$self
->
lmLog
(
"
Bad password for
$user
",
'
error
'
);
unless
(
$result
)
{
return
PE_BADOLDPASSWORD
;
}
}
# Modify password
# Manage password hash (TODO in _DBI.pm)
if
(
$self
->
{
dbiAuthPasswordHash
}
=~
/^(md5|sha|sha1)$/i
)
{
$self
->
lmLog
(
"
Using
"
.
uc
(
$self
->
{
dbiAuthPasswordHash
}
)
.
"
to hash password
",
'
debug
'
);
$password
=
uc
(
$self
->
{
dbiAuthPasswordHash
}
)
.
"
('
"
.
$self
->
{
newpassword
}
.
"
')
";
}
else
{
$self
->
lmLog
(
"
No valid password hash, using clear text for password
",
'
debug
'
);
$password
=
"
'
"
.
$self
->
{
newpassword
}
.
"
'
";
}
my
$password
=
$self
->
hash_password
(
$self
->
{
newpassword
},
$self
->
{
dbiAuthPasswordHash
}
);
my
$result
=
$self
->
modify_password
(
$user
,
$password
);
eval
{
my
$sth
=
$dbh
->
prepare
(
"
UPDATE
$table
SET
$passwordCol
=
$password
WHERE
$loginCol
='
$user
'
");
$sth
->
execute
();
};
if
(
$@
)
{
$self
->
lmLog
(
"
DBI password modification error: $@
",
'
error
'
);
unless
(
$result
)
{
return
PE_ERROR
;
}
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/PasswordDBLDAP.pm
View file @
0a618cda
...
...
@@ -5,19 +5,27 @@
# LDAP password backend class
package
Lemonldap::NG::Portal::
PasswordDBLDAP
;
use
strict
;
use
Lemonldap::NG::Portal::
Simple
;
use
Lemonldap::NG::Portal::
_LDAP
'
ldap
';
#link protected ldap
use
Lemonldap::NG::Portal::
UserDBLDAP
;
#inherits
#use Lemonldap::NG::Portal::_SMTP; #inherits
our
$VERSION
=
'
0.
2
';
our
$VERSION
=
'
0.
3
';
*_formateFilter
=
*
Lemonldap::NG::Portal::UserDBLDAP::
formateFilter
;
*_search
=
*
Lemonldap::NG::Portal::UserDBLDAP::
search
;
## @apmethod int passwordDBInit()
# Load
Net::LDAP::Control::PasswordPolicy if needed
# Load
SMTP functions
# @return Lemonldap::NG::Portal constant
sub
passwordDBInit
{
my
$self
=
shift
;
eval
{
use
base
qw(Lemonldap::NG::Portal::_SMTP)
};
if
(
$@
)
{
$self
->
lmLog
(
"
Unable to load SMTP functions ($@)
",
'
error
'
);
return
PE_ERROR
;
}
PE_OK
;
}
...
...
@@ -71,21 +79,8 @@ sub resetPasswordByMail {
$self
->
lmLog
(
"
Reset password request for
"
.
$self
->
{
dn
},
'
debug
'
);
# Check the required modules before changing password
eval
{
require
String::
Random
};
if
(
$@
)
{
$self
->
lmLog
(
"
Module String::Random not found in
@INC
",
'
error
'
);
return
PE_ERROR
;
}
eval
{
require
MIME::
Lite
};
if
(
$@
)
{
$self
->
lmLog
(
"
Module MIME::Lite not found in
@INC
",
'
error
'
);
return
PE_ERROR
;
}
# Generate a complex password
my
$random
=
new
String::
Random
;
my
$password
=
$random
->
randregex
(
$self
->
{
randomPasswordRegexp
}
);
my
$password
=
$self
->
gen_password
(
$self
->
{
randomPasswordRegexp
}
);
$self
->
lmLog
(
"
Generated password:
"
.
$password
,
'
debug
'
);
...
...
@@ -111,29 +106,11 @@ sub resetPasswordByMail {
}
# Send new password by mail
$self
->
{
mailBody
}
=~
s/\$password/$password/g
;
$self
->
{
mailBody
}
=~
s/\$(\w+)/$self->{sessionInfo}->{$1}/g
;
$self
->
lmLog
(
"
SMTP From
"
.
$self
->
{
mailFrom
},
'
debug
'
);
$self
->
lmLog
(
"
SMTP To
"
.
$self
->
{
mail
},
'
debug
'
);
$self
->
lmLog
(
"
SMTP Subject
"
.
$self
->
{
mailSubject
},
'
debug
'
);
$self
->
lmLog
(
"
SMTP Body
"
.
$self
->
{
mailBody
},
'
debug
'
);
eval
{
my
$message
=
MIME::
Lite
->
new
(
From
=>
$self
->
{
mailFrom
},
To
=>
$self
->
{
mail
},
Subject
=>
$self
->
{
mailSubject
},
Type
=>
"
TEXT
",
Data
=>
$self
->
{
mailBody
},
);
$self
->
{
SMTPServer
}
?
$message
->
send
(
"
smtp
",
$self
->
{
SMTPServer
}
)
:
$message
->
send
();
};
if
(
$@
)
{
$self
->
lmLog
(
"
Send message failed: $@
",
'
error
'
);
return
PE_ERROR
;
}
my
$result
=
$self
->
send_password
(
$password
,
$self
->
{
mail
}
);
return
PE_ERROR
unless
$result
;
PE_PASSWORD_OK
;
}
1
;
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_DBI.pm
View file @
0a618cda
...
...
@@ -15,9 +15,10 @@ our @EXPORT = qw(dbh);
our
$VERSION
=
'
0.1
';
## @method protected Lemonldap::NG::Portal::_DBI dbh()
# @param dbiChain
# @param dbiUser
# @param dbiPassword
# Create connection to database
# @param dbiChain DBI connection chain
# @param dbiUser DBI connection user
# @param dbiPassword DBI connection password
# @return dbh object
sub
dbh
{
my
$self
=
shift
;
...
...
@@ -38,7 +39,98 @@ sub dbh {
return
0
;
}
$self
->
{
_dbh
}
=
$dbh
;
return
$dbh
;
}
## @method protected Lemonldap::NG::Portal::_DBI hash_password()
# Return hashed password for SQL SELECT WHERE clause
# @param password clear password
# @param hash hash mechanism
# @return hashed password
sub
hash_password
{
my
$self
=
shift
;
my
$password
=
shift
;
my
$hash
=
shift
;
if
(
$hash
=~
/^(md5|sha|sha1)$/i
)
{
$self
->
lmLog
(
"
Using
"
.
uc
(
$hash
)
.
"
to hash password
",
'
debug
'
);
return
uc
(
$hash
)
.
"
('
$password
')
";
}
else
{
$self
->
lmLog
(
"
No valid password hash, using clear text for password
",
'
debug
'
);
return
"
'
$password
'
";
}
}
## @method protected Lemonldap::NG::Portal::_DBI check_password()
# Verify user and password with SQL SELECT
# @param user user
# @param password password
# @return boolean result
sub
check_password
{
my
$self
=
shift
;
my
$user
=
shift
;
my
$password
=
shift
;
my
$table
=
$self
->
{
dbiAuthTable
};
my
$loginCol
=
$self
->
{
dbiAuthLoginCol
};
my
$passwordCol
=
$self
->
{
dbiAuthPasswordCol
};
my
@rows
=
();
eval
{
my
$sth
=
$self
->
{
_dbh
}
->
prepare
(
"
SELECT
$loginCol
FROM
$table
WHERE
$loginCol
='
$user
' AND
$passwordCol
=
$password
"
);
$sth
->
execute
();
@rows
=
$sth
->
fetchrow_array
();
};
if
(
$@
)
{
$self
->
lmLog
(
"
DBI error: $@
",
'
error
'
);
return
0
;
}
if
(
@rows
==
1
)
{
$self
->
lmLog
(
"
One row returned by SQL query
",
'
debug
'
);
return
1
;
}
else
{
$self
->
lmLog
(
"
Bad password for
$user
",
'
error
'
);
return
0
;
}
}
## @method protected Lemonldap::NG::Portal::_DBI modify_password()
# Modify password with SQL UPDATE
# @param user user
# @param password password
# @return boolean result
sub
modify_password
{
my
$self
=
shift
;
my
$user
=
shift
;
my
$password
=
shift
;
my
$table
=
$self
->
{
dbiAuthTable
};
my
$loginCol
=
$self
->
{
dbiAuthLoginCol
};
my
$passwordCol
=
$self
->
{
dbiAuthPasswordCol
};
eval
{
my
$sth
=
$self
->
{
_dbh
}
->
prepare
(
"
UPDATE
$table
SET
$passwordCol
=
$password
WHERE
$loginCol
='
$user
'
");
$sth
->
execute
();
};
if
(
$@
)
{
$self
->
lmLog
(
"
DBI password modification error: $@
",
'
error
'
);
return
0
;
}
return
1
;
}
1
;
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SMTP.pm
0 → 100644
View file @
0a618cda
##@file
# SMTP common functions
##@class
# SMTP common functions
package
Lemonldap::NG::Portal::
_SMTP
;
use
strict
;
use
String::
Random
;
use
MIME::
Lite
;
our
$VERSION
=
'
0.1
';
## @method string gen_password()
# Generate a complex password based on a regular expression
# @param regexp regular expression
# @return complex password
sub
gen_password
{
my
$self
=
shift
;
my
$regexp
=
shift
;
my
$random
=
new
String::
Random
;
return
$random
->
randregex
(
$regexp
);
}
## @method int send_password()
# Send password by mail
# @param password password
# @param mail mail
# @return boolean result
sub
send_password
{
my
$self
=
shift
;
my
$password
=
shift
;
my
$mail
=
shift
;
$self
->
{
mailBody
}
=~
s/\$password/$password/g
;
$self
->
{
mailBody
}
=~
s/\$(\w+)/$self->{sessionInfo}->{$1}/g
;
$self
->
lmLog
(
"
SMTP From
"
.
$self
->
{
mailFrom
},
'
debug
'
);
$self
->
lmLog
(
"
SMTP To
"
.
$mail
,
'
debug
'
);
$self
->
lmLog
(
"
SMTP Subject
"
.
$self
->
{
mailSubject
},
'
debug
'
);
$self
->
lmLog
(
"
SMTP Body
"
.
$self
->
{
mailBody
},
'
debug
'
);
eval
{
my
$message
=
MIME::
Lite
->
new
(
From
=>
$self
->
{
mailFrom
},
To
=>
$mail
,
Subject
=>
$self
->
{
mailSubject
},
Type
=>
"
TEXT
",
Data
=>
$self
->
{
mailBody
},
);
$self
->
{
SMTPServer
}
?
$message
->
send
(
"
smtp
",
$self
->
{
SMTPServer
}
)
:
$message
->
send
();
};
if
(
$@
)
{
$self
->
lmLog
(
"
Send message failed: $@
",
'
error
'
);
return
0
;
}
return
1
;
}
1
;
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