The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# Creation date: 2003-10-05 21:23:01
# Authors: Don
# Change log:
# $Id: login.cgi,v 1.1 2003/10/19 06:57:18 don Exp $

# Copyright (c) 2003 Don Owens

# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.

use strict;
use Carp;

# main
{
    local($SIG{__DIE__}) = sub { local(*STDERR) = *STDOUT;
                                 print "Content-Type: text/plain\n\n";
                                 &Carp::cluck(); exit 0 };

    use CGI::Utils;
    use Apache::Authen::Generic;
    
    my $cgi = CGI::Utils->new;
    $cgi->parse;
    my $fields = $cgi->vars;

    my $username = $$fields{username};
    my $password = $$fields{password};
    my $ref_url = $$fields{ref_url};

    if ($username eq 'test' and $password eq 'pwd') {
        my $key = q{abcdefghijklmnopqrstuvwxyz012346};
        my $auth = Apache::Authen::Generic->new;
        my $cookie = $auth->generateAuthCookie({ test_var1 => 1, auth_level => 8 },
                                               $key, {}, 'test_cookie');
        if ($ref_url =~ m{^/}) {
            $ref_url = $cgi->getSelfRefHostUrl . $ref_url;
        }
        print "Set-Cookie: $cookie\n";
        print "Location: $ref_url\n\n";
        exit 0;
    } else {
        my $args = { ref_url => $ref_url, msg => 'Password does not match' };
        my $url = '/cgi-bin/login/login_form.cgi';
        $url = $cgi->addParamsToUrl($url, $args);
        print "Location: $url\n\n";
        exit 0;
    }

}

exit 0;

###############################################################################
# Subroutines