2014-05-15 16:17:21 +00:00
#
# This file is not desinged to be used in conjuntion with other AAA providers.
# This file requires to be used alone as shown below for apache httpd2.
# You may change AuthName or SVNParentPath.
#
# <Location "/svn">
# DAV svn
# SVNParentPath "/var/lib/codepot/svnrepo"
# PerlAccessHandler Codepot::AccessHandler
# PerlAuthenHandler Codepot::AuthenHandler
2014-05-16 03:18:22 +00:00
# PerlSetEnv CODEPOT_CONFIG_FILE /etc/codepot/codepot.ini
2014-05-15 16:17:21 +00:00
# AuthType Basic
# AuthName "codepot"
# require valid-user
# </Location>
#
2014-05-16 03:18:22 +00:00
# If you do not move the handler files to the default library directory,
# a switch to indicate the location of the files are needed when loading
# the mod_perl module. Somewhere in your httpd configuration, specify
# the -Mlib switch.
#
# LoadModule perl_module modules/mod_perl.so
# PerlSwitches -Mlib=/etc/codepot/perl
#
2014-05-15 16:17:21 +00:00
package Codepot::AccessHandler ;
use strict ;
use warnings ;
use Apache2::Access ( ) ;
use Apache2::RequestUtil ( ) ;
use Apache2::RequestRec ( ) ;
use Apache2::Log ;
use APR::Table ;
use APR::Base64 ;
use Config::Simple ;
use Net::LDAP ;
use URI ;
use DBI ;
2022-05-30 01:28:19 +00:00
use Digest::SHA ;
2014-05-15 16:17:21 +00:00
2019-02-01 15:23:22 +00:00
use Apache2::Const - compile = > qw( OK DECLINED FORBIDDEN HTTP_UNAUTHORIZED HTTP_INTERNAL_SERVER_ERROR PROXYREQ_PROXY AUTH_REQUIRED ) ;
2014-05-15 16:17:21 +00:00
sub get_config
{
my $ cfg = new Config:: Simple ( ) ;
2022-05-30 01:28:19 +00:00
if ( ! $ cfg - > read ( $ ENV { 'CODEPOT_CONFIG_FILE' } ) )
2014-05-15 16:17:21 +00:00
{
return undef ;
}
my $ config = {
2022-05-30 01:28:19 +00:00
login_model = > $ cfg - > param ( 'login_model' ) ,
2014-05-17 07:04:12 +00:00
2021-09-03 17:13:27 +00:00
ldap_server_uri = > $ cfg - > param ( 'ldap_server_uri' ) ,
ldap_server_protocol_version = > $ cfg - > param ( 'ldap_server_protocol_version' ) ,
ldap_auth_mode = > $ cfg - > param ( 'ldap_auth_mode' ) ,
ldap_userid_format = > $ cfg - > param ( 'ldap_userid_format' ) ,
ldap_password_format = > $ cfg - > param ( 'ldap_password_format' ) ,
ldap_admin_binddn = > $ cfg - > param ( 'ldap_admin_binddn' ) ,
ldap_admin_password = > $ cfg - > param ( 'ldap_admin_password' ) ,
ldap_userid_search_base = > $ cfg - > param ( 'ldap_userid_search_base' ) ,
ldap_userid_search_filter = > $ cfg - > param ( 'ldap_userid_search_filter' ) ,
ldap_insider_attribute_names = > $ cfg - > param ( 'ldap_insider_attribute_names' ) ,
ldap_insider_attribute_value = > $ cfg - > param ( 'ldap_insider_attribute_value' ) ,
database_hostname = > $ cfg - > param ( 'database_hostname' ) ,
database_port = > $ cfg - > param ( "database_port" ) ,
database_username = > $ cfg - > param ( 'database_username' ) ,
database_password = > $ cfg - > param ( 'database_password' ) ,
database_name = > $ cfg - > param ( 'database_name' ) ,
database_driver = > $ cfg - > param ( 'database_driver' ) ,
database_prefix = > $ cfg - > param ( 'database_prefix' ) ,
svn_read_access = > $ cfg - > param ( 'svn_read_access' ) ,
svn_read_credential = > $ cfg - > param ( 'svn_read_credential' )
2014-05-15 16:17:21 +00:00
} ;
return $ config ;
}
sub format_string
{
my ( $ fmt , $ userid , $ password ) = @ _ ;
my $ out = $ fmt ;
$ out =~ s/\$\{userid\}/$userid/g ;
$ out =~ s/\$\{password\}/$password/g ;
return $ out ;
}
2014-05-17 07:04:12 +00:00
sub authenticate_ldap
2014-05-15 16:17:21 +00:00
{
2014-05-18 16:17:29 +00:00
my ( $ r , $ cfg , $ userid , $ password ) = @ _ ;
2014-05-15 16:17:21 +00:00
my $ binddn ;
my $ passwd ;
2022-05-30 01:28:19 +00:00
my $ uri = URI - > new ( $ cfg - > { ldap_server_uri } ) ;
my $ ldap = Net::LDAP - > new (
2014-05-18 16:17:29 +00:00
$ uri - > host ,
scheme = > $ uri - > scheme ,
port = > $ uri - > port ,
version = > $ cfg - > { ldap_server_protocol_version }
2014-05-15 16:17:21 +00:00
) ;
if ( ! defined ( $ ldap ) )
{
2014-05-18 16:17:29 +00:00
$ r - > log_error ( 'Cannot create LDAP' ) ;
2014-05-15 16:17:21 +00:00
return - 1 ;
}
if ( $ cfg - > { ldap_auth_mode } == 2 )
{
2022-05-30 01:28:19 +00:00
my $ f_rootdn = format_string ( $ cfg - > { ldap_admin_binddn } , $ userid , $ password ) ;
my $ f_rootpw = format_string ( $ cfg - > { ldap_admin_password } , $ userid , $ password ) ;
my $ f_basedn = format_string ( $ cfg - > { ldap_userid_search_base } , $ userid , $ password ) ;
my $ f_filter = format_string ( $ cfg - > { ldap_userid_search_filter } , $ userid , $ password ) ;
2014-05-18 16:17:29 +00:00
2022-05-30 01:28:19 +00:00
my $ res = $ ldap - > bind ( $ f_rootdn , password = > $ f_rootpw ) ;
if ( $ res - > code != Net::LDAP:: LDAP_SUCCESS )
2016-12-01 15:11:47 +00:00
{
2014-05-18 16:17:29 +00:00
$ r - > log_error ( "Cannot bind LDAP as $f_rootdn - " . $ res - > error ( ) ) ;
$ ldap - > unbind ( ) ;
return - 1 ;
}
2016-12-01 15:11:47 +00:00
2022-05-30 01:28:19 +00:00
$ res = $ ldap - > search ( base = > $ f_basedn , scope = > 'sub' , filter = > $ f_filter ) ;
if ( $ res - > code != Net::LDAP:: LDAP_SUCCESS )
2016-12-01 15:11:47 +00:00
{
2014-05-18 16:17:29 +00:00
$ ldap - > unbind ( ) ;
return 0 ;
}
my $ entry = $ res - > entry ( 0 ) ; # get the first entry only
if ( ! defined ( $ entry ) )
{
$ ldap - > unbind ( ) ;
return 0 ;
}
$ binddn = $ entry - > dn ( ) ;
2014-05-15 16:17:21 +00:00
}
else
{
$ binddn = format_string ( $ cfg - > { ldap_userid_format } , $ userid , $ password ) ;
}
$ passwd = format_string ( $ cfg - > { ldap_password_format } , $ userid , $ password ) ;
my $ res = $ ldap - > bind ( $ binddn , password = > $ passwd ) ;
2022-05-30 01:28:19 +00:00
if ( $ res - > code != Net::LDAP:: LDAP_SUCCESS )
2014-05-18 16:17:29 +00:00
{
#$r->log_error ("Cannot bind LDAP as $binddn - " . $res->error());
$ ldap - > unbind ( ) ;
return 0 ;
}
2014-05-15 16:17:21 +00:00
2016-12-01 15:11:47 +00:00
my $ authenticated = 1 ;
2016-12-02 07:29:03 +00:00
if ( $ cfg - > { ldap_insider_attribute_names } ne '' && $ cfg - > { ldap_insider_attribute_value } ne '' )
2016-12-01 15:11:47 +00:00
{
2016-12-02 07:29:03 +00:00
my $ attr_str = $ cfg - > { ldap_insider_attribute_names } ;
$ attr_str =~ s/^\s+|\s+$//g ;
2021-09-03 17:13:27 +00:00
my @ attrs = split ( /\s+/ , $ attr_str ) ;
2016-12-02 07:29:03 +00:00
if ( scalar ( @ attrs ) > 0 )
2016-12-01 15:11:47 +00:00
{
2016-12-02 07:29:03 +00:00
#my $f_filter = '(' . $cfg->{ldap_insider_attribute_name} . '=*)';
my $ f_filter = '(objectClass=*)' ;
2022-05-30 01:28:19 +00:00
$ res = $ ldap - > search ( base = > $ binddn , scope = > 'base' , filter = > $ f_filter , @ attrs ) ;
if ( $ res - > code == Net::LDAP:: LDAP_SUCCESS )
2016-12-01 15:11:47 +00:00
{
2016-12-02 07:29:03 +00:00
search_loop:
foreach my $ entry ( $ res - > entries )
2016-12-01 15:11:47 +00:00
{
2016-12-02 07:29:03 +00:00
foreach my $ a ( @ attrs )
2016-12-01 15:11:47 +00:00
{
2016-12-02 07:29:03 +00:00
my @ va = $ entry - > get_value ( $ a ) ;
foreach my $ v ( @ va )
{
if ( lc ( $ v ) eq lc ( $ cfg - > { ldap_insider_attribute_value } ) )
{
$ authenticated = 2 ;
last search_loop ;
}
}
2016-12-01 15:11:47 +00:00
}
}
2016-12-02 07:29:03 +00:00
$ res - > abandon ( ) ;
2016-12-01 15:11:47 +00:00
}
}
}
2014-05-15 16:17:21 +00:00
$ ldap - > unbind ( ) ;
2016-12-01 15:11:47 +00:00
return $ authenticated ;
2014-05-15 16:17:21 +00:00
}
2014-05-17 07:04:12 +00:00
sub authenticate_database
{
2015-04-29 14:31:15 +00:00
my ( $ dbh , $ prefix , $ userid , $ password , $ qc ) = @ _ ;
2014-05-17 07:04:12 +00:00
2022-05-30 01:28:19 +00:00
my $ query = $ dbh - > prepare ( "SELECT ${qc}userid${qc},${qc}passwd${qc} FROM ${qc}${prefix}user_account${qc} WHERE ${qc}userid${qc}=? and ${qc}enabled${qc}='Y'" ) ;
2014-05-17 16:22:56 +00:00
if ( ! $ query || ! $ query - > execute ( $ userid ) )
2014-05-17 07:04:12 +00:00
{
return ( - 1 , $ dbh - > errstr ( ) ) ;
}
2015-04-28 06:26:40 +00:00
2014-05-17 07:04:12 +00:00
my @ row = $ query - > fetchrow_array ;
$ query - > finish ( ) ;
2014-05-17 16:22:56 +00:00
if ( scalar ( @ row ) <= 0 ) { return ( 0 , undef ) ; }
my $ db_pw = $ row [ 1 ] ;
if ( length ( $ db_pw ) < 10 ) { return ( 0 , undef ) ; }
2022-05-30 01:28:19 +00:00
my $ hexsalt = substr ( $ db_pw , - 10 ) ;
my $ binsalt = pack ( 'H*' , $ hexsalt ) ;
2014-05-17 16:22:56 +00:00
2022-05-30 01:28:19 +00:00
my $ fmt_pw = '{ssha1}' . Digest::SHA:: sha1_hex ( $ password . $ binsalt ) . $ hexsalt ;
2014-05-17 16:22:56 +00:00
return ( ( $ fmt_pw eq $ db_pw ? 1 : 0 ) , undef ) ;
2014-05-17 07:04:12 +00:00
}
2014-05-15 16:17:21 +00:00
sub open_database
{
my ( $ cfg ) = @ _ ;
my $ dbtype = $ cfg - > { database_driver } ;
my $ dbname = $ cfg - > { database_name } ;
my $ dbhost = $ cfg - > { database_hostname } ;
2015-04-28 06:26:40 +00:00
my $ dbport = $ cfg - > { database_port } ;
if ( $ dbtype eq 'postgre' ) { $ dbtype = 'Pg' ; }
2015-04-29 14:31:15 +00:00
elsif ( $ dbtype eq 'oci8' ) { $ dbtype = 'Oracle' ; }
elsif ( $ dbtype eq 'mysqli' ) { $ dbtype = 'mysql' ; }
2021-09-05 14:47:49 +00:00
elsif ( $ dbtype eq 'sqlite' ) { $ dbtype = 'SQLite' ; }
2015-04-29 14:31:15 +00:00
my $ dbstr ;
my $ dbuser ;
my $ dbpass ;
if ( $ dbtype eq 'Oracle' )
{
$ dbstr = "DBI:$dbtype:" ;
$ dbuser = $ cfg - > { database_username } . '/' . $ cfg - > { database_password } . '@' . $ dbhost ;
$ dbpass = '' ;
}
2021-09-05 14:47:49 +00:00
elsif ( $ dbtype eq 'SQLite' )
{
$ dbstr = "DBI:$dbtype:database=$dbhost;" ;
$ dbuser = $ cfg - > { database_username } ;
$ dbpass = $ cfg - > { database_password } ;
}
2015-04-29 14:31:15 +00:00
else
{
$ dbstr = "DBI:$dbtype:database=$dbname;" ;
if ( length ( $ dbhost ) > 0 ) { $ dbstr . = "host=$dbhost;" ; }
if ( length ( $ dbport ) > 0 ) { $ dbstr . = "port=$dbport;" ; }
2015-04-28 06:26:40 +00:00
2015-04-29 14:31:15 +00:00
$ dbuser = $ cfg - > { database_username } ;
$ dbpass = $ cfg - > { database_password } ;
}
2014-05-15 16:17:21 +00:00
my $ dbh = DBI - > connect (
2015-04-29 14:31:15 +00:00
$ dbstr , $ dbuser , $ dbpass ,
2014-05-15 16:17:21 +00:00
{ RaiseError = > 0 , PrintError = > 0 , AutoCommit = > 0 }
) ;
return $ dbh ;
}
sub close_database
{
my ( $ dbh ) = @ _ ;
$ dbh - > disconnect ( ) ;
}
sub is_project_member
{
2015-04-29 14:31:15 +00:00
my ( $ dbh , $ prefix , $ projectid , $ userid , $ qc ) = @ _ ;
2014-05-15 16:17:21 +00:00
2022-05-30 01:28:19 +00:00
my $ query = $ dbh - > prepare ( "SELECT ${qc}projectid${qc} FROM ${qc}${prefix}project_membership${qc} WHERE ${qc}userid${qc}=? AND ${qc}projectid${qc}=?" ) ;
2014-05-15 16:17:21 +00:00
if ( ! $ query || ! $ query - > execute ( $ userid , $ projectid ) )
{
return ( - 1 , $ dbh - > errstr ( ) ) ;
}
my @ row = $ query - > fetchrow_array ;
2014-05-17 07:04:12 +00:00
$ query - > finish ( ) ;
2014-05-15 16:17:21 +00:00
return ( ( ( scalar ( @ row ) > 0 ) ? 1 : 0 ) , undef ) ;
}
sub is_project_public
{
2015-04-29 14:31:15 +00:00
my ( $ dbh , $ prefix , $ projectid , $ qc ) = @ _ ;
2014-05-15 16:17:21 +00:00
2022-05-30 01:28:19 +00:00
my $ query = $ dbh - > prepare ( "SELECT ${qc}public${qc} FROM ${qc}${prefix}project${qc} WHERE ${qc}id${qc}=?" ) ;
2014-05-15 16:17:21 +00:00
if ( ! $ query || ! $ query - > execute ( $ projectid ) )
{
return ( - 1 , $ dbh - > errstr ( ) ) ;
}
my @ row = $ query - > fetchrow_array ;
2014-05-17 07:04:12 +00:00
$ query - > finish ( ) ;
2014-05-15 16:17:21 +00:00
return ( ( ( scalar ( @ row ) > 0 && $ row [ 0 ] eq 'Y' ) ? 1 : 0 ) , undef ) ;
}
2014-05-26 06:18:30 +00:00
sub is_read_method
{
my ( $ method ) = @ _ ;
return $ method eq "GET" || $ method eq "HEAD" ||
$ method eq "OPTIONS" || $ method eq "REPORT" ||
$ method eq "PROPFIND" ;
}
2021-09-03 17:13:27 +00:00
2014-05-15 16:17:21 +00:00
sub __handler
{
my ( $ r , $ cfg , $ dbh ) = @ _ ;
my $ method = uc ( $ r - > method ( ) ) ;
2021-09-03 17:13:27 +00:00
my $ is_method_r = is_read_method ( $ method ) ;
2014-05-15 16:17:21 +00:00
2022-05-30 01:28:19 +00:00
#my ($empty, $base, $repo, $dummy) = split('/', $r->uri(), 4);
2021-09-03 17:13:27 +00:00
my @ urisegs = split ( '/' , $ r - > uri ( ) ) ;
2017-01-25 17:00:16 +00:00
my $ repo = $ urisegs [ 2 ] ;
2014-05-15 16:17:21 +00:00
my $ author ;
my $ userid = undef ;
my $ password = undef ;
2014-05-26 06:18:30 +00:00
my $ public = undef ;
my $ member = undef ;
my $ errmsg = undef ;
2015-04-29 14:31:15 +00:00
my $ qc = '' ;
if ( $ cfg - > { database_driver } eq 'oci8' ) { $ qc = '"' ; }
2014-05-15 16:17:21 +00:00
if ( $ r - > proxyreq ( ) == Apache2::Const:: PROXYREQ_PROXY )
{
$ author = $ r - > headers_in - > { 'Proxy-Authorization' } ;
}
else
{
$ author = $ r - > headers_in - > { 'Authorization' } ;
}
if ( defined ( $ author ) )
{
2022-05-30 01:28:19 +00:00
my ( $ rc , $ pass ) = $ r - > get_basic_auth_pw ( ) ;
2014-05-15 16:17:21 +00:00
if ( $ rc != Apache2::Const:: OK ) { return $ rc ; }
#$author = APR::Base64::decode((split(/ /,$author))[1]);
#($userid,$password) = split(/:/, $author);
$ userid = $ r - > user ( ) ;
$ password = $ pass ;
}
if ( ! defined ( $ userid ) ) { $ userid = "" ; }
if ( ! defined ( $ password ) ) { $ password = "" ; }
2014-05-26 06:18:30 +00:00
if ( $ is_method_r )
2014-05-15 16:17:21 +00:00
{
2021-09-03 17:13:27 +00:00
( $ public , $ errmsg ) = is_project_public ( $ dbh , $ cfg - > { database_prefix } , $ repo , $ qc ) ;
2014-05-15 16:17:21 +00:00
if ( $ public <= - 1 )
{
# failed to contact the authentication server
$ r - > log_error ( "Cannot check if a project is public - $errmsg" ) ;
return Apache2::Const:: HTTP_INTERNAL_SERVER_ERROR ;
}
elsif ( $ public >= 1 )
{
2014-05-26 06:18:30 +00:00
if ( lc ( $ cfg - > { svn_read_access } ) eq 'anonymous' )
2014-05-25 06:53:16 +00:00
{
2014-05-26 06:18:30 +00:00
# grant an anonymous user the read access.
2019-02-01 15:23:22 +00:00
if ( ! defined ( $ userid ) || $ userid eq '' )
{
# httpd 2.4 emits the following message if the user is not set
# AH00027: No authentication done but request not allowed
# without authentication for /xxx/xxx. Authentication not configured?
$ r - > user ( '<codepot-anonymous-user>' ) ;
}
2014-05-25 06:53:16 +00:00
return Apache2::Const:: OK ;
}
2021-09-03 17:13:27 +00:00
elsif ( defined ( $ cfg - > { svn_read_credential } ) && $ cfg - > { svn_read_credential } ne '' )
{
# security loop hole here.
my ( $ c_user , $ c_pass ) = split ( /:/ , $ cfg - > { svn_read_credential } ) ;
if ( $ c_user ne '' && $ c_pass ne '' && $ c_user eq $ userid && $ c_pass eq $ password )
{
return Apache2::Const:: OK ;
}
}
2014-05-15 16:17:21 +00:00
}
}
2021-09-03 17:45:24 +00:00
2014-05-17 07:04:12 +00:00
my $ auth = - 3 ;
if ( $ cfg - > { login_model } eq 'LdapLoginModel' )
{
2021-09-03 17:45:24 +00:00
$ auth = authenticate_ldap ( $ r , $ cfg , $ userid , $ password ) ;
2014-05-17 07:04:12 +00:00
}
2014-05-17 16:22:56 +00:00
elsif ( $ cfg - > { login_model } eq 'DbLoginModel' )
2014-05-17 07:04:12 +00:00
{
2021-09-03 17:45:24 +00:00
( $ auth , $ errmsg ) = authenticate_database ( $ dbh , $ cfg - > { database_prefix } , $ userid , $ password , $ qc ) ;
2015-04-28 06:26:40 +00:00
if ( $ auth <= - 1 )
{
$ r - > log_error ( "Database error - $errmsg" ) ;
}
2014-05-17 07:04:12 +00:00
}
2014-05-15 16:17:21 +00:00
if ( $ auth <= - 1 )
{
# failed to contact the authentication server
return Apache2::Const:: HTTP_INTERNAL_SERVER_ERROR ;
}
elsif ( $ auth == 0 )
{
# authentication denied
$ r - > note_basic_auth_failure ( ) ;
return Apache2::Const:: HTTP_UNAUTHORIZED ;
}
# authentication successful.
2016-12-01 15:11:47 +00:00
if ( $ is_method_r && $ public >= 1 )
2014-05-26 06:18:30 +00:00
{
2016-12-01 15:11:47 +00:00
if ( lc ( $ cfg - > { svn_read_access } ) eq 'authenticated' )
{
# grant read access to an authenticated user regardless of membership
# this applies to a public project only
return Apache2::Const:: OK ;
}
elsif ( lc ( $ cfg - > { svn_read_access } ) eq 'authenticated-insider' )
{
if ( $ auth >= 2 ) { return Apache2::Const:: OK ; }
}
2014-05-26 06:18:30 +00:00
}
2021-09-03 17:13:27 +00:00
( $ member , $ errmsg ) = is_project_member ( $ dbh , $ cfg - > { database_prefix } , $ repo , $ userid , $ qc ) ;
2014-05-15 16:17:21 +00:00
if ( $ member <= - 1 )
{
$ r - > log_error ( "Cannot check project membership - $errmsg" ) ;
return Apache2::Const:: HTTP_INTERNAL_SERVER_ERROR ;
}
elsif ( $ member == 0 )
{
# access denined
return Apache2::Const:: FORBIDDEN ;
}
else
{
# the user is a member of project. access granted.
return Apache2::Const:: OK ;
}
}
sub handler : method
{
my ( $ class , $ r ) = @ _ ;
my $ res ;
my $ cfg ;
2022-05-30 01:28:19 +00:00
$ cfg = get_config ( ) ;
2014-05-15 16:17:21 +00:00
if ( ! defined ( $ cfg ) )
{
2015-04-28 06:26:40 +00:00
$ r - > log_error ( 'Cannot load configuration' ) ;
2014-05-15 16:17:21 +00:00
return Apache2::Const:: HTTP_INTERNAL_SERVER_ERROR ;
}
2022-05-30 01:28:19 +00:00
my $ dbh = open_database ( $ cfg ) ;
2014-05-15 16:17:21 +00:00
if ( ! defined ( $ dbh ) )
{
2015-04-28 06:26:40 +00:00
$ r - > log_error ( 'Cannot open database - ' . $ DBI:: errstr ) ;
2014-05-15 16:17:21 +00:00
return Apache2::Const:: HTTP_INTERNAL_SERVER_ERROR ;
}
2021-09-03 17:45:24 +00:00
$ res = __handler ( $ r , $ cfg , $ dbh ) ;
2014-05-15 16:17:21 +00:00
close_database ( $ dbh ) ;
return $ res ;
}
2019-02-01 15:23:22 +00:00
2014-05-15 16:17:21 +00:00
1 ;