package Apache::Authn::RedmineRepoControl;

=head1 Apache::Authn::RedmineRepoControl

Module for repository access and control to interface with Redmine

=head1 SYNOPSIS

=head1 INSTALLATION

=head1 CONFIGURATION

=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");

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 APR::Pool();
use APR::Table();

my @directives = (
    {
        name         => 'RedmineDSN',
        req_override => OR_AUTHCFG,
        args_how     => TAKE1,
        errmsg       => '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,
    },
    { 
        name         => 'RedmineDbPass',
        req_override => OR_AUTHCFG,
        args_how     => TAKE1,
    },
    {
        name         => 'RedmineCacheCredsMax',
        req_override => OR_AUTHCFG,
        args_how     => TAKE1,
        errmsg => 'RedmineCacheCredsMax must be a decimal number',
    },
);

sub RedmineDSN {
    my ($self, $parms, $arg) = @_;
    $self->{RedmineDSN} = $arg;
    my $query = "SELECT 
    hashed_password, auth_source_id, permissions
    FROM members, projects, users, roles
    WHERE 
    projects.id=members.project_id 
    AND users.id=members.user_id 
    AND roles.id=members.role_id
    AND users.status=1 
    AND login=? 
    AND identifier=? ";
    $self->{RedmineQuery} = trim($query);
}

sub RedmineDbUser { set_val('RedmineDbUser', @_); }
sub RedmineDbPass { set_val('RedmineDbPass', @_); }
sub RedmineDbWhereClause { 
    my ($self, $parms, $arg) = @_;
    $self->{RedmineQuery} = trim($self->{RedmineQuery}.($arg ? $arg : "")." ");
}

sub RedmineCacheCredsMax { 
    my ($self, $parms, $arg) = @_;

    if ($arg) {
        $self->{RedmineCacheCredsCount} = 0;
        $self->{RedmineCacheCredsMax} = $arg;
    }
}

sub trim {
    my $string = shift;
    $string =~ s/\s{2,}/ /g;
    return $string;
}

sub set_val {
    my ($key, $self, $parms, $arg) = @_;
    $self->{$key} = $arg;
}

Apache2::Module::add(__PACKAGE__, \@directives);

# This is the list of all apache request methods that we are treating as "read-only" methods
my %read_only_methods = map { $_ => 1 } qw/GET PROPFIND REPORT OPTIONS/;

#
# Access is the first step in the AAA model. This funciton decides whether or not to even ask
# the user to log in. Basically, this is going to always be yes, however, if an anonymous
# person is trying to connect, and we've set that anonymous people can browse public projects
# then we will OK it, and tell apache that the authenicatin handler doesn't need to be called
# or, that the anonymous person doesn't need to log in.
#
sub access_handler {
    my $r = shift;

    my $cfg = Apache2::Module::get_config( __PACKAGE__, $r->server, $r->per_dir_config );

    unless ( $r->some_auth_required ) {
        $r->log_reason("No authentication has been configured");
        return FORBIDDEN;
    }

    return OK;
}

# 
# This is the second step in the AAA model, Authentication. If we have gotten here, we need
# to make sure the user can authenticate against redmine. 
# 
sub authen_handler {
    my $r = shift;

    my $ret = AUTH_REQUIRED;

    my ($res, $redmine_pass) = $r->get_basic_auth_pw();
    return $res unless $res == OK;

    my $redmine_user = $r->user;
    my $project_id   = get_project_identifier($r);

    if(!defined($project_id) or !defined($redmine_user)) {
        return FORBIDDEN;
    }

    my $cfg = Apache2::Module::get_config(__PACKAGE__, $r->server, $r->per_dir_config);

    #1. Check the chache for the user's credentials
    my $usrprojpass;
    my $pass_digest = Digest::SHA1::sha1_hex($redmine_pass);
    if ($cfg->{RedmineCacheCredsMax}) {
        if(!defined($cfg->{RedmineCacheCreds})) {
            $cfg->{RedmineCachePool} = APR::Pool->new;
            $cfg->{RedmineCacheCreds} = APR::Table::make($cfg->{RedmineCachePool}, $cfg->{RedmineCacheCredsMax});
        }

        $usrprojpass = $cfg->{RedmineCacheCreds}->get($redmine_user.":".$project_id);
        return OK if ( defined $usrprojpass and ( $usrprojpass eq $pass_digest ));
    }

    #2. Otherwise, authenticate the user

    # Pull the hashed password for the user from the DB
    my $dbh          = connect_database($r);
    my $sth = $dbh->prepare("SELECT hashed_password, auth_source_id FROM users WHERE users.status=1 AND login=? ");
    $sth->execute($redmine_user);

    # check the result from the DB query to try and authenticate the user
    while ( my($hashed_password, $auth_source_id) = $sth->fetchrow_array ) {
        # if there is an auth_source_id set, then skip this first part and authenticate using the auth_source
        unless($auth_source_id) {
            # otherwise, authenticate using the hashed password
            if ( $hashed_password eq $pass_digest ) {
                $ret = OK;
            }
        } elsif ($CanUseLDAPAuth) {
            # pull the auth_source configuration from the database
            my $sthldap = $dbh->prepare("SELECT host,port,tls,account,account_password,base_dn,attr_login from auth_sources WHERE id = ?;");
            $sthldap->execute($auth_source_id);
            while (my @rowldap = $sthldap->fetchrow_array) {
                # add ldap authenticate as user
                my $bind_as = $rowldap[3];
                my $bind_pw = $rowldap[4] ? $rowldap[4] : "";
                if ($bind_as =~ m/\$login/) {
                    # if we have $login in the bind user, replace it with the user
                    # trying to log in, and use their password as well
                    $bind_as =~ s/\$login/$redmine_user/g;
                    $bind_pw = $redmine_pass;
                }
                
                my $ldap = Authen::Simple::LDAP->new(
                    host   => ($rowldap[2] == 1) ? "ldaps://$rowldap[0]" : $rowldap[0],
                    port   => $rowldap[1],
                    basedn => $rowldap[5],
                    binddn => $bind_as,
                    bindpw => $bind_pw,
                    filter => "(".$rowldap[6]."=%s)"
                );

                $ret = OK if ($ldap->authenticate($redmine_user, $redmine_pass));
            }

            $sthldap->finish();
        } else {
            #there is an auth_source, but we can't use it because we don't have the LDAP module installed,
            #so error and let the user know
            $r->log_error("Cannot load the Authen::Simple::LDAP module to authenticate the user, please check
               your installation");
            $ret = SERVER_ERROR;
        }
    } 

    $sth->finish();
    $dbh->disconnect();

    #
    # If the login was successful, add it to the cache
    #
    if ($cfg->{RedmineCacheCredsMax} and $ret == OK) {
        if (defined $usrprojpass) {
            $cfg->{RedmineCacheCreds}->set($redmine_user.":".$project_id, $pass_digest);
        } else {
            if ($cfg->{RedmineCacheCredsCount} < $cfg->{RedmineCacheCredsMax}) {
                $cfg->{RedmineCacheCreds}->set($redmine_user.":".$project_id, $pass_digest);
                $cfg->{RedmineCacheCredsCount}++;
            } else {
                $cfg->{RedmineCacheCreds}->clear();
                $cfg->{RedmineCacheCredsCount} = 0;
            }
        }
    }

    $ret;
}

#
# This is the final stage in the AAA model, Authorization. This function decides
# whether or not the user is actually allowed to access this particular path.
sub authz_handler {
    my $r = shift;
    my $user = $r->user;
    my $project_id = get_project_identifier($r);
    my $req_path = get_requested_path($r);

    if($req_path =~ m{!svn}) {
        return OK;
    }

    my $perm = get_user_permission($user, $project_id, $req_path, $r);
    
    if(exists $read_only_methods{$r->method}) {
        return OK if($perm =~ /:browse_repository/);
    }
    else {
        return OK if($perm =~ /:commit_access/);
    }
    
    return FORBIDDEN;
}

#
# Returns the path requested in the repository
#
sub get_requested_path {
    my $r = shift;

    my $location = $r->location;
    my $path;
    
    if($location ne "/") {
        ($path) = $r->uri =~ m{$location/*[^/]+(/.*)};
    }
    else {
         my @path_items = split /\//, $r->uri;

         if(@path_items <= 2) {
             $path = "/";
         }
         else {
             if($path_items[2] eq "!svn") {
                 if(@path_items <= 5) {
                     return "/!svn";
                 }

                 @path_items = @path_items[5..$#path_items];
             }
             else {
                 @path_items = @path_items[2..$#path_items];
             }

             $path = "/" . join "/", @path_items;
         }
   }

   $path;
}

# 
# Returns the project identifier for a given request
#
sub get_project_identifier {
    my $r = shift;

    my $location = $r->location;
    my $identifier;

    if($location ne "/") {
        ($identifier) = $r->uri =~ m{$location/*([^/]+)};
    }
    else {
        my @path_items = split /\//, $r->uri;
        $identifier = $path_items[1];
    }

    $identifier;
}

#
# Returns a connection to the database
#
sub connect_database {
    my $r = shift;

    my $cfg = Apache2::Module::get_config( __PACKAGE__, $r->server, $r->per_dir_config );
    return DBI->connect( $cfg->{RedmineDSN}, $cfg->{RedmineDbUser},$cfg->{RedmineDbPass} );
}

sub get_role_permission {
    my ($role_id, $project_id, $req_path, $r) = @_;

    if(!defined($project_id)) {
        return '';
    }

    my $dbh = connect_database($r);
    my $sth = $dbh->prepare("SELECT path, permissions FROM repository_controls, projects
                             WHERE repository_controls.role_id='$role_id'
                             AND projects.identifier='$project_id'
                             AND repository_controls.project_id=projects.id");
    $sth->execute;
    
    my $longest_path = 0;
    my $role_perm;
    
    while(my ($path, $perm) = $sth->fetchrow_array()) {
        if($req_path =~ m{^($path).*}) {
            my $path_length = length $path;
            
            if($path_length > $longest_path) {
                $longest_path = $path_length;
                $role_perm = $perm;
            }
        }
    }
    
    $sth->finish();
    $dbh->disconnect();

    return $role_perm;
}

sub get_user_permission {
    my ($user, $project_id, $req_path, $r) = @_;
    my $user_perm;
    
    if(!defined($project_id)) {
        return '';
    }

    if($user) {
        my $dbh = connect_database($r);
        my $sth;
        my $role_id;

        $sth = $dbh->prepare("SELECT role_id FROM member_roles 
                                INNER JOIN users 
                                  ON users.login='$user' 
                                INNER JOIN projects 
                                  ON projects.identifier='$project_id' 
                                INNER JOIN members 
                                  ON members.user_id=users.id 
                                  AND members.project_id=projects.id 
                                INNER JOIN roles 
                                  ON roles.id=member_roles.role_id 
                              WHERE member_roles.member_id=members.id 
                              ORDER BY position 
                              LIMIT 1");
        $sth->execute;
        ($role_id) = $sth->fetchrow_array();
        $sth->finish();
        
        if(defined $role_id) {
            my $longest_path = 0;
        
            $sth = $dbh->prepare("SELECT path, permissions FROM repository_controls 
                                    INNER JOIN projects 
                                      ON projects.identifier='$project_id' 
                                    WHERE repository_controls.project_id=projects.id 
                                    AND repository_controls.role_id=$role_id");
            $sth->execute;
            
            while(my ($path, $perm) = $sth->fetchrow_array()) {
                if($req_path =~ m{^($path).*}) {
                    my $path_length = length $path;
                    
                    if($path_length > $longest_path) {
                        $longest_path = $path_length;
                        $user_perm = $perm;
                    }
                }
            }

            $sth->finish();
        }
        else {
            # non-member access
            $user_perm = get_role_permission('1', $project_id, $req_path, $r);
        }
        $dbh->disconnect();
    }
    else {
        # anonymous access
        $user_perm = '';
    }

    if(!defined($user_perm)) {
        $user_perm = '';
    }

    return $user_perm;
}

1;