Re: If (!$one_thing) {$other;}
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.
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; $poslength($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;
}
if (!$one_thing) { $other; }
I suppose the subroutine that makes the call to it would help too.
I'll spare you all the dispatch routine as it's quite lengthy, but basically
the DispatchTbl::* generates webpages dynamically depending on the uri
caught by RequestHandler::handler();.
sub post_login_form {
my $state = shift;
my %args = $state-{q};
$state-{template} = 'generic.tmpl';
$state-{title} = 'TTMS Login';
my $checkpass = get_password($state);
if ($checkpass eq $state-{q}{login_pass}) {
$state-{login_user} = $state-{q}{login_user};
$state-{login_pass} = $state-{q}{login_pass};
$state-{auth_status} = Logged in as $state-{login_user};
set_auth_cookie($state);
$args{body} = Good Morning, Dave.;
} else {
set_logout_cookie($state);
$args{body} = I'm afraid I can't let you do that, Dave.;
}
return output_html($state, %args);
}
Re: If (!$one_thing) {$other;}
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
Re: If (!$one_thing) {$other;}
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;}
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;}
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; $poslength($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
Re: If (!$one_thing) {$other;}
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;}
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. m, 4 day weekend Dennis
Re: If (!$one_thing) {$other;}
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
