2011-11-12 21:42:19 +04:00
package Apache::Authn::Redmine ;
= head1 Apache::Authn:: Redmine
Redmine - a mod_perl module to authenticate webdav subversion users
against redmine database
= head1 SYNOPSIS
This module allow anonymous users to browse public project and
registred users to browse and commit their project . Authentication is
done against the redmine database or the LDAP configured in redmine .
This method is far simpler than the one with pam_ * and works with all
database without an hassle but you need to have apache / mod_perl on the
svn server .
= head1 INSTALLATION
For this to automagically work , you need to have a recent reposman . rb
( after r860 ) and if you already use reposman , read the last section to
migrate .
Sorry ruby users but you need some perl modules , at least mod_perl2 ,
DBI and DBD:: mysql ( or the DBD driver for you database as it should
work on allmost all databases ) .
On debian / ubuntu you must do :
2011-11-14 14:12:40 +04:00
aptitude install libapache - dbi - perl libapache2 - mod - perl2 libdbd - mysql - perl
2011-11-12 21:42:19 +04:00
If your Redmine users use LDAP authentication , you will also need
Authen::Simple:: LDAP ( and IO::Socket:: SSL if LDAPS is used ) :
2011-11-14 14:12:40 +04:00
aptitude install libauthen - simple - ldap - perl libio - socket - ssl - perl
2011-11-12 21:42:19 +04:00
= head1 CONFIGURATION
2011-11-14 14:12:40 +04:00
## This module has to be in your perl path
## eg: /usr/lib/perl5/Apache/Authn/Redmine.pm
PerlLoadModule Apache::Authn:: Redmine
< Location / svn >
DAV svn
SVNParentPath "/var/svn"
AuthType Basic
AuthName redmine
Require valid - user
PerlAuthenHandler Apache::Authn::Redmine:: authen_handler
PerlAuthzHandler Apache::Authn::Redmine:: authz_handler
## for mysql
RedmineDSN "DBI:mysql:database=databasename;host=my.db.server"
## for postgres
# RedmineDSN "DBI:Pg:dbname=databasename;host=my.db.server"
RedmineDbUser "redmine"
RedmineDbPass "password"
## Optional where clause (fulltext search would be slow and
## database dependant).
# RedmineDbWhereClause "and members.role_id IN (1,2)"
## Optional credentials cache size
# RedmineCacheCredsMax 50
</Location>
2011-11-12 21:42:19 +04:00
To be able to browse repository inside redmine , you must add something
like that :
2011-11-14 14:12:40 +04:00
< Location / svn - private >
DAV svn
SVNParentPath "/var/svn"
Order deny , allow
Deny from all
# only allow reading orders
< Limit GET PROPFIND OPTIONS REPORT >
Allow from redmine . server . ip
</Limit>
</Location>
2011-11-12 21:42:19 +04:00
and you will have to use this reposman . rb command line to create repository :
2011-11-14 14:12:40 +04:00
reposman . rb - - redmine my . redmine . server - - svn - dir /var/s vn - - owner www - data - u http: //s vn . server /svn-private/
2011-11-12 21:42:19 +04:00
= head1 MIGRATION FROM OLDER RELEASES
If you use an older reposman . rb ( r860 or before ) , you need to change
rights on repositories to allow the apache user to read and write
S < them : >
2011-11-14 14:12:40 +04:00
sudo chown - R www - data /var/s vn / *
sudo chmod - R u + w /var/s vn / *
2011-11-12 21:42:19 +04:00
And you need to upgrade at least reposman . rb ( after r860 ) .
= cut
use strict ;
use warnings FATAL = > 'all' , NONFATAL = > 'redefine' ;
use DBI ;
use Digest::SHA1 ;
# optional module for LDAP authentication
my $ CanUseLDAPAuth = eval ( "use Authen::Simple::LDAP; 1" ) ;
# Reload ourself (disable in production)
use Apache2::Reload ;
use Apache2::Module ;
use Apache2::Access ;
use Apache2::ServerRec qw( ) ;
use Apache2::RequestRec qw( ) ;
use Apache2::RequestUtil qw( ) ;
use Apache2::Const qw( :common :override :cmd_how ) ;
use Apache2::Log ;
use APR::Pool ( ) ;
use APR::Table ( ) ;
# use Apache2::Directive qw();
my @ directives = (
2011-11-13 14:53:29 +04:00
{
name = > 'RedmineDSN' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Redmine database DSN in format used by Perl DBI. eg: "DBI:Pg:dbname=databasename;host=my.db.server"' ,
} ,
{
name = > 'RedmineDbUser' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Redmine database user' ,
} ,
{
name = > 'RedmineDbPass' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Redmine database password' ,
} ,
{
name = > 'RedmineDbWhereClause' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Additionnal where clause used when checking for user permissions' ,
} ,
{
name = > 'RedmineProject' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Identifier (short name) of a Redmine project. If undefined, extract the project identifier from the location.' ,
} ,
2011-11-13 13:45:04 +04:00
{
name = > 'RedmineReadPermissions' ,
req_override = > OR_AUTHCFG ,
args_how = > ITERATE ,
2011-11-13 14:53:29 +04:00
errmsg = > 'Permissions to check for read access. Defaults to :browse_repository.' ,
2011-11-13 13:45:04 +04:00
} ,
{
name = > 'RedmineWritePermissions' ,
req_override = > OR_AUTHCFG ,
args_how = > ITERATE ,
2011-11-13 14:53:29 +04:00
errmsg = > 'Permissions to check for write access. Defaults to :commit_access.' ,
} ,
{
name = > 'RedmineCacheCredsMax' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Maximum number of credentials to cache. Set to 0 to disable credential caching.' ,
} ,
{
name = > 'RedmineCacheCredsMaxAge' ,
req_override = > OR_AUTHCFG ,
args_how = > TAKE1 ,
errmsg = > 'Maximum age of cached credentials. Defaults to 300. Set to 0 to disable credential expiration.' ,
2011-11-13 13:45:04 +04:00
} ,
2011-11-13 14:54:39 +04:00
{
name = > 'RedmineDenyAnonymous' ,
req_override = > OR_AUTHCFG ,
args_how = > FLAG ,
errmsg = > 'Deny anonymous access. Defaults to no.' ,
} ,
{
name = > 'RedmineDenyNonMember' ,
req_override = > OR_AUTHCFG ,
args_how = > FLAG ,
errmsg = > 'Do not check non-member permissions. Defaults to no.' ,
} ,
{
name = > 'RedmineSuperAdmin' ,
req_override = > OR_AUTHCFG ,
args_how = > FLAG ,
errmsg = > 'Grant all permissions to administrators. Defaults to yes.' ,
} ,
2011-11-12 21:42:19 +04:00
) ;
2011-11-13 14:54:39 +04:00
# Initialize defaults configuration
sub DIR_CREATE {
my ( $ class , $ parms ) = @ _ ;
return bless {
PermissionQuery = > trim ( "
SELECT permissions FROM users , members , member_roles , roles
WHERE users . login = ?
AND users . id = members . user_id
AND users . status = 1
AND members . project_id = ?
AND members . id = member_roles . member_id
AND member_roles . role_id = roles . id
" ) ,
CacheCredsMax = > 0 ,
CacheCredsCount = > 0 ,
CacheCredsMaxAge = > 300 ,
DenyAnonymous = > 0 ,
DenyNonMember = > 0 ,
SuperAdmin = > 1 ,
} , $ class ;
2011-11-12 21:42:19 +04:00
}
2011-11-13 14:54:39 +04:00
# Simple setters
sub RedmineDSN { set_val ( 'DSN' , @ _ ) ; }
2011-11-13 13:45:04 +04:00
sub RedmineDbUser { set_val ( 'DbUser' , @ _ ) ; }
sub RedmineDbPass { set_val ( 'DbPass' , @ _ ) ; }
sub RedmineProject { set_val ( 'Project' , @ _ ) ; }
2011-11-13 14:54:39 +04:00
sub RedmineReadPermissions { push_val ( 'ReadPermissions' , @ _ ) ; }
sub RedmineWritePermissions { push_val ( 'WritePermissions' , @ _ ) ; }
sub RedmineCacheCredsMaxAge { set_val ( 'CacheCredsMaxAge' , @ _ ) ; }
sub RedmineDenyAnonymous { set_val ( 'DenyAnonymous' , @ _ ) ; }
sub RedmineDenyNonMember { set_val ( 'DenyNonMember' , @ _ ) ; }
sub RedmineSuperAdmin { set_val ( 'SuperAdmin' , @ _ ) ; }
2011-11-13 13:45:04 +04:00
sub RedmineDbWhereClause {
2011-11-14 14:12:40 +04:00
my ( $ cfg , $ parms , $ arg ) = @ _ ;
if ( $ arg ) {
$ cfg - > { PermissionQuery } = trim ( $ cfg - > { PermissionQuery } . "$arg " ) ;
2011-11-13 14:54:39 +04:00
}
2011-11-12 21:42:19 +04:00
}
2011-11-13 13:45:04 +04:00
sub RedmineCacheCredsMax {
2011-11-14 14:12:40 +04:00
my ( $ cfg , $ parms , $ arg ) = @ _ ;
if ( $ arg ) {
unless ( $ cfg - > { CachePool } ) {
$ cfg - > { CachePool } = APR::Pool - > new ;
$ cfg - > { CacheCreds } = APR::Table:: make ( $ cfg - > { CachePool } , $ arg ) ;
2011-11-13 14:54:39 +04:00
}
2011-11-14 14:12:40 +04:00
$ cfg - > { CacheCredsMax } = $ arg ;
}
2011-11-12 21:42:19 +04:00
}
2011-11-13 14:54:39 +04:00
sub set_val {
2011-11-14 14:12:40 +04:00
my ( $ key , $ cfg , $ parms , $ arg ) = @ _ ;
$ cfg - > { $ key } = $ arg ;
2011-11-13 13:45:04 +04:00
}
2011-11-13 14:54:39 +04:00
sub push_val {
2011-11-14 14:12:40 +04:00
my ( $ key , $ cfg , $ parms , $ arg ) = @ _ ;
push @ { $ cfg - > { $ key } } , $ arg ;
2011-11-13 13:45:04 +04:00
}
2011-11-12 21:42:19 +04:00
sub trim {
2011-11-14 14:12:40 +04:00
my $ string = shift ;
$ string =~ s/\s{2,}/ /g ;
return $ string ;
2011-11-12 21:42:19 +04:00
}
Apache2::Module:: add ( __PACKAGE__ , \ @ directives ) ;
2011-11-13 13:45:04 +04:00
my % read_only_methods = map { $ _ = > 1 } qw/GET PROPFIND REPORT OPTIONS/ ;
my @ default_read_permissions = ( ':browse_repository' ) ;
my @ default_write_permissions = ( ':commit_access' ) ;
2011-11-12 21:42:19 +04:00
sub authen_handler {
2011-11-14 14:12:40 +04:00
my $ r = shift ;
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
unless ( $ r - > some_auth_required ) {
$ r - > log_reason ( "No authentication has been configured" ) ;
return FORBIDDEN ;
}
2011-11-12 21:42:19 +04:00
my ( $ res , $ password ) = $ r - > get_basic_auth_pw ( ) ;
my $ reason ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
if ( $ res == OK ) {
# Got user and password
# Used cached credentials if possible
my $ cache_key = get_cache_key ( $ r , $ password ) ;
if ( cache_get ( $ r , $ cache_key ) ) {
$ r - > log - > debug ( "reusing cached credentials for user '" , $ r - > user , "'" ) ;
$ r - > set_handlers ( PerlAuthzHandler = > undef ) ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
} else {
# Else check them
my $ dbh = connect_database ( $ r ) ;
( $ res , $ reason ) = check_login ( $ r , $ dbh , $ password ) ;
$ dbh - > disconnect ( ) ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
# Store the cache key for latter use
2011-11-13 13:45:04 +04:00
$ r - > pnotes ( "RedmineCacheKey" = > $ cache_key ) if $ res == OK ;
2011-11-12 21:42:19 +04:00
}
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
} elsif ( $ res == AUTH_REQUIRED ) {
my $ dbh = connect_database ( $ r ) ;
2011-11-13 14:54:39 +04:00
my $ cfg = get_config ( $ r ) ;
if ( ! $ cfg - > { AllowAnonymous } || is_authentication_forced ( $ dbh ) ) {
2011-11-12 21:42:19 +04:00
# We really want an user
$ reason = 'anonymous access disabled' ;
} else {
# Anonymous is allowed
$ res = OK ;
}
$ dbh - > disconnect ( ) ;
2011-11-13 13:45:04 +04:00
}
2011-11-12 21:42:19 +04:00
$ r - > log_reason ( $ reason ) if defined ( $ reason ) ;
2011-11-13 13:45:04 +04:00
$ r - > note_basic_auth_failure unless $ res == OK ;
2011-11-12 21:42:19 +04:00
2011-11-14 14:12:40 +04:00
return $ res ;
2011-11-12 21:42:19 +04:00
}
sub check_login {
my ( $ r , $ dbh , $ password ) = @ _ ;
my $ user = $ r - > user ;
2011-11-13 13:45:04 +04:00
2011-11-13 14:54:39 +04:00
my ( $ hashed_password , $ status , $ auth_source_id , $ salt ) = $ dbh - > selectrow_array ( 'SELECT hashed_password, status, auth_source_id, salt FROM users WHERE login = ?' , undef , $ user ) ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
# Not found
return ( AUTH_REQUIRED , "unknown user '$user'" ) unless defined ( $ hashed_password ) ;
2011-11-13 13:45:04 +04:00
# Check password
2011-11-12 21:42:19 +04:00
if ( $ auth_source_id ) {
# LDAP authentication
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
# Ensure Authen::Simple::LDAP is available
return ( SERVER_ERROR , "Redmine LDAP authentication requires Authen::Simple::LDAP" )
unless $ CanUseLDAPAuth ;
# Get LDAP server informations
my ( $ host , $ port , $ tls , $ account , $ account_password , $ base_dn , $ attr_login ) = query_fetch_first (
$ dbh ,
"SELECT host,port,tls,account,account_password,base_dn,attr_login from auth_sources WHERE id = ?" ,
$ auth_source_id
) ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
# Check them
return ( SERVER_ERROR , "Undefined authentication source for '$user'" )
unless defined $ host ;
2011-11-13 13:45:04 +04:00
# Connect to the LDAP server
2011-11-14 14:12:40 +04:00
my $ ldap = Authen::Simple::LDAP - > new (
host = > is_true ( $ tls ) ? "ldaps://$host:$port" : $ host ,
port = > $ port ,
basedn = > $ base_dn ,
binddn = > $ account || "" ,
bindpw = > $ account_password || "" ,
filter = > '(' . $ attr_login . '=%s)'
) ;
# Finally check user login
return ( AUTH_REQUIRED , "LDAP authentication failed (user: '$user', server: '$host')" )
unless $ ldap - > authenticate ( $ user , $ password ) ;
2011-11-13 13:45:04 +04:00
} else {
2011-11-12 21:42:19 +04:00
# Database authentication
my $ pass_digest = Digest::SHA1:: sha1_hex ( $ password ) ;
return ( AUTH_REQUIRED , "wrong password for '$user'" )
unless $ hashed_password eq Digest::SHA1:: sha1_hex ( $ salt . $ pass_digest ) ;
}
2011-11-13 13:45:04 +04:00
# Password is ok, check if account if locked
2011-11-13 13:38:18 +04:00
return ( FORBIDDEN , "inactive account: '$user'" ) unless $ status == 1 ;
2011-11-12 21:42:19 +04:00
$ r - > log - > debug ( "successfully authenticated as active redmine user '$user'" ) ;
2011-11-13 13:45:04 +04:00
# Everything's ok
2011-11-12 21:42:19 +04:00
return OK ;
}
# check if authentication is forced
sub is_authentication_forced {
my $ dbh = shift ;
2011-11-14 14:12:40 +04:00
return is_true ( $ dbh - > selectrow_array ( "SELECT value FROM settings WHERE settings.name = 'login_required'" ) ) ;
2011-11-12 21:42:19 +04:00
}
sub authz_handler {
2011-11-14 14:12:40 +04:00
my $ r = shift ;
2011-11-12 21:42:19 +04:00
2011-11-14 14:12:40 +04:00
unless ( $ r - > some_auth_required ) {
$ r - > log_reason ( "No authentication has been configured" ) ;
return FORBIDDEN ;
}
2011-11-12 21:42:19 +04:00
2011-11-14 14:12:40 +04:00
my $ dbh = connect_database ( $ r ) ;
2011-11-13 14:54:39 +04:00
my $ cfg = get_config ( $ r ) ;
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
my ( $ identifier , $ project_id , $ is_public , $ status ) = get_project_data ( $ r , $ dbh ) ;
2011-11-12 21:42:19 +04:00
$ is_public = is_true ( $ is_public ) ;
my ( $ res , $ reason ) = FORBIDDEN ;
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
unless ( defined ( $ project_id ) ) {
# Unknown project
$ res = DECLINED ;
$ reason = "not a redmine project" ;
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
} elsif ( $ status != 1 && ! is_read_request ( $ r ) ) {
# Write operation on archived project is forbidden
$ reason = "write operations on inactive project '$identifier' are forbidden" ;
2011-11-12 21:42:19 +04:00
} elsif ( ! $ r - > user ) {
2011-11-14 14:12:40 +04:00
# Anonymous access
2011-11-12 21:42:19 +04:00
$ res = AUTH_REQUIRED ;
$ reason = "anonymous access to '$identifier' denied" ;
2011-11-13 13:45:04 +04:00
2011-11-13 14:54:39 +04:00
if ( $ is_public && ! $ cfg - > { DenyAnonymous } ) {
2011-11-12 21:42:19 +04:00
# Check anonymous permissions
2011-11-13 14:54:39 +04:00
my $ permissions = $ dbh - > selectrow_array ( "SELECT permissions FROM roles WHERE builtin = 2" ) ;
$ res = OK if $ permissions && check_permissions ( $ r , $ permissions ) ;
2011-11-12 21:42:19 +04:00
}
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
# Force login if failed
2011-11-12 21:42:19 +04:00
$ r - > note_auth_failure unless $ res == OK ;
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
} else {
# Logged in user
my $ user = $ r - > user ;
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
if ( $ cfg - > { SuperAdmin } && is_true ( $ dbh - > selectrow_array ( "SELECT admin FROM users WHERE login = ?" , undef , $ user ) ) ) {
# Adminstrators have all the rights
$ res = OK ;
2011-11-13 14:54:39 +04:00
2011-11-14 14:12:40 +04:00
} else {
# Really check user permissions
2011-11-13 14:54:39 +04:00
my @ permissions = ( ) ;
# Membership permissions
my $ membership = $ dbh - > selectcol_arrayref ( $ cfg - > { PermissionQuery } , undef , $ user , $ project_id ) ;
push @ permissions , @ { $ membership } if $ membership ;
2011-11-13 13:45:04 +04:00
# Add non-member permissions for public projects
2011-11-13 14:54:39 +04:00
if ( $ is_public && ! $ cfg - > { DenyNonMember } ) {
my $ non_member = $ dbh - > selectrow_array ( "SELECT permissions FROM roles WHERE builtin = 1" ) ;
push @ permissions , $ non_member if $ non_member ;
2011-11-13 13:45:04 +04:00
}
2011-11-13 14:54:39 +04:00
# Look for the permissions
$ res = OK if check_permissions ( $ r , @ permissions ) ;
2011-11-14 14:12:40 +04:00
}
2011-11-13 13:45:04 +04:00
2011-11-13 14:54:39 +04:00
if ( $ res == OK ) {
# Put successful credentials in cache
if ( my $ cache_key = $ r - > pnotes ( "RedmineCacheKey" ) ) {
cache_set ( $ r , $ cache_key ) ;
}
2011-11-12 21:42:19 +04:00
} else {
2011-11-13 14:54:39 +04:00
$ reason = "insufficient permissions (user: '$user', project: '$identifier')" ;
2011-11-12 21:42:19 +04:00
}
2011-11-14 14:12:40 +04:00
}
2011-11-12 21:42:19 +04:00
2011-11-13 14:54:39 +04:00
# Log what we have done
if ( $ res == OK ) {
$ r - > log - > debug ( "access granted: user '" , ( $ r - > user || 'anonymous' ) , "', project '$identifier', method: '" , $ r - > method , "'" ) if $ res == OK ;
} elsif ( defined $ reason ) {
2011-11-14 14:12:40 +04:00
$ r - > log_reason ( $ reason ) ;
2011-11-13 14:54:39 +04:00
}
2011-11-13 13:45:04 +04:00
2011-11-14 14:12:40 +04:00
return $ res ;
2011-11-12 21:42:19 +04:00
}
2011-11-13 13:45:04 +04:00
# get the project identifier
2011-11-12 21:42:19 +04:00
sub get_project_identifier {
2011-11-13 13:45:04 +04:00
my ( $ r , $ dbh ) = @ _ ;
my $ cfg = get_config ( $ r ) ;
my $ identifier = $ cfg - > { Project } ;
unless ( $ identifier ) {
my $ location = $ r - > location ;
( $ identifier ) = $ r - > uri =~ m {^\Q$location\E/*([^/]+)} ;
}
2011-11-14 14:12:40 +04:00
return $ identifier ;
2011-11-12 21:42:19 +04:00
}
2011-11-13 13:45:04 +04:00
# tell if the given request is a read operation
sub is_read_request {
my $ r = shift ;
return defined $ read_only_methods { $ r - > method } ;
}
# check if one of the required permissions is in the passed list
sub check_permissions {
my $ r = shift ;
my $ permissions = join ( ' ' , @ _ )
or return 0 ;
2011-11-13 14:54:39 +04:00
my $ cfg = get_config ( $ r ) ;
2011-11-13 13:45:04 +04:00
my @ required ;
if ( is_read_request ( $ r ) ) {
@ required = $ cfg - > { ReadPermissions } || @ default_read_permissions ;
} else {
@ required = $ cfg - > { WritePermissions } || @ default_write_permissions ;
}
foreach ( @ required ) {
return 1 if $ permissions =~ m {\Q$_\E} ;
}
return 0 ;
}
2011-11-12 21:42:19 +04:00
# get information about the project
sub get_project_data {
my $ r = shift ;
my $ dbh = shift ;
2011-11-14 14:12:40 +04:00
my $ identifier = get_project_identifier ( $ r ) ;
2011-11-13 14:54:39 +04:00
return $ identifier , $ dbh - > selectrow_array ( "SELECT id, is_public, status FROM projects WHERE identifier = ?" , undef , $ identifier ) ;
2011-11-12 21:42:19 +04:00
}
# return module configuration for current directory
sub get_config {
my $ r = shift ;
2011-11-13 13:45:04 +04:00
return Apache2::Module:: get_config ( __PACKAGE__ , $ r - > server , $ r - > per_dir_config ) ;
2011-11-12 21:42:19 +04:00
}
# get a connection to the redmine database
sub connect_database {
2011-11-13 13:45:04 +04:00
my $ r = shift ;
2011-11-12 21:42:19 +04:00
my $ cfg = get_config ( $ r ) ;
2011-11-13 13:45:04 +04:00
return DBI - > connect ( $ cfg - > { DSN } , $ cfg - > { DbUser } , $ cfg - > { DbPass } ) ;
2011-11-12 21:42:19 +04:00
}
# tell if a value returned from SQL is "true"
sub is_true {
my $ value = shift ;
2011-11-14 14:12:40 +04:00
return defined ( $ value ) && ( $ value == 1 || $ value eq "t" ) ;
2011-11-12 21:42:19 +04:00
}
# build credential cache key
sub get_cache_key {
my ( $ r , $ password ) = @ _ ;
2011-11-13 14:54:39 +04:00
return Digest::SHA1:: sha1_hex ( join ( ':' , get_project_identifier ( $ r ) , $ r - > user , $ password , is_read_request ( $ r ) ? 'read' : 'write' ) ) ;
2011-11-12 21:42:19 +04:00
}
# check if credentials exist in cache
sub cache_get {
my ( $ r , $ key ) = @ _ ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
my $ cfg = get_config ( $ r ) ;
2011-11-13 14:54:39 +04:00
return unless $ cfg - > { CacheCredsMax } ;
2011-11-13 13:45:04 +04:00
2011-11-13 14:54:39 +04:00
my $ time = $ cfg - > { CacheCreds } - > get ( $ key )
2011-11-13 13:45:04 +04:00
or return 0 ;
if ( $ cfg - > { CacheCredsMaxAge } && ( $ r - > request_time - $ time ) > $ cfg - > { CacheCredsMaxAge } ) {
2011-11-13 14:54:39 +04:00
$ cfg - > { CacheCreds } - > unset ( $ key ) ;
2011-11-13 13:45:04 +04:00
$ cfg - > { CacheCredsCount } - - ;
2011-11-12 21:42:19 +04:00
return 0 ;
}
2011-11-13 13:45:04 +04:00
return 1 ;
2011-11-12 21:42:19 +04:00
}
# put credentials in cache
sub cache_set {
my ( $ r , $ key ) = @ _ ;
2011-11-13 13:45:04 +04:00
2011-11-12 21:42:19 +04:00
my $ cfg = get_config ( $ r ) ;
2011-11-13 14:54:39 +04:00
return unless $ cfg - > { CacheCredsMax } ;
2011-11-13 13:45:04 +04:00
if ( $ cfg - > { CacheCredsCount } >= $ cfg - > { CacheCredsMax } ) {
2011-11-13 14:54:39 +04:00
$ cfg - > { CacheCreds } - > clear ;
2011-11-13 13:45:04 +04:00
$ cfg - > { CacheCredsCount } = 0 ;
2011-11-12 21:42:19 +04:00
}
2011-11-13 14:54:39 +04:00
$ cfg - > { CacheCreds } - > set ( $ key , $ r - > request_time ) ;
2011-11-13 13:45:04 +04:00
$ cfg - > { CacheCredsCount } + + ;
2011-11-12 21:42:19 +04:00
}
1 ;
2011-11-13 14:54:39 +04:00