If (!$one_thing) {$other;}

[Dennis Stout]

This is irking me.

$state preserves information about the request and so on.  Now,
$r->whatever_method works just fine.. EXCEPT for sending headers.  When I
visit my site, I get my nifty login page, and that is all.  Always the login
page.

I telnetted into the thing to see what kinds of cookie strings I was getting
back and... NO HEADERS!  No Content-type: 's or nothing.

$r->send_http_header; must be broken, eh?  How to fix?? =P

I'll spare all of your eyes by not sending complete source, but here's the
basic idea.


#!/usr/bin/perl

package RequestHandler;
use strict;

# snipped out a lot of use vars qw();'s and $val = blah.

sub handler {
        my $r = shift;
        my $result = undef;

        eval { $result = inner_handler($r) };
        return $result unless $@;

        warn "Uncaught Exception: $@";

        return SERVER_ERROR;
}

sub inner_handler {
        my $r = shift;

        my %q = ($r->args, $r->content);
        my %state = (r => $r, q => \%q);

        $state{login_user} = '';
        $state{login_pass} = '';
        $state{title} = '';
        $state{template} = '';
        $state{auth_status} = password_boxes(\%state);

        validate_auth_cookie(\%state);

        my $function = $r->uri;
        $function = '/login.html' if $state{login_user} eq '';
        my $func = $Dispatch{$function} || $Dispatch{DEFAULT};

        return $func->(\%state);
}

sub output_html {
        my $state = shift;
        my %args = @_;
        my $title = $state->{title};
        my $r = $state->{r};

        $r->status(200);

        my $template = HTML::Template->new(
                filename                =>
"$Template_Dir/$state->{template}",
                die_on_bad_params       => 0,
        );

        $template->param(TITLE => $title);
        eval { foreach (keys %args) {
                $template->param($_ => $args{$_});
        }};
        $template->param(ERRORS => $@) if $@;

        $r->header_out( 'Set-Cookie' => $state->{cookie_out} ) if
$state->{cookie_out};
        $r->send_http_header('text/html');
        print $template->output();
}

sub get_password {
        my $state = shift;

        my $row = $Sql->select_hashref('DECODE(PWORD,\'blah\')', 'techs',
"TECH=\"$state->{
q}->{login_user}\"");
        return $row->{"DECODE(PWORD,'blah')"};
}

sub build_auth_string {
        my $state = shift;
        my $ip = shift || $ENV{REMOTE_ADDR};
        my $time = shift || time;

        my $login = $state->{login_user};
        my $password = $state->{login_pass};
        my $val = join "::", $login, $ip, $password, $time;

        # Iterate thru by 8 byte hunks.
        # with the added 8 spaces, do not do the last hunk
        # which will be all spaces
        my $blown;
        my $pos;
        for ( $pos = 0;  (($pos + 8) < length($val) ) ; $pos+=8 ) {
                $blown .= $cipher->encrypt(substr($val, $pos, 8));
                # encrypt this without temp vars
        }

        my $enc  = encode_base64($blown,"");

        $enc;
}

sub parse_auth_string {
        my $state  = shift;
        my $cookie = shift;

        return unless $cookie;
        return if $cookie =~ /logged_out/;

        my $unenc= decode_base64($cookie);
        my $unblown;

        # start at 8, take 8 bytes at a time
        # $unenc should be exactly a multiple of 8 bytes.

        my $pos;
        for ( $pos = 0; $pos<length($unenc); $pos += 8) {
                $unblown .= $cipher->decrypt(substr($unenc, $pos, 8));
        }
        my ($login, $ip, $password, $time)=split ( /::/, $unblown, 4);
}

sub get_auth_cookie {
        my $state=shift;
        my $cookie = TTMSCGI->parse_cookie($ENV{HTTP_COOKIE})->{ttms_user};
        my($login, $ip, $password, $time) = parse_auth_string($state,
$cookie);
        ($login, $ip, $password, $time);
}

sub set_auth_cookie {
        my $state = shift;

        my $val = build_auth_string($state);
        my $c = TTMSCGI->build_cookie(
                name    => 'ttms_user',
                value   => $val,
                expires => time + 86400*30*7,
                domain  => $Cookie_Domain,
                path    => '/',
        );
        $state->{cookie_out} = $c;
}

sub build_logout_cookie {
        TTMSCGI->build_cookie(
                name   => 'ttms_user',
                value  => "logged_out",
                expires=> time - 86400,
                domain => $Cookie_Domain,
                path   => '/'
        );
}

sub set_logout_cookie {
        my $state = shift;
        $state->{cookie_out} = build_logout_cookie($state);
}

sub validate_auth_cookie {
        my $state = shift;
        my ($login, $ip, $pass, $time) = get_auth_cookie($state);
        return unless $login && $pass;

        my $checkpass = get_password($state);
        if ($pass eq $checkpass) {
                $state->{login_user} = $login;
                $state->{login_pass} = $pass;
                $state->{auth_status} = "Logged in as $state->{login_user}";
                return;
        }
        return;
}