这是我的身份验证逻辑:
sub user_logon {
my ($dbh, $cgi, $cache, $logout) = @_;
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
my $session = new CGI::Session("driver:MySQL", $cgi, {Handle=>$dbh});
$session->expires("+3h");
my $auth = new CGI::Session::Auth::DBI({
CGI => $cgi,
Session => $session,
IPAuth => 1,
DBHandle => $dbh,
#Log => 1,
});
if($logout) {
$auth->logout();
}
else {
$auth->authenticate();
if($auth->loggedIn) {
my $user = Cherry::Schema::ResultSet::Employee::get_employee($dbh, $cache, { number => $auth->{userid} });
if (!$user->{active}) {
return { error => $user->{name} . ' is not an active employee.' };
}
$user->{cookie} = $auth->sessionCookie();
return $user;
}
elsif($cgi->param('action') eq 'logon') {
if($cgi->param('log_username') && $cgi->param('log_username')) {
return { error => 'Your username and/or password did not match.' };
}
elsif(!$cgi->param('log_username') || !$cgi->param('log_username')) {
return { error => 'Please enter a username and a password.' };
}
}
else {
return { error => 'You are not logged in' };
}
}
}
sub handle_authentication {
my ($dbh, $cache, $config, $params, $cgi) = @_;
if(($cgi->param('auth') || '') eq 'super_user') { # for automation
return;
}
if(($params->{action} || '') eq 'log_off') {
user_logon($dbh, $cgi, $cache, 1); # 1 means log out
login_form($config, 'Successfully logged out', $params->{login_url}, $params->{title});
}
my $user = user_logon($dbh, $cgi, $cache);
if(exists $user->{error}) {
login_form($config, $user->{error}, $params->{login_url}, $params->{title});
}
elsif($user->{number}) {
return $user;
}
}
然后在我的代码中,每次打印标题时,它看起来像这样:
my $user = Cherry::Authentication::handle_authentication(
$dbh,
$cache,
\%config,
{
action => $FORM{action},
username => $FORM{log_username},
password => $FORM{log_password},
auth => $FORM{auth}
},
$cgi
);
print header(
-type => 'application/json',
-cookie => $user->{cookie}
);
问题是这个代码似乎在80%的时间内运行良好。其他20%的用户被淘汰出局(而不是在被淘汰3小时后)。
此代码中是否存在明显缺陷?我是否遗漏了任何关键代码?
如果您觉得这里没有足够的信息来提供可行的解决方案,您对解决这些类型的问题可采取哪些措施有任何一般性建议吗?
答案 0 :(得分:0)
有了这个特殊的问题,我发现了一些我不知道的代码。
$cookie = CGI::Cookie->new(
-name => $session->name, # problem line
-value => $session->id, # problem line
-expires => '+1y',
-path => '/',
-secure => 0,
);
my @header = (
-cookie => $cookie,
-type => 'text/html',
-status => $status
);
print $cgi->header( @header );
评论 #problem line 的行正在分配一个新会话,即使已存在一个会话。
我在用户计算机上安装了Fiddler HTTP Debugger,似乎问题最多。然后,一旦用户意外退出,我查看了日志。我能够找到访问一个URL的用户与下一个请求的意外注销之间的相关性。