Connecting keeps closing? - perl

so i'm having a problem trying to automatically login to a internal website. I'm able to send a post request but in the response I always get the Header Connection: close. I've tried to pass is through the post request but it still seems to respond with Connection: close. I want to be able to navigate through the website so I need the Connection: keep-alive so that i can send more request. Could anyone tell me what I'm doing wrong? here's the code:
#usr/bin/perl
#NetTelnet.pl
use strict; use warnings;
#Sign into cfxint Unix something...
use Net::Telnet;
# Create a new instance of Net::Telnet,
my $telnetCon = new Net::Telnet (Timeout => 10,
Prompt => '/bash\$ $/') or die "Could not make connection.";
my $hostname = 'cfxint';
# Connect to the host of the users choice
$telnetCon->open(Host => $hostname,
Port => 23) or die "Could not connect to $hostname.";
use WWW::Mechanize;
my $mech = WWW::Mechanize->new(cookie_jar => {});
&login_alfresco;
sub login_cxfint {
#get username and password from user
my $CXusername = '';
my $CXpassword = '';
# Recreate the login
# Wait for the login: message and then enter the username
$telnetCon->waitfor(match => '/login:/i');
# this method adds a \n to the end of the username, it mimics hitting the enter key after entering your username
$telnetCon->print($CXusername);
# does the same as the previous command but for the password
$telnetCon->print($CXpassword);
#Wait for the login successful message
$telnetCon->waitfor();
}
sub login_alfresco{
my $ALusername = '';
my $ALpassword = '';
$mech->get('http://documents.ifds.group:8080/alfresco/faces/jsp/login.jsp');
my $res = $mech->res;
my $idfaces = '';
if($res->is_success){
my $ff = $res->content;
if($ff =~ /id="javax.faces.ViewState" value="(.*?)"/){
$idfaces = $1;
}
else {
print "javax.faces /Regex error?\n";
die;
}
}
print $idfaces, "\n";
#Send the get request for Alfresco
$mech->post('http://documents.ifds.group:8080/alfresco/faces/jsp/login.jsp',[
'loginForm:rediretURL' =>,
'loginForm:user-name' => $ALusername,
'loginForm:user-password' => $ALpassword,
'loginForm:submit' => 'Login',
'loginForm_SUBMIT' => '1',
'loginForm:_idcl' => ,
'loginForm:_link_hidden_' => ,
'javax.faces.ViewState' => $idfaces], **'Connection' =>'keep-alive'**);
$res = $mech->res;
open ALF, ">Alfresco.html";
print ALF $mech->response->as_string;
if($res->is_success){
my $ff = $res->content;
if($ff =~ /id="javax.faces.ViewState" value="(.*?)"/){
$idfaces = $1;
}
else {
print "javax.faces /Regex error?\n";
die;
}
}
print $idfaces, "\n";
#Logout
$mech->post('http://documents.ifds.group:8080/alfresco/faces/jsp/extension/browse/browse.jsp', [
'browse:serach:_option' => '0',
'browse:search' => ,
'browse:spaces-pages' => '20',
'browse:content-pages' => '50',
'browse_SUBMIT' => '1',
'id' => ,
'browse:modelist' => '',
'ref'=>'',
'browse:spacesList:sort' => ,
'browse:_idJsp7' => ,
'browse:sidebar-body:navigator' => ,
'browse:contentRichList:sort' => ,
'browse:act' => 'browse:logout',
'outcome' => 'logout',
'browse:panel' => ,
'javax.faces.ViewState' => $idfaces,])
}

You can enable keep-alive by using a connection cache:
use LWP::ConnCache;
...
$mech->conn_cache(LWP::ConnCache->new);

All that header means is that the connection will be closed upon completion of the request, instead of being kept open for possible further requests. This is perfectly normal and should not interfere with sending the request.
EDIT: If you're sending a Connection:Keep-Alive and the server is still responding with Connection:Close, then the server configuration needs to be changed. The default for HTTP/1.1 is persistent connections, so the server must explicitly be configured to send Connection:Close. See Section 8 of RFC2616.

Related

In mojolicious, how to protect images from public view

Somebody can help me, please. I have app in mojolicious Lite
I wanna block images from all without session login
when i type http://m.y.i.p:3000/images/imageX.jpg
i wanna show images only with session login.
my html code is
shwo image 1
Same way as any other content. Set up a handler for requests, render (or don't render) the content.
get '/images/*img' => sub {
my $c = shift;
if (!$c->session("is_authenticated")) {
return $c->render( text => "Forbidden", status => 403 );
}
my $file = $c->param("img");
if (!open(my $fh, '<', $IMAGE_DIR/$file)) {
return $c->render( text => "Not found", status => 404 );
}
my $data = do { local $/; <$fh> };
close $fh;
$c->render( data => $data, format => 'jpg' );
};
Your request handler will take priority over the default handler that serves content from public folders, but once you have this handler in place, you don't need to store the files it serves in a public folder.
another sololution is
get '/pays/*img' => sub {
my $self = shift;
my $img = $self->param('img');
plugin 'RenderFile';
my #imgext = split(/\./, $img);
my $ext = $imgext[-1];
$self->render_file(
'filepath' => "/directiry/$img",
'format' => "$ext", # will change Content-Type "application/x-download" to "application/pdf"
'content_disposition' => 'inline', # will change Content-Disposition from "attachment" to "inline"
# delete file after completed
);
It is use plugin 'RenderFile';

error when sending email using Dancer2::Plugin::Email;

I am sending email using Dancer2 via the Dancer2::Plugin::Email package. The main code that I have for this is:
sub sendEmail {
my ($params,$email_address,$template) = #_;
my $text = '';
my $tt = Template->new({
INCLUDE_PATH => config->{views},
INTERPOLATE => 1,
OUTPUT => \$text
}) || die "$Template::ERROR\n";
my $out = $tt->process($template,$params);
my $email = email {
from => XXXXX,
to => $email_address,
subject => XXXXX,
body => $text,
'Content-Type' => 'text/html'
};
}
where I have hidden a couple of the fields. I have gotten the following error:
Route exception: open body: Invalid argument at
/usr/local/share/perl/5.22.1/MIME/Entity.pm line 1878. in
/usr/local/share/perl/5.22.1/Dancer2/Core/App.pm l. 1454
It is not occurring all of the time and I haven't been able to find a consistent piece of code that always fails.
I have set the host parameter of the mail server that I am using in the configuration as explained here: https://metacpan.org/pod/Dancer2::Plugin::Email Simple tests show it works, but I get sporadic errors that I can't track down.

Reading Firefox cookie using LWP

I was trying to eliminate the logging in process to a website by reading the browser cookies (which I created by logging in using Firefox earlier). I exported it from Firefox using this Firefox addon. It gives a 200 OK response but returns the generic homepage instead of my custom 'logged in' home page. How do I make sure that cookie is passed to the server properly ?
#!/usr/bin/perl
use strict ;
use warnings;
use LWP::UserAgent;
use HTTP::Cookies::Netscape;
my #GHeader = (
'User-Agent' => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.0.19) Gecko/2010040200 Ubuntu/8.04 (hardy) Firefox/3.0.19',
'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
'Accept-Language' => 'en-us,en;q=0.5',
'Accept-Charset' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
'Accept-Encoding' => 'gzip,deflate',
'Keep-Alive' => '300',
'Connection' => 'keep-alive'
);
my $cookie_jar = HTTP::Cookies::Netscape->new(
file => "cookies.txt",
);
my $Browser = LWP::UserAgent->new;
$Browser->cookie_jar( $cookie_jar );
my ($OutLine,$response)=();
my $URL = 'http://www.hanggliding.org/';
printf("Get [%s]\n",$URL);
$response = $Browser->get($URL,#GHeader);
if($response->is_success)
{
if($response->status_line ne "200 OK")
{
printf("%s\n", $response->status_line);
}
else
{
printf("%s\n", $response->status_line);
$OutLine =$response->decoded_content;
open(HTML,">out.html");printf HTML ("%s",$OutLine);close(HTML);
}
}
else
{
printf("Failed to get url [%s]\n", $response->status_line);
}
You can inject a handler to access or modify request/response data during processing.
Quoting LWP::UserAgent's docs:
Handlers are code that injected at various phases during the processing of requests. The following methods are provided to manage the active handlers:
$ua->add_handler( $phase => \&cb, %matchspec )
Add handler to be invoked in the given processing phase. For how to specify %matchspec see "Matching" in HTTP::Config.
...
request_send => sub { my($request, $ua, $h) = #_; ... }
This handler gets a chance of handling requests before they're sent to the protocol handlers. It should return an HTTP::Response object if it wishes to terminate the processing; otherwise it should return nothing.
From there, you can inject a handler which will analyze the request object, but otherwise do nothing:
use LWP::UserAgent;
use Data::Dumper;
sub dump_request {
my ($request, $ua, $h) = #_;
print Dumper($request);
return undef;
}
my $browser = LWP::UserAgent->new;
$browser->add_handler(
request_send => \&dump_request,
m_method => 'GET'
);
$browser->get('http://www.google.com');

Perl mechanize script no form defined

I'm getting an error No form defined at cqSubmitter.pl at line 33 which is the second set_fields method. Other times I get an Error POSTing http://micron.com Internal Server Error at line 39 , which corresponds to the last click_button line.
I'm not really sure what's going on, and why it's saying no form defined? The first half of the code which includes the first click_button method works fine and saves the correct page, but when I try set_fields for the second time, it errors out.
Anyone familiar with the Mechanize package realize what's going on here?
use Data::Dumper;
use HTTP::Request::Common qw(GET);
use WWW::Mechanize;
#Prepopulated information
my $types_ = "";
my $dept_ = "";
my $group_ = "";
#Create new WWW::Mechanize object
my $mech = WWW::Mechanize->new( 'ssl_opts' => { 'verify_hostname' => 0 } );
my $url = "http://f2prbrequest";
#Fetch URL or Die Tryin'
$mech ->get($url);
$fname = "user";
$pswd = "password";
#Login to ClearQuest form using credentials
$mech->set_fields(
USER => $fname
,PASSWORD => $pswd
);
$mech->click_button(
name => 'Submit'
);
#Set fields and actually fill out ClearQuest Form
$mech->set_fields(
types => $types_
,dept => $dept_
,group => $group_
);
$mech->click_button(
name => 'submit1'
);
$mech->save_content("clearQuestFilled.html");

OpenID authentication to Google Apps via Perl and Net::OpenID::Consumer fails

I asked this over on Google's support forums for Apps integration, but got zero response. Maybe somebody here can help steer me in the right direction.
I'm trying to integrate a Perl application with Google Apps, and I'm having some trouble with the OpenID authentication. I've been using this PHP tutorial from Google as a kind of reference, since there are no Perl examples I can find.
My initial file, index.cgi (referred by manifest.xml, and the starting point of the OpenID transaction) is as follows:
use Net::OpenID::Consumer;
use CGI;
# ...
my $q = CGI->new();
my $domain = $q->param('domain');
if (!$domain) {
print $q->header(), 'Provide domain please.';
exit 0;
}
# my website
my $root = 'http://www.example.com/';
my $csr = Net::OpenID::Consumer->new(
# The user agent which sends the openid off to the server
ua => LWP::UserAgent->new,
# Who we are
required_root => $root,
# Consumer Key Secret from Google Apps Marketplace
consumer_secret => 'Zzzzzz9zzAAAAA....'
);
my $claimed_id = $csr->claimed_identity(
'https://www.google.com/accounts/o8/site-xrds?hd=' . $domain);
if ($claimed_id) {
my $check_url = $claimed_id->check_url(
# Upon validation, the user will be returned here, and real
# work may begin
return_to => $root . '/return.cgi',
trust_root => $root
);
print $q->redirect($check_url);
}
else {
print $q->header(), "Error";
}
This part seems to be working. That is, I get redirected to return.cgi with a bunch of openid.* parameters. However, at this point I get the following error:
no_identity_server The provided URL doesn't declare its OpenID identity server
I'm using the latest version of the Net::OpenID::Consumer module.
Here are the significant bits of return.cgi:
my $q = CGI->new();
my $csr = Net::OpenID::Consumer->new(
ua => LWP::UserAgent->new,
# The root of our URL
required_root => 'http://www.example.com/',
# Our password.
consumer_secret => 'Zzzzzz9zzAAAAA....',
# Where to get the information from.
args => $q
);
print $q->header();
$csr->handle_server_response(
not_openid => sub {
print "That's not an OpenID message. Did you just type in the URL?";
},
setup_required => sub {
my $setup_url = shift;
print 'You need to do something here.';
},
cancelled => sub {
print 'You cancelled your login.';
},
verified => sub {
my $vident = shift;
my $url = $vident->url;
print "You are verified as '$url'. ** FIN **";
},
error => sub { die "Can't figure it out: ", #_; }
);
As you can imagine, I'm wanting the verified sub to fire, but instead I'm getting an error. Anything obvious I'm missing? Any help would be appreciated.
So the solution, it turns out, is to switch modules. I changed to the skimpily documented Net::Google::FederatedLogin, and things are now working. The code is as follows (substitute example.com below for your actual developer's domain).
In your Google Apps Marketplace vendor profile, add the URL to index.cgi in the Application Manifest:
...
<Url>http://www.example.com/index.cgi?from=google&domain=${DOMAIN_NAME}</Url>
...
Then add the following code to your servers.
index.cgi
use CGI;
use Net::Google::FederatedLogin;
my $q = CGI->new();
my $domain = $q->param('domain');
if (!$domain) {
print $q->header(), 'Provide domain please.';
exit 0;
}
my $fl = Net::Google::FederatedLogin->new(
claimed_id =>
'https://www.google.com/accounts/o8/site-xrds?hd=' . $domain,
return_to =>
'http://www.example.com/return.cgi',
extensions => [
{
ns => 'ax',
uri => 'http://openid.net/srv/ax/1.0',
attributes => {
mode => 'fetch_request',
required => 'email',
type => {
email => 'http://axschema.org/contact/email'
}
}
}
] );
print $q->redirect($fl->get_auth_url());
return.cgi
use CGI;
use Net::Google::FederatedLogin;
my $q = CGI->new();
print $q->header();
my $fl = Net::Google::FederatedLogin->new(
cgi => $q,
return_to =>
'http://www.example.com/return.cgi' );
eval { $fl->verify_auth(); };
if ($#) {
print 'Error: ' . $#;
}
else {
# we've authenticated and gotten attributes --
my $ext = $fl->get_extension('http://openid.net/srv/ax/1.0');
print $ext->get_parameter('value.email');
}
(For a full sample, plus OAuth access to user data, see this post on my blog.)
In some cases, reportedly, this is caused by Perl missing Net::SSL, making it fail on Google's SSL URLs.
The step where it's failing is where it performs discovery on the identifier asserted by Google's server. For some reason discovery on that identifier URL is failing. It would be helpful to know what OpenID identifier the Google server is asserting to try to debug why discovery is not working for it.
I'm not sure what $domain is there, but you may need to escape it:
use URI::Escape 'uri_escape';
....
my $claimed_id = $csr->claimed_identity(
'https://www.google.com/accounts/o8/site-xrds?hd=' . uri_escape($domain) );
Also, the consumer_secret used by Net::OpenID::Consumer has no relationship to any other secret.