The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package RT::Authen::ExternalAuth::DBI;

use DBI;
use RT::Authen::ExternalAuth::DBI::Cookie;

use strict;

sub GetAuth {

    my ($service, $username, $password) = @_;
    
    my $config = $RT::ExternalSettings->{$service};
    $RT::Logger->debug( "Trying external auth service:",$service);

    my $db_table        = $config->{'table'};
    my $db_u_field      = $config->{'u_field'};
    my $db_p_field 	    = $config->{'p_field'};
    my $db_p_enc_pkg    = $config->{'p_enc_pkg'};
    my $db_p_enc_sub    = $config->{'p_enc_sub'};
    my $db_p_salt       = $config->{'p_salt'};

    # Set SQL query and bind parameters
    my $query = "SELECT $db_u_field,$db_p_field FROM $db_table WHERE $db_u_field=?";
    my @params = ($username);
    
    # Uncomment this to trace basic DBI information and drop it in a log for debugging
    # DBI->trace(1,'/tmp/dbi.log');

    # Get DBI handle object (DBH), do SQL query, kill DBH
    my $dbh = _GetBoundDBIObj($config);
    return 0 unless $dbh;
    
    my $results_hashref = $dbh->selectall_hashref($query,$db_u_field,{},@params);
    $dbh->disconnect();

    my $num_users_returned = scalar keys %$results_hashref;
    if($num_users_returned != 1) { # FAIL
        # FAIL because more than one user returned. Users MUST be unique! 
        if ((scalar keys %$results_hashref) > 1) {
            $RT::Logger->info(  $service,
                                "AUTH FAILED",
                                $username,
                                "More than one user with that username!");
        }

        # FAIL because no users returned. Users MUST exist! 
        if ((scalar keys %$results_hashref) < 1) {
            $RT::Logger->info(  $service,
                                "AUTH FAILED",
                                $username,
                                "User not found in database!");
        }

	    # Drop out to next external authentication service
	    return 0;
    }
    
    # Get the user's password from the database query result
    my $pass_from_db = $results_hashref->{$username}->{$db_p_field};        

    # This is the encryption package & subroutine passed in by the config file
    $RT::Logger->debug( "Encryption Package:",
                        $db_p_enc_pkg);
    $RT::Logger->debug( "Encryption Subroutine:",
                        $db_p_enc_sub);

    # Use config info to auto-load the perl package needed for password encryption
    # I know it uses a string eval - but I don't think there's a better way to do this
    # Jump to next external authentication service on failure
    eval "require $db_p_enc_pkg" or 
        $RT::Logger->error("AUTH FAILED, Couldn't Load Password Encryption Package. Error: $@") && return 0;
    
    my $encrypt = $db_p_enc_pkg->can($db_p_enc_sub);
    if (defined($encrypt)) {
        # If the package given can perform the subroutine given, then use it to compare the
        # password given with the password pulled from the database.
        # Jump to the next external authentication service if they don't match
        if(defined($db_p_salt)) {
            $RT::Logger->debug("Using salt:",$db_p_salt);
            if(${encrypt}->($password,$db_p_salt) ne $pass_from_db){
                $RT::Logger->info(  $service,
                                    "AUTH FAILED", 
                                    $username, 
                                    "Password Incorrect");
                return 0;
            }
        } else {
            if(${encrypt}->($password) ne $pass_from_db){
                $RT::Logger->info(  $service,
                                    "AUTH FAILED", 
                                    $username, 
                                    "Password Incorrect");
                return 0;
            }
        }
    } else {
        # If the encryption package can't perform the request subroutine,
        # dump an error and jump to the next external authentication service.
        $RT::Logger->error($service,
                            "AUTH FAILED",
                            "The encryption package you gave me (",
                            $db_p_enc_pkg,
                            ") does not support the encryption method you specified (",
                            $db_p_enc_sub,
                            ")");
            return 0;
    }
    
    # Any other checks you want to add? Add them here.

    # If we've survived to this point, we're good.
    $RT::Logger->info(  (caller(0))[3], 
                        "External Auth OK (",
                        $service,
                        "):", 
                        $username);
    
    return 1;   
}

sub CanonicalizeUserInfo {
    
    my ($service, $key, $value) = @_;

    my $found = 0;
    my %params = (Name         => undef,
                  EmailAddress => undef,
                  RealName     => undef);
    
    # Load the config
    my $config = $RT::ExternalSettings->{$service};
    
    # Figure out what's what
    my $table      = $config->{'table'};

    unless ($table) {
        $RT::Logger->critical(  (caller(0))[3],
                                "No table given");
        # Drop out to the next external information service
        return ($found, %params);
    }

    unless ($key && $value){
        $RT::Logger->critical(  (caller(0))[3],
                                " Nothing to look-up given");
        # Drop out to the next external information service
        return ($found, %params);
    }
    
    # "where" refers to WHERE section of SQL query
    my ($where_key,$where_value) = ("@{[ $key ]}",$value);

    # Get the list of unique attrs we need
    my %db_attrs = map {$_ => 1} values(%{$config->{'attr_map'}});
    my @attrs = keys(%db_attrs);
    my $fields = join(',',@attrs);
    my $query = "SELECT $fields FROM $table WHERE $where_key=?";
    my @bind_params = ($where_value);

    # Uncomment this to trace basic DBI throughput in a log
    # DBI->trace(1,'/tmp/dbi.log');
    my $dbh = _GetBoundDBIObj($config);
    my $results_hashref = $dbh->selectall_hashref($query,$key,{},@bind_params);
    $dbh->disconnect();

    if ((scalar keys %$results_hashref) != 1) {
        # If returned users <> 1, we have no single unique user, so prepare to die
        my $death_msg;
        
	    if ((scalar keys %$results_hashref) == 0) {
            # If no user...
	        $death_msg = "No User Found in External Database!";
        } else {
            # If more than one user...
            $death_msg = "More than one user found in External Database with that unique identifier!";
        }

        # Log the death
        $RT::Logger->info(  (caller(0))[3],
                            "INFO CHECK FAILED",
                            "Key: $key",
                            "Value: $value",
                            $death_msg);
        
        # $found remains as 0
        
        # Drop out to next external information service
        return ($found, %params);
    }

    # We haven't dropped out, so DB search must have succeeded with 
    # exactly 1 result. Get the result and set $found to 1
    my $result = $results_hashref->{$value};
 
    # Use the result to populate %params for every key we're given in the config
    foreach my $key (keys(%{$config->{'attr_map'}})) {
        $params{$key} = ($result->{$config->{'attr_map'}->{$key}})[0];
    }
    
    $found = 1;
  
    return ($found, %params);
}

sub UserExists {
    
    my ($username,$service) = @_;
    my $config              = $RT::ExternalSettings->{$service};
    my $table    	        = $config->{'table'};
    my $u_field	            = $config->{'u_field'};
    my $query               = "SELECT $u_field FROM $table WHERE $u_field=?";
    my @bind_params         = ($username);

    # Uncomment this to do a basic trace on DBI information and log it
    # DBI->trace(1,'/tmp/dbi.log');
    
    # Get DBI Object, do the query, disconnect
    my $dbh = _GetBoundDBIObj($config);
    my $results_hashref = $dbh->selectall_hashref($query,$u_field,{},@bind_params);
    $dbh->disconnect();

    my $num_of_results = scalar keys %$results_hashref;
        
    if ($num_of_results > 1) { 
        # If more than one result returned, die because we the username field should be unique!
        $RT::Logger->debug( "Disable Check Failed :: (",
                            $service,
                            ")",
                            $username,
                            "More than one user with that username!");
        return 0;
    } elsif ($num_of_results < 1) { 
        # If 0 or negative integer, no user found or major failure
        $RT::Logger->debug( "Disable Check Failed :: (",
                            $service,
                            ")",
                            $username,
                            "User not found");   
        return 0; 
    }
    
    # Number of results is exactly one, so we found the user we were looking for
    return 1;            
}

sub UserDisabled {

    my ($username,$service) = @_;
    
    # FIRST, check that the user exists in the DBI service
    unless(UserExists($username,$service)) {
        $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking");
        return 0;
    }
    
    # Get the necessary config info
    my $config              = $RT::ExternalSettings->{$service};
    my $table    	        = $config->{'table'};
    my $u_field	            = $config->{'u_field'};
    my $disable_field       = $config->{'d_field'};
    my $disable_values_list = $config->{'d_values'};

    unless ($disable_field) {
        # If we don't know how to check for disabled users, consider them all enabled.
        $RT::Logger->debug("No d_field specified for this DBI service (",
                            $service,
                            "), so considering all users enabled");
        return 0;
    } 
    
    my $query = "SELECT $u_field,$disable_field FROM $table WHERE $u_field=?";
    my @bind_params = ($username);

    # Uncomment this to do a basic trace on DBI information and log it
    # DBI->trace(1,'/tmp/dbi.log');
    
    # Get DBI Object, do the query, disconnect
    my $dbh = _GetBoundDBIObj($config);
    my $results_hashref = $dbh->selectall_hashref($query,$u_field,{},@bind_params);
    $dbh->disconnect();

    my $num_of_results = scalar keys %$results_hashref;
        
    if ($num_of_results > 1) { 
        # If more than one result returned, die because we the username field should be unique!
        $RT::Logger->debug( "Disable Check Failed :: (",
                            $service,
                            ")",
                            $username,
                            "More than one user with that username! - Assuming not disabled");
        # Drop out to next service for an info check
        return 0;
    } elsif ($num_of_results < 1) { 
        # If 0 or negative integer, no user found or major failure
        $RT::Logger->debug( "Disable Check Failed :: (",
                            $service,
                            ")",
                            $username,
                            "User not found - Assuming not disabled");   
        # Drop out to next service for an info check
        return 0;             
    } else { 
        # otherwise all should be well
        
        # $user_db_disable_value = The value for "disabled" returned from the DB
        my $user_db_disable_value = $results_hashref->{$username}->{$disable_field};
        
        # For each of the values in the (list of values that we consider to mean the user is disabled)..
        foreach my $disable_value (@{$disable_values_list}){
            $RT::Logger->debug( "DB Disable Check:", 
                                "User's Val is $user_db_disable_value,",
                                "Checking against: $disable_value");
            
            # If the value from the DB matches a value from the list, the user is disabled.
            if ($user_db_disable_value eq $disable_value) {
                return 1;
            }
        }
        
        # If we've not returned yet, the user can't be disabled
        return 0;
    }
    $RT::Logger->crit("It is seriously not possible to run this code.. what the hell did you do?!");
    return 0;
}

sub GetCookieAuth {

    $RT::Logger->debug( (caller(0))[3],
	                "Checking Browser Cookies for an Authenticated User");
			     
    # Get our cookie and database info...
    my $config = shift;

    my $username = undef;
    my $cookie_name = $config->{'name'};

    my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($cookie_name);

    unless($cookie_value){
        return $username;
    }

    # The table mapping usernames to the Username Match Key
    my $u_table     = $config->{'u_table'};
    # The username field in that table
    my $u_field     = $config->{'u_field'};
    # The field that contains the Username Match Key
    my $u_match_key = $config->{'u_match_key'};

    # The table mapping cookie values to the Cookie Match Key
    my $c_table     = $config->{'c_table'};
    # The cookie field in that table - The same as the cookie name if unspecified
    my $c_field     = $config->{'c_field'};
    # The field that connects the Cookie Match Key
    my $c_match_key = $config->{'c_match_key'};

    # These are random characters to assign as table aliases in SQL
    # It saves a lot of garbled code later on
    my $u_table_alias = "u";
    my $c_table_alias = "c";

    # $tables will be passed straight into the SQL query
    # I don't see this as a security issue as only the admin may modify the config file anyway
    my $tables;

    # If the tables are the same, then the aliases should be the same
    # and the match key becomes irrelevant. Ensure this all works out
    # fine by setting both sides the same. In either case, set an
    # appropriate value for $tables.
    if ($u_table eq $c_table) {
            $u_table_alias  = $c_table_alias;
            $u_match_key    = $c_match_key;
            $tables         = "$c_table $c_table_alias";
    } else {
            $tables = "$c_table $c_table_alias, $u_table $u_table_alias";
    }

    my $select_fields = "$u_table_alias.$u_field";
    my $where_statement = "$c_table_alias.$c_field = ? AND $c_table_alias.$c_match_key = $u_table_alias.$u_match_key";

    my $query = "SELECT $select_fields FROM $tables WHERE $where_statement";
    my @params = ($cookie_value);

    # Use this if you need to debug the DBI SQL process
    # DBI->trace(1,'/tmp/dbi.log');

    my $dbh = _GetBoundDBIObj($RT::ExternalSettings->{$config->{'db_service_name'}});
    my $query_result_arrayref = $dbh->selectall_arrayref($query,{},@params);
    $dbh->disconnect();

    # The log messages say it all here...
    my $num_rows = scalar @$query_result_arrayref;
    if ($num_rows < 1) {
        $RT::Logger->info(  "AUTH FAILED",
                            $cookie_name,
                            "Cookie value not found in database.",
                            "User passed an authentication token they were not given by us!",
                            "Is this nefarious activity?");
    } elsif ($num_rows > 1) {
        $RT::Logger->error( "AUTH FAILED",
                            $cookie_name,
                            "Cookie's value is duplicated in the database! This should not happen!!");
    } else {
        $username = $query_result_arrayref->[0][0];
    }

    if ($username) {
        $RT::Logger->debug( "User (",
                            $username,
                            ") was authenticated by a browser cookie");
    } else {
        $RT::Logger->debug( "No user was authenticated by browser cookie");
    }

    return $username;

}


# {{{ sub _GetBoundDBIObj

sub _GetBoundDBIObj {
    
    # Config as hashref. 
    my $config = shift;

    # Extract the relevant information from the config.
    my $db_server     = $config->{'server'};
    my $db_user       = $config->{'user'};
    my $db_pass       = $config->{'pass'};
    my $db_database   = $config->{'database'};
    my $db_port       = $config->{'port'};
    my $dbi_driver    = $config->{'dbi_driver'};

    # Use config to create a DSN line for the DBI connection
    my $dsn;
    if ( $dbi_driver eq 'SQLite' ) {
        $dsn = "dbi:$dbi_driver:$db_database";
    }
    else {
        $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
    }

    # Now let's get connected
    my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })
            or die $DBI::errstr;

    # If we didn't die, return the DBI object handle 
    # and hope it's treated sensibly and correctly 
    # destroyed by the calling code
    return $dbh;
}

# }}}

1;