view release on metacpan or  search on metacpan

Program.pm  view on Meta::CPAN

# Apache::Authen::Program allows you to call an external program
# that performs username/password authentication in Apache.
#
# Copyright (c) 2002-2004 Mark Leighton Fisher, Fisher's Creek Consulting, LLC
# 
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.


package Apache::Authen::Program;

use strict;
use Apache::Constants ':common';
use File::Temp q(tempfile);

$Apache::Authen::Program::VERSION = '0.93';


sub handler {
    my $request  = shift;	# Apache request object
    my @args     = ();		# authentication program arguments
    my $cmd      = "";		# program command string
    my $i        = 0;		# counter for @args
    my $ofh      = "";		# output file handle for password temp file
    my $password = "";		# password from Basic Authentication
    my $passfile = "";		# temporary file containing password
    my $passtype = "";		# "File" if communicating password by temp file
    my $program  = "";		# authentication program filename
    my $response = ""; 		# Apache response object
    my $success  = "";		# success string from authentication program
    my $username = "";		# username from Basic Authentication

    # get password, decline if not Basic Authentication
    ($response, $password) = $request->get_basic_auth_pw;
    return $response if $response;

    # get username
    $username = $request->connection->user;
    if ($username eq "") {
	$request->note_basic_auth_failure;
        $request->log_reason("Apache::Authen::Program - No Username Given", $request->uri);
        return AUTH_REQUIRED;
    }

    # get authentication program, args, and success string
    $program = $request->dir_config("AuthenProgram");
    for ($i = 1; $i < 10; $i++) {
        $args[$i] = $request->dir_config("AuthenProgramArg$i");
    }
    $success = $request->dir_config("AuthenProgramSuccess");

    # write temp. password file on request
    $passtype = $request->dir_config("AuthenProgramPassword");
    if ($passtype eq "File") {
        ($ofh, $passfile) = tempfile();
        if (!defined($ofh) || $ofh eq "") {
            $request->log_reason("Apache::Authen::Program can't create password file",
	     $request->uri);
            return SERVER_ERROR;
        }
        chmod(0600, $passfile)
         || $request->log_reason(
         "Apache::Authen::Program can't chmod 0600 password file '$passfile' because: $!",
	 $request->uri);
        if (!print $ofh $password,"\n") {
            $request->log_reason("Apache::Authen::Program can't write password file '$ofh'",
	     $request->uri);
            return SERVER_ERROR;
        }
        if (!close($ofh)) {
            $request->log_reason("Apache::Authen::Program can't close password file '$ofh'",
	     $request->uri);
            return SERVER_ERROR;
        }
        $password = $passfile;
    }

    # execute command, then examine output for success or failure
    $cmd = "$program '$username' '$password' ";
    $cmd .= join(' ', @args);
    my @output = `$cmd`;
    if ($passtype eq "File") {
        if (!unlink($passfile)) {
            $request->log_reason("Apache::Authen::Program can't delete password file '$ofh'",
	     $request->uri);
        }
    }
    if (!grep(/$success/, @output)) {
	$request->note_basic_auth_failure;
	$request->log_reason("login failure: " . join(' ', @output), $request->uri);
	return AUTH_REQUIRED;
    }

    unless (@{ $request->get_handlers("PerlAuthzHandler") || []}) {
	$request->push_handlers(PerlAuthzHandler => \&authz);
    }

    return OK;
}

sub authz {
    my $request = shift;		# Apache request
    my $requires = $request->requires;	# Apache Requires arrayref
    my $username			# username
      = $request->connection->user;
    my $require = "";			# one Requires statement
    my $type    = "";			# type of Requires
    my @users   = ();			# list of valid users

    # decline unless we have a requires
    return OK unless $requires;

    # process each Requires statement
    for my $require (@$requires) {
        my($type, @users) = split /\s+/, $require->{requirement};

	# user is one of these users
	if ($type eq "user") {
	    return OK if grep($username eq $_, @users);

	# user is simply authenticated
	} elsif ($type eq "valid-user") {
	    return OK;