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