Apache Module in Perl

############################################################################
#   Apache::AuthbyWebAuthSess
#   by Paul Main
#   oit@uci.edu
#
############################################################################

package Apache::AuthbyWebAuthSess;

use Apache::compat;
use Apache::Constants qw(:common :http);
use LWP;
use CGI::Cookie;
use strict;

sub handler {
    my $r = shift;

    my $localserver='http://' INSERT HOST NAME HERE e.g. 'http://www.uci.edu/'
    #return OK unless $r->is_initial_req;

    my $debug=1;

    my @users=split(/[,\s]/,$r->dir_config('users'));

    my $timeout= $r->dir_config('Timeout') || 36000;
    my $auth_page = 'https://login.uci.edu/ucinetid/webauth';

    my $host = $r->connection->remote_ip;
    my $url=$r->uri;
    $url=~s/&/;;38;/g;
    $url = 'http://'.$localserver.$url unless $url=~/http/;
    $auth_page .= "?return_url=$url";

    my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
    my $key=$cookies{'ucinetid_auth'}; $key=~s/ucinetid_auth=//;
    $key=~s/; path.*//;

    if (-e "/tmp/".$key)
    {
    open (KEYFILE, "/tmp/".$key);
    my $ucinetid = <KEYFILE>;
    chomp $ucinetid;
    my $inittime = <KEYFILE>;
    chomp $inittime;
    my $ipaddress = <KEYFILE>;
    chomp $ipaddress;
    close (KEYFILE);

    if (($inittime + $timeout > time) && ($ucinetid) && ($ipaddress eq $host))
    {

    $r->subprocess_env('ucinetid' => $ucinetid);
    $r->user($ucinetid);
    return OK;
    }
    else
    {
    unlink "/tmp/".$key;
    }
    }

    my $reason = login($r, $host, $key, $timeout, @users);

    if($reason) {
        #$r->note_basic_auth_failure;
    # only print reason into error_log if in debug mode
        $r->log_reason($reason, $r->filename) if $debug; 
        # This can be set to a URL explaining that the USER is logged in
        # but not authorized 
     #   $auth_page = 'https://login.uci.edu/notallowed' if ($reason =~ /Authorization/);
        $r->custom_response(HTTP_UNAUTHORIZED, $auth_page);
        return HTTP_UNAUTHORIZED;
    }

    # if no error message from login(), assume everything is OK
    return OK;
}

sub login {
    my($r, $host, $key, $timeout, @users) = @_;

    if (!$key)
        {
        return "Authentication Failure - No Key";   
        }

    my $valid_user = 1 if grep(/valid-user/,@users);

    my $auth_url='http://login.uci.edu/ucinetid/webauth_check';
    my $auth_check="$auth_url?ucinetid_auth=$key";

    my $ua = new LWP::UserAgent;
    my $req = new HTTP::Request 'GET',$auth_check;
    my $response = $ua->request($req) or die "$? $!";

    my %authcheck;
    for (split(/\n/,$response->content)) {
        my ($k,$v) = split (/=/);
        $authcheck{$k}=$v;
    }

    if ($authcheck{auth_fail}=~/not found/ or $authcheck{auth_fail}=~/no ucinetid_auth provided/) {
        return "Authentication Failure - $key not in database";
    }

    if ($host ne $authcheck{auth_host}) {
        return  "Authentication Failure - Host $host ($authcheck{auth_host} - $key -".$response->content.") not in database";
    }
    if ($authcheck{age_in_seconds} > $timeout) {
        return "Authentication Failure - Host $host registration expired.";
    }

    unless ($valid_user or grep(/^$authcheck{ucinetid}$/,@users)) {
        return "Authorization Failure - $authcheck{ucinetid} not allowed access.";
    }

#   $r->notes('ucinetid' => $authcheck{ucinetid});

    $r->subprocess_env('ucinetid' => $authcheck{ucinetid});
    $r->user($authcheck{ucinetid});

    open  (KEYFILE, ">/tmp/".$key);
    print KEYFILE $authcheck{ucinetid}."\n".time()."\n".$host;
    close (KEYFILE);
    return "";
}

1;
__END__

 

Scroll Up