How to redirect using Perl? - perl

I am new to Perl and I am trying to redirect a user to another page on my server when he enters the right password. The page that I want to redirect to (hello.pl) is in the same directory as my Perl script for the page; however when I try to redirect all I get is a message:
Status: 302 Found Location: hello.pl
But the browser doesn't actually go to the hell0.pl which is what I want. I looked online and in the Perl books but it looks that I'm doing everything right, can someone tell me why my code isn't redirecting? Here's the code for it:
I omitted the code for setting up page and getting user input stored in $var ie I did $var = CGI->new at the top of the file, also I am using CGI.pm as a library.
#!/usr/bin/perl -wT
use strict;
use CGI qw(:standard);
print header,
start_html("Input Form"),
start_form,
"Please enter your username:",
textfield(-name=>'username',
-maxlength=>20),p,
"Please enter your password:",
password_field(-name=>'password',
-maxlength=>20),p,
submit,
end_form,
hr, "\n";
my $var = CGI->new;
my $username = $var->param("username");
my $password = $var->param("password");
my $open = "opensesamie";
if ($password ne $open) {
print "Sorry wrong password";
} else {
print $var->redirect('hello.pl');
print $var->start_html,p,
"Hello, $username",p,
"The current time is ",scalar(localtime),
$var->end_html;
}
print end_html;

Sorry for the delay - I have had to set up a working HTTP server to test my code.
Thank you for posting your full code. It is as I guessed - you have started a message at the top of your program and then added the redirect output to it, whereas you need only the redirect output sent to the client.
I think this is what you need. It checks to see if both the username and password parameters have been sent. If not then the form must be displayed to ask for them. If so then either an error message must be sent if the password is wrong, or a redirect if it is right.
#!/usr/bin/perl
use strict;
use warnings;
use CGI qw(:standard);
my %names = map { $_ => 1 } param;
my $open = 'opensesamie';
if ($names{username} and $names{password}) {
my $username = param('username');
my $password = param('password');
if ($password eq $open) {
print
header,
start_html,
p('Sorry, wrong password'),
end_html;
}
else {
print redirect('hello.pl');
}
}
else {
print
header,
start_html('Input Form'),
start_form,
p('Please enter your username:'),
textfield( -name => 'username', -maxlength => 20),
p('Please enter your password:'),
password_field( -name => 'password', -maxlength => 20),
p,
submit,
end_form,
hr,
end_html;
}

You are outputting two headers. Don't use both header and redirect for the same request.
#!/usr/bin/perl -wT
use strict;
use CGI qw(:standard);
my $cgi = CGI->new;
my $username = $cgi->param("username");
my $password = $cgi->param("password");
if ($password eq "opensesamie") {
print $cgi->redirect('hello.pl');
exit();
}
print header;
print start_html("Please Login");
print p({-class => "error"}, "Incorrect password") if $password;
print ... print the form here ...;

I think you have something like this.
Have you started the HTTP print statements somewhere before the if that tests the password? That would make the headers that print $cgi->redirect just part of the HTML text.
use strict;
use warnings;
use CGI;
my %passwords;
my $cgi = CGI->new;
my $username = $cgi->param('username');
my $password = $cgi->param('password');
print
$cgi->header,
$cgi->start_html;
if ($password ne $open) {
print 'Sorry wrong password';
}
else {
print $var->redirect('hello.pl');
print
$var->start_html, p,
"Hello, $username", p,
"The current time is ", scalar(localtime),
$var->end_html;
}
You need to separate the success/failure completely, like this
use strict;
use warnings;
use CGI;
my %passwords;
my $cgi = CGI->new;
my $username = $cgi->param('username);
my $password = $cgi->param('password);
my $open = $passwords{$username};
if ($password ne $open) {
print
$cgi->header,
$cgi->start_html;
$cgi->p('Sorry wrong password'),
$cgi->end_html;
}
else {
print $var->redirect('hello.pl');
}

Related

Perl Web Login Script With CGI::Session

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.

Passing Variable with redirect in cgi/perl

I have two cgi script. Login.cgi and welcome.cgi
I want to pass variable between these two pages
Here are the two pages i have
#!C:/Perl/bin/perl.exe -w
#login.cgi
use strict;
use warnings;
use CGI::Pretty qw(:all);
my $cgi = new CGI;
my $username = $cgi->param('username');
my $password = $cgi->param('password');
if ( ( $cgi->param('username') eq 'demo' ) && ( $cgi->param('password') eq 'demo' ) ) {
print $cgi->redirect("welcome.cgi");
}
else {
print header();
print start_html( -title => "Login" );
if ( $cgi->param('username') or $cgi->param('password') ) {
print center( font( { -color => 'red' }, "Invalid input" ) );
}
print generate_form();
print end_html();
}
sub generate_form {
return start_form,
h1("Please Login"),
p( "username", textfield('username') ),
p( "password", textfield('password') ), p(submit),
end_form;
}
Another page welcome.cgi
#!C:/Perl/bin/perl.exe -w
#welcome.cgi
use warnings;
use CGI::Pretty qw(:all);
use strict;
my $cgi=new CGI;
my $username;
print header();
print start_html("Welcome"),h1("Hello, $username");
print end_html();
How do I get the username variable passed to welcome.cgi?
use CGI::Session.
For a tutorial on all the different ways to pass information between scripts and why this implementation is a good choice, read CGI::Session::Tutorial
Implemented in your login script:
#login.cgi
use strict;
use warnings;
use CGI::Pretty qw(:all);
use CGI::Session;
my $cgi = new CGI;
my $session = CGI::Session->new($cgi) or die CGI->Session->errstr;
my $username = $cgi->param('username') // '';
my $password = $cgi->param('password') // '';
if ( $username eq 'demo' && $password eq 'demo' ) {
$session->param(username => $username);
print $cgi->redirect("welcome.cgi");
exit;
}
print $session->header();
print start_html( -title => "Login" );
if ( $username or $cgi->param('password') ) {
print center( font( { -color => 'red' }, "Invalid input" ) );
}
print start_form,
h1("Please Login"),
p( "username", textfield('username') ),
p( "password", textfield('password') ), p(submit),
end_form,
end_html();
And in your welcome script:
#welcome.cgi
use strict;
use warnings;
use CGI::Pretty qw(:all);
use CGI::Session;
my $cgi = new CGI;
my $session = CGI::Session->new($cgi) or die CGI->Session->errstr;
my $username = $session->param('username');
print header();
print start_html("Welcome"),h1("Hello, $username");
print end_html();
You can either pass it directly (by encoding it in a query string and adding that to the URL you are redirecting to) or you can store it in a cookie or a session and then retrieve it in the other script.
I would have to slightly disagree with Mr.Miller here. CGI::Session is at present outdated in many regards especially due to:
The method to set cookies is outdated, and does not adhere to the RFC6265
The Cookie ID algorithm is not secure enough, the author has moved on to other projects.
And thus should not be used unless for educational purposes.
With regards to the original question, you can look at this simple tutorial
http://practicalperl5.blogspot.in/2014/07/perl-login-script.html

Perl Script to Log into TopCoder

My following codes work for other https sites but not for TopCoder. The output file reads: Can't connect to community.topcoder.com:443 LWP::Protocol::https::Socket: SSL connect attempt failed with unknown error error:00000000:lib(0):func(0):reason(0) at C:/Perl64/lib/LWP/Protocol/http.pm line 51, line 2. Could you please help me know where it is wrong? Thank you very much.
#!perl
use LWP::Simple;
use LWP::UserAgent;
use HTML::Form;
use HTTP::Cookies;
use Term::ReadKey;
use HTML::Parse;
print "Please enter your TopCoder username:";
chop(my $user=<stdin>);
print "Please enter your TopCoder password: (do not display)\n";
ReadMode 2;
chop(my $password=<stdin>);
ReadMode 0;
#log-in and set cookies
my $host="http://community.topcoder.com/tc?&module=MyHome";
my $method="GET";
my $cookie_jar=HTTP::Cookies->new;
require HTTP::Request;
my $ua=LWP::UserAgent->new;
$ua->cookie_jar({});
$ua->agent('Mozilla/5.0');
my $r=HTTP::Request->new;
my $response=HTTP::Response->new;
$r->method($method);
$r->uri($host);
$cookie_jar->add_cookie_header($r);
$response=$ua->request($r);
$cookie_jar->extract_cookies($response);
my $html;
my $baseuri;
if($response->is_success)
{
$html=$response->content;
$baseuri=$response->base;
}
else
{
$html = $response->error_as_HTML();
print "Server Connection Failed.\n";
exit 0;
}
my #forms=HTML::Form->parse($html,$baseuri);
my $form=$forms[1];
$form->value("username",$user);
$form->value("password",$password);
push #{ $ua->requests_redirectable }, 'POST';
$response=$ua->request($form->click);
if ($response->content =~/Username or password incorrect/i)
{
print "Wrong username or password!\n";
exit 1;
}
else
{
open(FO2, ">login_test.htm");
print FO2 $response->content;
$cookie_jar->extract_cookies($response);
print "Login OK\n";
}
$ua->cookie_jar($cookie_jar);
IO::Socket::SSL uses SSLv2 by default, and that server does not renegotiate in order to upgrade to v3. So connect with v3 right away, and it works.
LWP::UserAgent->new(ssl_opts => {SSL_version => 'SSLv3'})

I am new to perl-cgi . i am trying to connect db with cgi script i getting this error

Using Perl CGI, I am trying to create a login page with db connection. I am using the IDE eclipse. While running it I am getting the error:
Server Error
while trying to obtain /sssss/login.cgi
Missing header from cgi output
Here is my code:
#!/usr/bin/perl
use strict;
use CGI qw(:standard);
use CGI::Pretty qw(:all);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use DBI;
use DBD::mysql;
use DBI qw(:sql_types);
use DBD::ODBC;
use CGI qw/:standard/;
use CGI;
my $cgi = CGI->new();
my $user='root';
my $pass='123';
my $dsn = 'DBI:mysql:delve:server';
my $dbh = &sql_connect;
$dbh-> {'LongTruncOk'} = 1;
$dbh-> {'LongReadLen'} = 90000;
print "Content-type: text/html\n\n";
print "<html><h1>OTT Login</h1></html>\n";
print '<body bgcolor="gray">';
#start a form----------------
print '<form method=POST>';
print '<p>';
print 'Employee Name: <p><INPUT type="text" name="User" size=25 maxlength=25></p>';
print '</p>';
# Create a text box for Password:---------------
print '<p>';
print 'Password:<p><INPUT TYPE=PASSWORD NAME="mypassword" id = "Password" size = "15" maxlength = "15" tabindex = "1"/></p>';
print '</p>';
#Create submit & reset button:-------------------
#print '<p><input type=" button" name="submitit"value="submit"onclick="formvalidation(myform)"/></p>';
print '<form name="input" method="post">';
print '<p><input type="submit" value="Submit" /><INPUT TYPE="reset" name = "Reset" value = "Reset"></p>';
#Create Change Password & Reset Password link:------------
print '<p>Change Password</p>';
print '<p>Reset Password</p>';
print '</form>';
#logic for submit button functionality :-----------------
if (param('User') and param('mypassword'))
{
my $usr=ucfirst(lc(param('User')));
my $pwd=ucfirst(lc(param('mypassword')));
my $query="select username from login where username='$usr'";
my $data=$dbh->prepare($query) or die $dbh->errstr;
$data->execute() or die $data->errstr;
my ($x,$y);
my $query1="select password from login where password='$pwd'";
my $data1=$dbh->prepare($query1) or die $dbh->errstr;
$data1->execute() or die $data->errstr;
if ($x=$data->fetchrow())
{
if ($y=$data1->fetchrow())
{
print "Correct Password";
print $cgi->redirect("samp.html");
}
else
{
print "Incorrect Password";
}
}
else
{
print "Invalid username";
}
$dbh->disconnect || die "$DBI::errstr\n";
}
sub sql_connect
{
Reconnect:
my $dbh = DBI->connect($dsn, $user, $pass,{AutoCommit => 1}) or warn "$DBI::errstr\a\a\n";
if(defined $dbh)
{
print "Data base Connected successfully\n";
}
else
{
print "Please Check Ur Database\n"; ### To handle Database Failure
sleep(10);
goto Reconnect;
}
return $dbh;
}
1;
Your subroutine sql_connect generates output (print "...") before the correct HTTP Header is sent.
Either print your debug messages to a logfile or first print the HTTP header before generating other content.
When you are sending an HTTP response (e.g. printing things to the browser), your application has to send the response header, and not just the body. As you're sending HTML, the very first thing you print to STDOUT should be a header that contains at least this:
Content-type: text/html
The header is followed by a blank line.
So the first print in your script should be:
print 'Content-type: text/html',"\n\n";
(If you have more headers to generate, then print only one \n after each until the last one.)
Of course, if you use CGI or CGI::Simple modules instead, you'll make your life a lot easier. CGI has lots of edge cases and weird behavior that's already been dealt with in these modules.

Why is this password check not working as expected?

I am trying to expand from php. Here is a basic problem I have and can not figure it out...
password.pl
#!/usr/bin/perl
use CGI;
$q = new CGI;
print "Content-type:text/html\r\n\r\n";
print '<html>';
print '<head>';
print '<title>Card</title>';
print '</head>';
print '<body>';
print '<FORM METHOD=POST ACTION=/card.pl>';
print '<INPUT TYPE=password NAME=password SIZE=25>';
print '<input type=submit value=Submit>';
print '</FORM>';
print '</body>';
print '</html>';
1;
card.pl
#!/usr/bin/perl
use CGI;
$q = new CGI;
$password = $q->param("password");
print $password;
if ($password == pass)
{
print 'Yup';
}
else
{
print 'Wrong Password';
}
1;
Nothing is passing to card.pl from the password.pl form? I have used a simular example before with no problem?
More coffee...
use strict;, use warnings; and look in your error logs. Also validate your HTML.
Then you'll be alerted to problems like:
Bareword "pass" not allowed while "strict subs" in use at card.pl line 7.
You probably want:
($password eq 'pass')
In my continuing quest to disabuse the abuse of CGI.pm, your first script would be much better as–
use strict;
use warnings;
use CGI qw( :standard );
print
header(),
start_html("O HAI CARD"),
start_form(-action => "card.pl"),
fieldset(
legend("None Shall Pass!"),
password_field(-name => "password",
-size => 25),
submit(-value => "Submit"),
),
end_form(),
end_html();
Your second as, perhaps, just for example, et cetera–
use strict;
use warnings;
use CGI;
my $q = CGI->new;
print
$q->header,
$q->start_html("O HAI CARD");
my $password = $q->param("password");
if ( $password eq "pass" )
{
print $q->h2("You're all good");
}
else
{
print $q->h2({-style => "color:#a00"},
"You're all good");
}
print $q->end_html();
Or, maybe better, all together–
use strict;
use warnings;
no warnings "uninitialized";
use CGI qw( :standard );
print
header(),
start_html("O HAI CARD");
print param("password") eq "pass" ?
h2("Yes!") : h2({-style => "color:#a00"}, ":(");
print
start_form(),
fieldset(
legend("None Shall Pass!"),
password_field(-name => "password",
-size => 25),
submit(-value => "Submit"),
),
end_form(),
end_html();
RIF, read the docs: CGI.