Here is a little script I wrote a while back so that I could look at headers being sent from my server in a browser window. JM.
----- Original Message -----
From: "Dennis Stout" <[EMAIL PROTECTED]>
To: <[EMAIL PROTECTED]>
Sent: Wednesday, July 02, 2003 4:44 PM
Subject: If (!$one_thing) {$other;}
> 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;
> }
>
header.pl
Description: Binary data
