I'm having an issue with storing sessions in a MySQL database using CGI::Session.
Here is a snippet
#!/usr/bin/perl
use CGI;
use CGI::Session;
use CGI::Session::Driver::mysql;
use DBI;
use DBD::mysql;
use Net::LDAPS;
require '../include/include.pl';
$LDAP_SERVER = 'my.test.ldap.example.com';
$LDAP_SSL_PORT = '636';
$LDAP_BASE = 'ou=users,dc=example,dc=com';
$ldap = Net::LDAPS->new($LDAP_SERVER, port=> $LDAP_SSL_PORT)
or die "Unable to create LDAP object because: $! \n";
$dbh = DBI->connect("DBI:mysql:host=$db_host;database=$db_name",$db_user,$db_pswd)
or die "Unable to connect to database: \"$DBI::errstr\" $! \n";
$q = CGI->new;
$usr = $q->param('usr') || undef;
$userDN = "uid=$usr,$LDAP_BASE";
if($usr) {
$pwd = $q->param('pwd');
$ldapMsg = $ldap->bind($userDN, password=>$pwd);
$result = $ldap->code;
if ($result == 0) {
$session = CGI::Session->new('driver:mysql', undef,
{ TableName=>'car_sessions',
IdColName=>'id',
DataColName=>'a_session',
Handle=>$dbh})
or die "Unable to create session because: $!";
$session->expire('+1h');
$session->param(-name=>'car_login', -value=>$usr);
$sess_cookie = $q->cookie(-name=>'CGISESSID', -value=>$session->id, -expires=>'+1h', -path=>'/hr_car/');
$login_cookie = $q->cookie(-name=>'car_login', -value=>$usr, -expires=>'+1h', -path=>'/hr_car/');
print $q->header(-cookie=>[$sess_cookie, $login_cookie], -location=>'manage.cgi');
}
LDAP is binding correctly, and the cookies are being set correctly, but NOTHING is showing up in my sessions table!
What could I be doing wrong??
I believe the problem is with auto-flushing being unreliable. There's an explicit problem with DBI handles going out of scope before auto-flush happens, so call $session->flush once you're done setting the session up and after you delete it.
You may mitigate this problem by using file-scoped lexicals instead of globals for $dbh and friends, Perl might be able to clean them up in the right order and it's just a good idea.
PS Turn on strict and warnings and declare all those variables. Your problem could have just as easily been caused by a typo and you'd never have known it.
Related
I am new in perl, and I need to connect the database use DBI. My code as follows:
use LWP::Simple;
use XML::Simple qw(:strict);
use Data::Dumper;
use DBI;
use Getopt::Long;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use IO::File;
use warnings;
$dbh = DBI->connect("dbi:);
if (!$dbh) {
&logMsg(0, "$DBI::errstr");
die;
} else {&logMsg(0,"Connection to $dbName DB OK")}
I already set the values. Its kind like connection failed, but I didn't get any errors. I also check the log file, there is nothing showing. What can I do for checking the errors? Thanks for any comments and help.
I can't find anything wrong with your code, unless logMsg just doesn't work, but it's a tedious way to go about using DBI.
Rather than checking if something went wrong with DBI, it's much better to set DBI to throw an error. You can do this with RaiseError.
my $dbh = DBI->connect(
"dbi:ODBC:DSN=$dbName;Server=$dbHost",
$dbUser, $dbPassword,
{ RaiseError => 1 }
);
Now if DBI has a failure, including trying to connect, it will throw an error and stop the program. This avoids having to check for an error every time you use the database (you'll forget).
DBI;
$dbh = DBI->connect('Your_Database_Name', 'user_id','Password');
my $sth = $dbh->prepare ("select * from Table_name");
$sth->execute();
my #row_ary = $sth->hetshrow_array;
foreach $item (#row_ary)
{
print "$item\n";
}
print syntax not working after my $dbh = DBI->connect($dsn, "username", "password"); has been called. But when I put print syntax on the top of my $dbh = DBI->connect($dsn, "username", "password"); print work properly. This case happen when I run this code through browser using CGI and when I run this code in command-line both work properly.
Here are the code:
#!"C:\Strawberry\perl\bin\perl.exe"
use CGI qw(:standard);
use DBI;
use JSON;
print header("application/json");
my $dsn = "DBI:mysql:database=webservices;host=localhost;port=3306";
print "test"; #work properly
my $dbh = DBI->connect($dsn, "root", "bukanjombloboy");
print "test"; #not working
my $result = $dbh->prepare("SELECT * FROM news");
$result->execute();
my $json_text = to_json($result->fetchall_arrayref());
print $json_text;
$dbh->disconnect();
Sorry for my bad English, thanks anyway.
It could be a issue with the EOL, in the line:
my $dbh = DBI->connect ($dsn, "root", "bukanjombloboy");
Check all your EOL are equal in all lines.
I have found the solution.
The problem is APACHE webserver doesn't have permission to access the library so I have to run XAMPP on administrator mode.
i'm on the same problem since almost two week ago.
i'm a newbie with Perl and Web :/
i followed the CGI::Session tutorial and Cookbook, the code seems to be good but... not working.
index.cgi
#!/usr/bin/perl
use CGI;
use CGI::Cookie;
use HTML::Template;
use strict;
use warnings;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser);
require "cgi-bin/web_base.pl";
require "cgi-bin/login.pl";
my $cgi = new CGI;
my $session = new CGI::Session("driver:File", undef, {Directory=>'/tmp'}) or die CGI::Session->errstr;
my $CGISESSID = $session->id();
print header();
print $cgi->header();
print my_topbar();
login_attempt($session, $cgi);
if ( $session->param("~login-trials") >= 3 ) {
print error("You failed 3 times in a row.\n" .
"Your session is blocked. Please contact us with ".
"the details of your action");
exit(0);
}
unless ( $session->param("~logged-in") ) {
print login_form($cgi, $session);
exit(0);
}
print footer();
login.cgi
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use CGI::Cookie;
use HTML::Template;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser);
use Fcntl;
my $cgi = new CGI;
my $session = new CGI::Session(undef, $cgi, {Directory=>'/tmp'});
sub login_attempt {
my ($session, $cgi) = #_;
if ( $session->param("~logged-in") ) {
return 1; # Verify if user is not logged.
}
my $username = $cgi->param("username") or return;
my $password=$cgi->param("password") or return;
# Form submited. Try to load profile.
if ( my $profile = load_profile($username, $password) ) {
$session->param("~profile", $profile);
$session->param("~logged-in", 1);
print "YOUPIIIII";
$session->clear(["~login-trials"]);
$session->redirect("dashboard.cgi");
return 1;
}
# Failed to login, wrong credentials.
my $trials = $session->param("~login-trials") || 0;
return $session->param("~login-trials", ++$trials);
}
return 1;
sub load_profile {
my ($username, $password) = #_;
local $/ = "\n";
unless (sysopen(PROFILE, "profile.txt", O_RDONLY) ) {
die ("Couldn't open profile.txt: $!");
}
while ( <PROFILE> ) {
/^(\n|#)/ and next;
chomp;
my ($n, $p) = split "\s+";
if ( ($n eq $username) && ($p eq $password) ) {
my $p_mask = "x" . length($p);
return {username=>$n, password=>$p_mask};
}
}
close(PROFILE);
return undef;
}
profile.txt
Formget 123
When i try to login, nothing happen, even when i try wrong crendentials it should block me after 3 attemps but it is not.
Can someone really help me on this ? i can't take it anymooooore.
feel free for any questions :)
EDIT :
-login_attempt() corrected
-load-profile wasn't working, made a new one, but still need improvement.
-Last Problem is session init
Are you sure that you don't get any errors? Have you checked the web server error log?
You call login_attempt() with two parameters ($session and $cgi) but in login.cgi, that subroutine is defined like this:
sub login_attempt() {
...
}
You're (probably accidentally) using a prototype on that subroutine, telling Perl that it takes no parameters. So I'd be surprised if you don't get an error saying:
Too many arguments for main::login_attempt
Remove the parentheses from that definition.
sub login_attempt {
...
}
Update: I think you're missing one very important step here. From the CGI::Session Tutorial:
There is one small, but very important thing your application needs to perform after creating CGI::Session object as above. It needs to drop Session ID as an HTTP cookie into the user's computer. CGI::Session will use this cookie to identify the user at his/her next request and will be able to load his/her previously stored session data.
To make sure CGI::Session will be able to read your cookie at next request you need to consult its name() method for cookie's suggested name:
$cookie = $query->cookie( -name => $session->name,
-value => $session->id );
print $query->header( -cookie=>$cookie );
name() returns CGISESSID by default. If you prefer a different cookie name, you can change it as easily too, but you have to do it before CGI::Session object is created:
CGI::Session->name("SID");
$session = CGI::Session->new();
Baking the cookie wasn't too difficult, was it? But there is an even easier way to send a cookie using CGI::Session:
print $session->header();
The above will create the cookie using CGI::Cookie and will return proper http headers using CGI.pm's CGI method. Any arguments to CGI::Session will be passed to CGI::header().
Without this, you'll be creating a brand new session for each request.
My problem is that: the outputs are different, when I run the program on the linux machine, and on a web browser of another machine.
When I run the program on the linux machine, the output is:
Content-type: text/plain
11
22
username password
But when I put the program on an Apache Server, and access it using a browser on another machine, the output is simply:
11
It is probably because the program fails to connect to the database file. As I have set all the files to mode 777, that I do not have the permission is unlikely a reason.
Anyone know what the problem is and how to fix it?
#!/usr/bin/perl -w
use DBI;
print ("Content-type: text/plain\n\n");
print "11\n";
my $dbh = DBI->connect("dbi:SQLite:dbname=4140.db","","",{RaiseError => 1},) or die $DBI::errstr;
print "22\n";
my $sth = $dbh -> prepare("SELECT * FROM Credential");
$sth -> execute();
($usrname, $password) = $sth -> fetchrow();
$sth -> finish();
$dbh->disconnect();
print "$usrname $password\n";
The die strings are sent to STDERR and so won't appear in the HTTP message that is sent. You can solve this several ways, one of the simplest being to write an error handler for DBI errors that prints the error message to STDOUT.
You should also always use strict and use warnings. That way Perl will highlight many simple errors that you could otherwise easily overlook. use warnings is far superior to -w on the command line.
Take a look at this code as an example. Note that if you enable RaiseError as well as providing an error handler then DBI will raise an exception only if your error handler returns a false value.
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
print ("Content-type: text/plain\n\n");
print "11\n";
my $dbh = DBI->connect('dbi:SQLite:dbname=4140.db','','',
{RaiseError => 1, PrintError => 0, HandleError => \&handle_error});
print "22\n";
my $sth = $dbh->prepare('SELECT * FROM Credential');
$sth->execute;
my ($usrname, $password) = $sth -> fetchrow();
print "$usrname $password\n";
sub handle_error {
my ($msg, $dbh, $rv) = #_;
print "DB Error: $msg\n";
0;
}
Yo should specify the complete path to your database file in order to avoid this kind of problems. Try this (if your database is at the same path as your script):
use FindBin '$Bin';
my $dbfile = "$Bin/4140.db";
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",{RaiseError => 1},) or die $DBI::errstr;
#...
Check your error log. You'll surely find that SQLite is failing to create 4140.db because of a permission error. You've made incorrect assumptions about the current directory.
I have a problem when I use Apache::DBI in child processes. The problem is that Apache::DBI provides a single handle for all processes which use it, so I get
DBD::mysql::db selectall_arrayref
failed: Commands out of sync; you
can't run this command now at
/usr/local/www/apache22/data/test-fork.cgi
line 20.
Reconnection doesn't help, since Apache::DBI reconnects in all processes, as I understood the following error
The server encountered an internal
error and was unable to complete your
request.
Error message: DBD driver has not
implemented the AutoCommit attribute
at
/usr/local/lib/perl5/site_perl/5.8.9/Apache/DBI.pm
line 283. ,
Here's the origin code:
use Data::Dumper 'Dumper';
use DBI ();
my $dbh = DBI->connect($dsn, $username, $password, {
RaiseError => 1,
PrintError => 0,
});
my $file = "/tmp/test-fork.tmp";
my $pid = fork;
defined $pid or die "fork: $!";
if ($pid) {
my $rows = eval { $dbh->selectall_arrayref('SELECT SLEEP(1)') };
print "Content-Type: text/plain\n\n";
print $rows ? "parent: " . Dumper($rows) : $#;
}
else {
my $rows = eval { $dbh->selectall_arrayref('SELECT SLEEP(1)') };
open FH, '>', $file or die "$file: $!";
print FH $rows ? "child: " . Dumper($rows) : $#;
close FH;
}
The code I used for reconnection:
...
else {
$dbh->disconnect;
$dbh = DBI->connect($dsn, $username, $password, $attrs);
my $rows = eval { $dbh->selectall_arrayref('SELECT SLEEP(1)') };
open FH, '>', $file or die "$file: $!";
print FH $rows ? "child: " . Dumper($rows) : $#;
close FH;
}
Is there a safe way to use Apache::DBI with forking? Is there a way to make it create a new connection perhaps?
I see a few options:
Explicitly close your DB handles when you fork, and reopen them as needed.
e.g.:
my $dbh = DBI->connect(...);
my $pid = fork;
defined $pid or die "fork: $!";
if ($pid) {
# parent...
}
else {
# child...
undef $dbh;
This could be made easier by storing the $dbh in an object, and passing around that object as needed to parts of your system. The object would be responsible for reopening the $dbh as needed, so the rest of the application doesn't have to concern itself with the details. Keep code encapsulated and well-separated from other parts of the system.
Don't use Apache::DBI. I can highly recommend DBIx::Connector, which opens a new connection as needed and doesn't preserve the bad behaviour of either plain DBI or Apache::DBI: see http://search.cpan.org/~dwheeler/DBIx-Connector-0.32/lib/DBIx/Connector.pm#Description for a detailed description of how it differs.
I use DBIx::Connector in my system inside a Moose object, which uses a method delegation to provide the dbh. The application simply does:
my $dbh = $db_dbj->dbh;
my $sth = $dbh->prepare(...);
# more boring DBI code here
...And the dbh is reconnected/regenerated as needed, invisibly.
As an aside, you should be really careful of using bare filehandles in a multiprocess environment. You could be very easily clobbering your data. open (my $fh, $file) or die "Cannot open $file: $!" is much safer.
I'm also a little nervous by seeing you using eval {} blocks without checking the contents of $#. You're just masking errors, rather than dealing with them, so there may be more things going on than you are aware of. Check your result values (or better, use an explicit exception-handling module, such as Try::Tiny. use use strict; use warnings;.
PS. I just noticed that you are explicitly including DBI in your code. Don't do that. If you use Apache::DBI in your startup_modperl.pl (or whatever you call your bootstrap file), you should never have to include DBI itself. I can't say for sure but I wouldn't be confident the right package is getting called (it's been a while since I looked at Apache::DBI's guts; it might take care of this for you though).
Don't fork under mod_perl2. Use Apache2::Subprocess. See also Is it a bad idea to fork under mod_perl2?