You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl@perl.apache.org by Dennis Stout <st...@stout.dyndns.org> on 2003/07/02 23:44:08 UTC
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;
}
Re: If (!$one_thing) {$other;}
Posted by John Michael <jo...@acadiacom.net>.
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" <st...@stout.dyndns.org>
To: <mo...@perl.apache.org>
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;
> }
>
Re: If (!$one_thing) {$other;}
Posted by Ged Haywood <ge...@www2.jubileegroup.co.uk>.
Hi there,
On Wed, 2 Jul 2003, Dennis Stout wrote:
> This also means I can write a small subroutine to eval a form that's been
> posted, and given the authentication passes, add code to the thing while it's
> running, AND save the code to the DB so it'll be around for reboots.
>
> Wouldn't that just be awesome?
Can I urge a little caution?
73,
Ged.
Re: If (!$one_thing) {$other;}
Posted by Dennis Stout <st...@stout.dyndns.org>.
> I think when I'm done and get this roled out, I'll work on making something
> very similar but completely database driven. All the functions in the
> dispatch table will be brought in through a single SQL statement called in
an
> eval context.
This also means I can write a small subroutine to eval a form that's been
posted, and given the authentication passes, add code to the thing while it's
running, AND save the code to the DB so it'll be around for reboots.
Wouldn't that just be awesome?
A totally dynamic web driven database that can be completely reconfigured on
the fly.
I wonder if using <Perl></Perl> sections in the httpd.conf file, if a guy
could put the entire RequestHandler in a database as well.... heh
I spose that might take some work, probably with vi and gcc, on apache source
files.
Dennis
Re: If (!$one_thing) {$other;}
Posted by Dennis Stout <st...@stout.dyndns.org>.
> On Wed, 2003-07-02 at 21:24, Dennis Stout wrote:
> > > Okay, I put in some code to take the generated headers and enter them
into
> > the
> > > body of the page. This had an odd effect.
> >
> > I bet I have a login problem.
Whoops. logic problem. YAY, maybe the core of all my problems is vast
amounts of typo's caused by carpal tunnel =/
> You lost me. You were having problems with headers not being sent,
> right? That probably means that either $r is not the Apache object you
> think it is, or your program is not actually calling send_http_header.
> Have you done enough debugging to rule both of those things out?
$r is indeed the correct Apache object.
Where I believe hte problem exists is in the PerlSendHeaders dealybob John
mentioned in a private email to me...
I'm currently taking a break from that section of hte program and have
disabled it with a series of #'s for now... I'm going to work more directly
with the SQL interface I'm making. I think I'll junk what I have and write a
new one from scratch....
I think when I'm done and get this roled out, I'll work on making something
very similar but completely database driven. All the functions in the
dispatch table will be brought in through a single SQL statement called in an
eval context.
I might work on that once I have sufficiently pounded my brain with enough
beer.
mmmmm, 4 day weekend....
Dennis
Re: If (!$one_thing) {$other;}
Posted by Perrin Harkins <pe...@elem.com>.
On Wed, 2003-07-02 at 21:24, Dennis Stout wrote:
> > Okay, I put in some code to take the generated headers and enter them into
> the
> > body of the page. This had an odd effect.
>
> I bet I have a login problem.
You lost me. You were having problems with headers not being sent,
right? That probably means that either $r is not the Apache object you
think it is, or your program is not actually calling send_http_header.
Have you done enough debugging to rule both of those things out?
- Perrin
Re: If (!$one_thing) {$other;}
Posted by Dennis Stout <st...@stout.dyndns.org>.
> > Not likely. Your syntax looks okay to me. It probably isn't being
> > called for some reason, or else $r is not what you think it is. Throw
> > in some debug statements and find out what's actually happening there.
>
>
> Okay, I put in some code to take the generated headers and enter them into
the
> body of the page. This had an odd effect.
I bet I have a login problem.
User tries to do whatever. Gets asked to login. Fills in login form, hits
submit, but posting is a request in and of itself. So the request for the cgi
is made, user doesn;'t have a valid cookie yet, gets redirected to the login
page ...
Dennis
Re: If (!$one_thing) {$other;}
Posted by Dennis Stout <st...@stout.dyndns.org>.
> Not likely. Your syntax looks okay to me. It probably isn't being
> called for some reason, or else $r is not what you think it is. Throw
> in some debug statements and find out what's actually happening there.
Okay, I put in some code to take the generated headers and enter them into the
body of the page. This had an odd effect.
I got headers at hte TOP of hte page, before the <html> tags, and here is what
it reads:
HTTP/1.1 200 OK
Date: Wed, 02 Jul 2003 22:33:52 GMT
Server: Apache/1.3.27 (Unix) mod_perl/1.27
Connection: close
Content-Type: text/html
Set-Cookie:
So the cookie it's trying to set is wrong, but I can work on that later. Why
is it not sending it normally? More importantly, why am I seeing this when I
view source? I'm not supposed to ever see header info.
Dennis
Re: If (!$one_thing) {$other;}
Posted by Perrin Harkins <pe...@elem.com>.
On Wed, 2003-07-02 at 17:44, Dennis Stout wrote:
> $r->send_http_header; must be broken, eh?
Not likely. Your syntax looks okay to me. It probably isn't being
called for some reason, or else $r is not what you think it is. Throw
in some debug statements and find out what's actually happening there.
- Perrin