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'})
Related
Note: This is a test perl code to check if works.
I have problem with my perl script, I know there's a solution for that by adding
print "Your server is not ok, please check!\n";
die "- Server is not ok!\n";
But in my project after stop in die "- Server is not ok!\n"; continue the script, I use print to show if works.
Heres the code
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new( timeout => 1 );
$ua->agent("007");
my $req = HTTP::Request->new( GET => 'http://www.google.com.ph/' );
my $res;
for ( 1 .. 10 ) {
$res = $ua->request($req);
if ( $res->is_success ) {
print "+ Server is ok!\n";
}
else {
die "- Server is not ok!\n"; # I want to stop if server is not ok and print last code. Or other solution to stop instead of using die.
}
sleep 1;
}
print "Your server is not ok, please check!\n"; # Why this print not showing if stop in "- Server is not ok!\n"?
See image...
Other solution to stop? Intead using die to continue the perl script.
I hope someone will fixed this little problem, thanks for all reply!
for ( 1 .. 10 ) {
$res = $ua->request($req);
if ( $res->is_success ) {
print "+ Server is ok!\n";
}
else {
print "- Server is not ok!\n";
last; #this statement causes to exit the loop
}
sleep 1;
}
# at this point everything is oke
print "Your server is ok!\n";
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');
}
I'm trying to detect if a link is broken or not, as in if it's a web address I could paste into my browser and find a web page. I've tried two methods so far that I found online and both are giving me false positives (LWP::UserAgent and LWP::Simple).
#!/usr/bin/perl -w
use strict;
use LWP::UserAgent;
my $url1 = 'http://www.gutenberg.org';
my $url2 = 'http://www.gooasdfzzzle.com.no/thisisnotarealsite';
my $ua = LWP::UserAgent->new;
$ua->agent("Mozilla/8.0"); # Pretend to be Mozilla
my $req = HTTP::Request->new(GET => "$url1");
my $res = $ua->request($req);
if ($res->is_success) {
print "Success!\n";
} else {
print "Error: " . $res->status_line . "\n";
}
$req = HTTP::Request->new(GET => "$url2");
$res = $ua->request($req);
if ($res->is_success) {
print "Success!\n";
} else {
print "Error: " . $res->status_line . "\n";
}
Which is giving me output of:
Success!
Success!
and then there's
#!/usr/bin/perl -w
use strict;
use LWP::Simple;
my $url1 = 'http://www.gutenberg.org';
my $url2 = 'http://www.gooasdfzzzle.com.no/thisisnotarealsite';
if (head("$url1")) {
print "Yes\n";
} else {
print "No\n";
}
if (head("$url2")) {
print "Yes\n";
} else {
print "No\n";
}
Which is giving me an output of:
Yes
Yes
Am I missing something here?
Your code worked fine for me, I can only see a problem if your running behind a VPN or gateway as previous stated. Always use strict and warnings, and here is an alternative way so you are not initializing a new Request object everytime you want to check for a valid link.
use strict;
use warnings;
use LWP::UserAgent;
sub check_url {
my ($url) = #_;
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(HEAD => $url);
my $res = $ua->request($req);
return $res->status_line if $res->is_error;
return "Success: $url";
}
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.
I have CGI proxy that works on my localhost, but when I try to get it work on another server I get Premature end of script headers. I have included the source below. I also tried print header instead of the text/xml and it worked localhost but it failed on the server.
use strict;
#use warnings;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use HTTP::Request::Common qw(POST);
use HTTP::Request::Common;
use LWP::UserAgent;
use URI::Escape;
use Data::Dumper;
my $url = param('url');
sub writeXML($) {
my $response = shift #_;
if ($response->is_success) {
print CGI->header('text/xml');
print $response->content;
print STDERR "content response:#" . $response->content . "#\n";
}
else {
print STDERR "Status Code: " . $response->status_line . "\n";
print STDERR Dumper ($response);
}
}
sub makeRequest(){
if ($url){
my $ua = LWP::UserAgent->new;
my $response = $ua->request(GET $url);
if ($response){
writeXML($response);
}
else{
print STDERR "No response exists";
}
}
else{
print STDERR "URL must be specified";
}
}
makeRequest();
0;
__END__
The script "works" when I try it from the command line:
$ t.pl url=http://www.unur.com/
gives me the home page of my web site.
That means, the host on which you are trying this is missing some libraries. To figure out which ones, you should examine the server's error log, or try running your script from the shell as shown above.
See DEBUGGING.
PS: There is absolutely no good reason for those prototypes on makeRequest and writeXML. Plus, try warn sprintf "Status: %s\n", $response->status_line; instead of those unsightly print STDERR lines.
See my Troubleshooting Perl CGI scripts guide for all the steps you can go through to find the problem.
You only output a header if the program succeeds, all your error conditions are going to cause the premature end of script headers.
Put a 'print CGI->header();' and a suitable error message to STDOUT at all the points where you're output an error message to STDERR, and you'll be to see what's going wrong.