Alright, I'm struggling a bit here and need a sanity check as well as an answer...
I'm using Apache2/mod_perl2/Mason I've been happy with mason, building my business logic and db layer stuff in perl modules, testing them with perl test scripts and then plugging them into the display page, it's all coming together quickly and elegantly... atleast compared the the JSP stuff I'm replacing. Now, I'm trying to do authentication and authorization and I'm starting to stumble.
Based on rolls, I want to adjust what a user see on a page, though there will be some redirecting or limiting access. The user authentication and roll information come out of sepparate mysql tables (though not particularly relevant, this will be switch to the corporate LDAP at some point). I'm not currently interested in sessions for tracking or page customization, but again I have to temper this with the fact I am in a corporate setting and I don't have the final say.
I've been basing much of my design philosophy on masonbook.com's aprentice.perl.org example, but they seem to have left out a lot of the logic, or it is baked into the strange OO db they use, so I've been wandering off on my own. There's an autohandler that loads with every page that looks for a user cookie. If it finds the cookie, it digests the user info to see if it matches the digest stored in the cookie at login. If it does, it creates a user object with methods to look up roll information when needed. Otherwise, it assumes you are "Guest" and gives you guest privledges. The user object is in a perl module that has subs to validate the username and password againdst the DB and I will put subs to assess roles and such.
Where this is breaking down, is I can't seem to set or perhaps read the cookies I'm setting and the cookie mechanism seems very "black box"-ish, or at least I can't find any good debuging ideas on Apache2::cookie on cpan or google.
I'd also like to know if I'm approaching this in a sane manner to build things. I've tried googling and rifling the monastary and haven't come up with a good standard or even acceptable practices for this sort of thing. I find things that give specifics on this sort of thing, but not anything that helps me sort out what I want and whats a good way to do it.
Code:
Auth::User
#! /usr/local/perl
package User;
use strict;
sub validate
{
my $self = ();
shift;
$self->{dbh} = shift;
$self->{username} = shift;
$self->{passwd} = shift;
$self->{qstr} = "select count(user_name) from users where user_name = \'$self->{username}\' and user_pass = \'$self->{passwd}\'";
$self->{error_msg} = "Invalid Login";
$self->{res} = undef;
bless($self);
my $q_stmt = $self->{dbh}->prepare($self->{qstr});
$q_stmt->execute();
my @data = $q_stmt->fetchrow_array();
if (@data[0] == 1)
{
$self->{res} = 1;
}
return($self);
}
sub guest
{
my $self = ();
shift;
$self->{dbh} = shift;
$self->{username} = "Guest";
$self->{logged_in} = undef;
$self->{passwd} = "";
bless($self);
return($self);
}
sub is_logged_in
{
my $self = shift;
return $self->{logged_in};
}
1;
autohandler
<%once>
$AuthDBH = DBI->connect('dbi:mysql:authority:10.33.8.159', 'appadmin', 'f00tbal
l') or die "poop sandwich";
$RepDBH = DBI->connect('dbi:mysql:reports:10.33.8.159', 'appadmin', 'f00tball')
or die "poop sandwich";
use Auth::User;
use Digest::SHA1;
<%init>
my %cookies = Apache2::Cookie->fetch($r);
my $guest = User->guest;
my $user;
if (exists $cookies{user_login})
{
my %user_info = $cookies{user_login}->value;
if ( $user_info{used_id} && $user_info{MAC})
{
my $MAC = Digest::SHA1::sha1_hex($user_info{user_id}, "Get the S1gnal!");
if ( $user_info{MAC} eq $MAC )
{
$user = User->new($user_info{used_id});
}
}
}
local $User = $user || $guest;
$m->call_next
<%flags>
inherit=>undef
Login
<%init>
my $item;
my $date;
my @line;
#Yes, I am sending a plain text password here... I'll digest it in SHA1 in the next step
my $res = User->validate($AuthDBH, $ARGS{username}, $ARGS{password});
my $url;
if (length($ARGS{ret_url}) <= 1)
{
$url = "/index.html";
}
if ($res->{res})
{
my $MAC = Digest::SHA1::sha1_hex($ARGS{username}, "Get the S1gnal!");
Apache2::Cookie->new
( $r,
-name => 'user_login',
-value => { user_id => $ARGS{username}, MAC => $MAC },
-path => '/',
-domain => 'ruth.dobson.net',
-expires => '+1M',
)->bake($r);
}
else
{
if (index($ARGS{ret_url}, '?') >= 0)
{
$url .= "&login_error=$res->{error_msg}";
}
else
{
$url .= "?login_error=$res->{error_msg}";
}
}
$url= "/test.html";
$m->redirect($url);
<%flags>
inherit=> '/syshandler'
--Jimbus aka Jim Babcock
Wireless Data Engineer and Geek Wannabe
jim-dot-babcock-at-usa-dot-com
Apache2::Cookie->new
( $r,
-name => 'user_login',
-value => { user_id => $ARGS{username}, MAC => $MAC },
-path => '/',
-domain => 'ruth.dobson.net',
-expires => '+1M',
)->bake($r);
$url= "/test.html";
$m->redirect($url);
Calling cookie->bake puts your cookie headers the response headers, but then you request a redirect, which is not a 200 response, and so the standard page headers do not get sent.
Instead of using bake, you need to set your err_headers_out, which will get sent regardless of the response code.
See here for a recipe : [href:http://perl.apache.org/docs/2.0/user/coding/cooking.html#Sending_Cookies_in_REDIRECT_Response__handlers_|Sending Cookies in REDIRECT Response handlers]
Based on the recipe, I updated the following to the login page
if ($res->{res})
{
my $MAC = Digest::SHA1::sha1_hex($ARGS{username}, "Get the S1gnal!");
my $cookie = Apache2::Cookie->new
( $r,
-name => 'user_login',
-value => { user_id => $ARGS{username}, MAC => $MAC },
-path => '/',
-domain => 'ruth.dobson.net',
-expires => '+1M',
);
$r->err_headers_out->add('Set-Cookie' => $cookie);
}
It didn't change any thing. is there any way to, if I stop before the redirect, to check and see what whas set or check someplace to see what is happening when I submit the cookie? I'm not sure how to go about debugging this.
--Jimbus aka Jim Babcock
Wireless Data Engineer and Geek Wannabe
jim-dot-babcock-at-usa-dot-com
$r->err_headers_out->add('Set-Cookie' => $cookie->as_string);
Also, you can't use a hash ref for "value" in your call to new(). That's supposed to be a string.To debug cookie problems, use a browser that shows the headers (lwp-request, Firefox with LiveHTTPHeaders, a logging proxy).
I think it's because you set an anonymous hash as the value for the cookie. Apache2::Cookie expects a string for the '-value'. So either you send two cookies, one holds the username and another one holds the MAC, or you serialize it with Storable::freeze when sending it and deserialize it when getting it with Storable::thaw.
However, I would just join them with comma when sending, and split them when receiving.
On debugging: use the good old 'warn' and 'Data::Dumper::Dumper' combination, printing everything to the apache error log. If you don't have access to the log, just print them to the browser.
badaiaqrandista
OK, I've not made any progress on this an I'm getting a bit frustrated. Some notes on the other comments and what I've done:
81: sub bake {
82: my ($c, $r) = @_;
83: $r->err_headers_out->add("Set-Cookie", $c->as_string);
84: }
The latest version of the code is
<%init>
use Apache2::Const -compile => qw(REDIRECT);
my $item;
my $date;
my @line;
my $res = User->validate($AuthDBH, $ARGS{username}, $ARGS{password});
my $url = "/";
if (length($ARGS{ret_url}) > 1)
{
$url = $ARGS{ret_url};
}
if ($res->{res})
{
my $MAC = Digest::SHA1::sha1_hex($ARGS{username}, "Get the S1gnal!");
my $cookie = Apache2::Cookie->new
( $r,
-name => 'user_login',
-value => { $ARGS{username} . "," . $MAC },
# -path => '/',
# -domain => '.dobson.net',
-expires => '+1M',
);
$r->err_headers_out ->add('Set-Cookie' => $cookie->as_string);
$r->headers_out->set(Location => $url);
# return Apache2::Const::REDIRECT;
}
else
{
if (index($ARGS{ret_url}, '?') >= 0)
{
$url .= "&login_error=$res->{error_msg}";
}
else
{
$url .= "?login_error=$res->{error_msg}";
}
}
#$url= "/index.html";
$m->redirect($url);
<%flags>
inherit=> '/syshandler'
<% $url %>
login_submit.html: 65 lines, 1088 characters.
I keep rereading the responses sent and trying a million different variations from references I've googled up... this cannot be this difficult.
Thanks
--Jimbus aka Jim Babcock
Wireless Data Engineer and Geek Wannabe
jim-dot-babcock-at-usa-dot-com