2007-10-11 16:25:56 +00:00
|
|
|
#!/usr/bin/perl
|
2007-10-11 17:06:08 +00:00
|
|
|
require "include.pl";
|
2007-10-12 00:44:24 +00:00
|
|
|
require "functions.pl";
|
2007-10-10 21:48:12 +00:00
|
|
|
|
|
|
|
#initialize session data
|
|
|
|
CGI::Session->name($session_name);
|
|
|
|
$query = new CGI;
|
|
|
|
$session = new CGI::Session;
|
|
|
|
|
2007-10-27 09:17:30 +00:00
|
|
|
$username = get_username_from_sid($session->id);
|
|
|
|
|
|
|
|
%page = ();
|
|
|
|
|
|
|
|
$page->{'username'} = $username;
|
|
|
|
$page->{'locale'} = $locale;
|
|
|
|
$page->{'stylesheet'} = $stylesheet;
|
|
|
|
$page->{'xmlns:dc'} = $xmlns_dc;
|
|
|
|
$page->{'xmlns:cc'} = $xmlns_cc;
|
|
|
|
$page->{'xmlns:rdf'} = $xmlns_rdf;
|
|
|
|
|
2007-10-10 21:48:12 +00:00
|
|
|
#check if action is set
|
2007-10-11 17:26:39 +00:00
|
|
|
if($query->param('action'))
|
|
|
|
{
|
2007-10-10 21:48:12 +00:00
|
|
|
#connect to db
|
|
|
|
$dbh = DBI->connect("DBI:mysql:$database:$dbhost", $dbuser, $dbpass);
|
|
|
|
|
2007-10-27 09:17:30 +00:00
|
|
|
if($query->param('action') eq "logout")
|
|
|
|
{
|
|
|
|
#if logout is requested
|
|
|
|
#remove sid from database
|
|
|
|
$dbh->do(qq{update users set sid = '' where username = ?}, undef, get_username_from_sid($session->id)) or die $dbh->errstr;
|
|
|
|
$session->delete();
|
|
|
|
print $query->redirect("index.pl?information=information_logged_out");
|
|
|
|
}
|
|
|
|
#check if user is logged in
|
|
|
|
elsif($username)
|
|
|
|
{
|
|
|
|
$page->{'message'}->{'type'} = "error";
|
|
|
|
$page->{'message'}->{'text'} = "error_already_logged_in";
|
|
|
|
|
|
|
|
#print xml http header along with session cookie
|
|
|
|
print $session->header(-type=>'text/xml', -charset=>'UTF-8');
|
|
|
|
|
|
|
|
print XMLout($page, KeyAttr => {}, XMLDecl => $XMLDecl, RootName => 'page', AttrIndent => '1');
|
|
|
|
}
|
2007-10-10 21:48:12 +00:00
|
|
|
#if login is requested
|
2007-10-27 09:17:30 +00:00
|
|
|
elsif($query->param('action') eq "login")
|
2007-10-11 17:26:39 +00:00
|
|
|
{
|
2007-10-20 16:32:04 +00:00
|
|
|
#prepare query - empty password are openid users so omit those entries
|
|
|
|
my $sth = $dbh->prepare(qq{select id from users
|
|
|
|
where password = password( ? ) and username = ? and not password = '' limit 1 });
|
2007-10-10 21:48:12 +00:00
|
|
|
|
|
|
|
#execute query
|
2007-10-12 00:34:32 +00:00
|
|
|
$sth->execute($query->param('pass'), $query->param('user'));
|
2007-10-10 21:48:12 +00:00
|
|
|
|
|
|
|
#if something was returned username and password match
|
2007-10-11 17:26:39 +00:00
|
|
|
if($sth->fetchrow_array())
|
|
|
|
{
|
2007-10-10 21:48:12 +00:00
|
|
|
#store session id in database
|
2007-10-24 11:25:18 +00:00
|
|
|
$dbh->do(qq{update users set sid = ? where username = ? }, undef, $session->id, $query->param('user')) or die $dbh->errstr;
|
2007-10-24 10:03:04 +00:00
|
|
|
print $query->redirect("index.pl?information=information_logged_in");
|
2007-10-11 17:26:39 +00:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2007-10-10 21:48:12 +00:00
|
|
|
#if not, print error
|
2007-10-27 09:17:30 +00:00
|
|
|
$page->{'message'}->{'type'} = "error";
|
|
|
|
$page->{'message'}->{'text'} = "error_username_password_do_not_match";
|
|
|
|
|
|
|
|
#print xml http header along with session cookie
|
|
|
|
print $session->header(-type=>'text/xml', -charset=>'UTF-8');
|
|
|
|
|
|
|
|
print XMLout($page, KeyAttr => {}, XMLDecl => $XMLDecl, RootName => 'page', AttrIndent => '1');
|
2007-10-10 21:48:12 +00:00
|
|
|
}
|
|
|
|
|
2007-10-11 17:26:39 +00:00
|
|
|
}
|
2007-10-20 16:32:04 +00:00
|
|
|
elsif($query->param('action') eq "openid")
|
|
|
|
{
|
|
|
|
#create our openid consumer object
|
|
|
|
$con = Net::OpenID::Consumer->new(
|
2007-10-27 09:17:30 +00:00
|
|
|
ua => LWPx::ParanoidAgent->new, # FIXME - use LWPx::ParanoidAgent
|
2007-10-20 16:32:04 +00:00
|
|
|
cache => undef, # or File::Cache->new,
|
|
|
|
args => $query,
|
|
|
|
consumer_secret => $session->id, #is this save? don't know...
|
2007-10-24 12:56:56 +00:00
|
|
|
required_root => $domain );
|
2007-10-20 16:32:04 +00:00
|
|
|
|
|
|
|
#is an openid passed?
|
|
|
|
if($query->param('user'))
|
|
|
|
{
|
|
|
|
#claim identity
|
|
|
|
$claimed = $con->claimed_identity($query->param('user'));
|
|
|
|
if(!defined($claimed))
|
|
|
|
{
|
|
|
|
print $session->header();
|
|
|
|
print "claim failed: ", $con->err;
|
|
|
|
}
|
|
|
|
$check_url = $claimed->check_url(
|
2007-10-27 09:17:30 +00:00
|
|
|
return_to => "$domain/login.pl?action=openid&ret=true", #on success return to this address
|
2007-10-24 12:56:56 +00:00
|
|
|
trust_root => $domain); #this is the string the user will be asked to trust
|
2007-10-20 16:32:04 +00:00
|
|
|
|
|
|
|
#redirect to openid server to check claim
|
|
|
|
print $query->redirect($check_url);
|
|
|
|
}
|
|
|
|
#we return from an identity check
|
|
|
|
elsif($query->param('ret'))
|
|
|
|
{
|
|
|
|
if($setup_url = $con->user_setup_url)
|
|
|
|
{
|
|
|
|
#redirect to setup url - user will give confirmation there
|
|
|
|
print $query->redirect($setup_url);
|
|
|
|
}
|
|
|
|
elsif ($con->user_cancel)
|
|
|
|
{
|
|
|
|
#cancelled - redirect to login form
|
|
|
|
print $session->header();
|
|
|
|
print "cancelled";
|
|
|
|
}
|
|
|
|
elsif ($vident = $con->verified_identity)
|
|
|
|
{
|
|
|
|
#we are verified!!
|
|
|
|
my $verified_url = $vident->url;
|
|
|
|
|
|
|
|
#check if this openid user already is in database
|
2007-10-20 22:38:24 +00:00
|
|
|
my $sth = $dbh->prepare(qq{select 1 from users where username = ? limit 1 });
|
2007-10-20 16:32:04 +00:00
|
|
|
$sth->execute($verified_url);
|
|
|
|
if($sth->fetchrow_array())
|
|
|
|
{
|
|
|
|
#store session id in database
|
2007-10-24 11:25:18 +00:00
|
|
|
$dbh->do(qq{update users set sid = ? where username = ? }, undef, $session->id, $verified_url) or die $dbh->errstr;
|
2007-10-20 16:32:04 +00:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
#add openid user to dabase
|
2007-10-24 11:25:18 +00:00
|
|
|
$dbh->do(qq{insert into users (username, sid) values ( ?, ? ) }, undef, $verified_url, $session->id) or die $dbh->errstr;
|
2007-10-20 16:32:04 +00:00
|
|
|
}
|
2007-10-24 10:03:04 +00:00
|
|
|
|
|
|
|
print $query->redirect("index.pl?information=information_logged_in");
|
2007-10-20 16:32:04 +00:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
#an error occured
|
|
|
|
print $session->header();
|
|
|
|
print "error validating identity: ", $con->err;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
#someone is messing with the args
|
2007-10-27 09:17:30 +00:00
|
|
|
$page->{'message'}->{'type'} = "error";
|
|
|
|
$page->{'message'}->{'text'} = "error_202c";
|
|
|
|
|
|
|
|
#print xml http header along with session cookie
|
|
|
|
print $session->header(-type=>'text/xml', -charset=>'UTF-8');
|
|
|
|
|
|
|
|
print XMLout($page, KeyAttr => {}, XMLDecl => $XMLDecl, RootName => 'page', AttrIndent => '1');
|
2007-10-20 16:32:04 +00:00
|
|
|
}
|
|
|
|
}
|
2007-10-11 17:26:39 +00:00
|
|
|
else
|
|
|
|
{
|
2007-10-10 21:48:12 +00:00
|
|
|
#something ugly was passed
|
2007-10-27 09:17:30 +00:00
|
|
|
$page->{'message'}->{'type'} = "error";
|
|
|
|
$page->{'message'}->{'text'} = "error_202c";
|
|
|
|
|
|
|
|
#print xml http header along with session cookie
|
|
|
|
print $session->header(-type=>'text/xml', -charset=>'UTF-8');
|
|
|
|
|
|
|
|
print XMLout($page, KeyAttr => {}, XMLDecl => $XMLDecl, RootName => 'page', AttrIndent => '1');
|
2007-10-10 21:48:12 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
#disconnect db
|
|
|
|
$dbh->disconnect();
|
2007-10-11 17:26:39 +00:00
|
|
|
}
|
2007-10-27 09:17:30 +00:00
|
|
|
#check if user is logged in
|
|
|
|
elsif($username)
|
|
|
|
{
|
|
|
|
$page->{'message'}->{'type'} = "error";
|
|
|
|
$page->{'message'}->{'text'} = "error_already_logged_in";
|
|
|
|
|
|
|
|
#print xml http header along with session cookie
|
|
|
|
print $session->header(-type=>'text/xml', -charset=>'UTF-8');
|
|
|
|
|
|
|
|
print XMLout($page, KeyAttr => {}, XMLDecl => $XMLDecl, RootName => 'page', AttrIndent => '1');
|
|
|
|
}
|
2007-10-11 17:26:39 +00:00
|
|
|
else
|
|
|
|
{
|
2007-10-12 00:44:24 +00:00
|
|
|
#if not, print login form
|
2007-10-12 11:04:34 +00:00
|
|
|
$page->{loginform} = [''];
|
2007-10-27 09:17:30 +00:00
|
|
|
|
2007-10-12 00:44:24 +00:00
|
|
|
#print xml http header along with session cookie
|
2007-10-26 17:42:03 +00:00
|
|
|
print $session->header(-type=>'text/xml', -charset=>'UTF-8');
|
2007-10-12 00:44:24 +00:00
|
|
|
|
2007-10-27 09:17:30 +00:00
|
|
|
print XMLout($page, KeyAttr => {}, XMLDecl => $XMLDecl, RootName => 'page', AttrIndent => '1');
|
2007-10-10 21:48:12 +00:00
|
|
|
}
|