i am trying to learn to work with cookies using Perl. following is my code. but i dont know why the cookie is not getting saved in chrome. everytime i run this script a new cookie is created.
#!"C:\wamp\perl\bin\perl.exe" -w
print "Content-type: text/html\n\n";
use CGI::Carp qw( fatalsToBrowser );
use CGI;
my $q=new CGI;
$value=$q->cookie('lol');
$cookie=$q->cookie
(
-name=>'lol',
-value=>'gh',
-expires=>'+7d'
);
print $q->header(-cookie=>$cookie);
$q->start_html
(
-title=>'CGI.pm Cookies'
);
unless($value) {print "cookie is goint to set";}
else {print "Hi $value";}
$q->end_html;
exit;
Here's the output of your script:
Content-type: text/html
Set-Cookie: lol=gh; path=/; expires=Sat, 04-May-2013 11:16:12 GMT
Date: Sat, 27 Apr 2013 11:16:12 GMT
Content-Type: text/html; charset=ISO-8859-1
cookie is goint to set
You send the Content-Type response header twice: first, on line 2, and again on line 16 when you print $q->header(-cookie => $cookie).
In fact, the double newline on line 2 ends your HTTP headers. So the output of $q->header(-cookie => $cookie) will be treated as document body content, not as HTTP headers.
Quickest solution? Comment out line 2.
Your forgot to send your cookie to the client:
print header(-cookie=>$cookie);
Related
Perl 5.36.0 with latest WWW::Mechanize 2.15. I want to get https://web.metro.taipei/img/ALL/timetables/079a.PDF this PDF file's Last-Modified, in which both curl & HTTPie work well:
$ curl -i https://web.metro.taipei/img/ALL/timetables/079a.PDF
HTTP/1.1 200 OK
Content-Type: application/pdf
Last-Modified: Fri, 11 Nov 2022 16:20:50 GMT
Accept-Ranges: bytes
ETag: "93931790e9f5d81:0"
Date: Wed, 23 Nov 2022 05:24:16 GMT
Content-Length: 205866
Strict-Transport-Security: max-age=177211688
Set-Cookie: ...
$ http -p h https://web.metro.taipei/img/ALL/timetables/079a.PDF
HTTP/1.1 200 OK
Accept-Ranges: bytes
Content-Length: 205866
Content-Type: application/pdf
Date: Wed, 23 Nov 2022 05:24:52 GMT
ETag: "93931790e9f5d81:0"
Last-Modified: Fri, 11 Nov 2022 16:20:50 GMT
Set-Cookie: ...
Strict-Transport-Security: max-age=177211688
But with Perl WWW::Mechanize (based on LWP::UserAgent), it doesn't return the PDF file and instead the server has redirected me to root page https://web.metro.taipei/:
(btw, I need to workaround its SSL certificate verification issue due to lack of intermediate certificate on https://web.metro.taipei/ web server settings. The sectigo-rsa.pem file can be obtained from https://crt.sh/?d=924467857)
#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;
use Data::Dumper;
use JSON;
use WWW::Mechanize;
INIT {
# Workaround with Sectigo's intermediate CA.
my $ua = WWW::Mechanize->new(
agent => 'Monitoring/0.20221123',
ssl_opts => {
SSL_ca_file => 'sectigo-rsa.pem'
},
);
my $res = $ua->get(
'https://web.metro.taipei/img/ALL/timetables/079a.PDF',
);
say $res->base;
# You can see details of redirects with:
say Dumper $res->redirects;
}
__END__
Now $res->base is:
$ ./monitoring-taipei-metro.pl
https://www.metro.taipei/
Also for the result of $res->headers, you can see there is a redirect response about https://www.metro.taipei/:
$VAR1 = bless( {
'_content' => '',
'_rc' => '302',
'_headers' => bless( {
'content-length' => '0',
'client-peer' => '60.244.85.177:443',
'location' => 'https://www.metro.taipei/',
By capturing WWW:Mechanize's raw request (using mitmproxy), I found these headers in the request:
TE: deflate,gzip;q=0.3
Connection: close, TE
It seems that web.metro.taipei will redirect all requests to https://www.metro.taipei/ if Connection: TE exists.
push(#LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 0);
This turns of sending TE header.
I have a perl script that posts data to the web service that I wrote in php ...
This is the code:
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $server_endpoint = "http://example.com/";
my $req = HTTP::Request->new(POST => $server_endpoint);
$req->header('content-type' => 'application/json');
$req->header('x-auth-token' => 'kfksj48sdfj4jd9d');
# add POST data to HTTP request body
my $post_data = '{ "name": "Dan", "address": "NY" }';
$req->content($post_data);
my $resp = $ua->request($req);
if ($resp->is_success) {
my $message = $resp->decoded_content;
print "Received reply: $message\n";
}
else {
print "HTTP POST error code: ", $resp->code, "\n";
print "HTTP POST error message: ", $resp->message, "\n";
}
When I send the request, I get this response:
HTTP POST error code: 302
HTTP POST error message: Found
Questions:
How can I get rid of this error or is this even an error though it's says Found ?
How can I get the return value of the post?
What is the right way to post data ? (The code above is copied from this site.
My php site gets the post data and echo or just print it as return.)
Thanks in advance .
A 302 error from a server is a redirection instruction to the client. If you are using the default configuration of LWP::UserAgent, it will automatically follow redirects up to a maximum of seven times. If you are not getting a successful response, it suggests that either you've got redirects turned off (which looks unlikely from the code you've posted, unless you've omitted some configuration details for LWP::UserAgent), or that you're getting stuck in a redirect loop.
You can examine the redirection data by checking the HTTP::Response object:
my $resp = $ua->request($req);
# check for success, etc.
...
if ($resp->is_redirect) {
# check the number of redirects that the script has made:
say "n redirects: " . $resp->redirects;
}
With the default LWP::UA settings, seven is the maximum number of redirects you'll get before LWP::UA gives up.
More details on the redirects is available by calling $resp->redirects in array context:
# #redirects is an array of HTTP::Response objects
my #redirects = $resp->redirects;
# print out the 'location' header for each Response object to track the redirection:
say "Location: " . $_->header('location') for #redirects;
# or, for more comprehensive troubleshooting, print out the whole response:
say "Response: " . $_->as_string for #redirects;
Example output for a request to google.com, which redirects once:
# say "n redirects: " . $resp->redirects;
n redirects: 1
# say "Location: " . $_->header('location') for #redirects;
Location: http://www.google.co.uk/?gfe_rd=cr&ei=1bg3VJikJ_HH8gfOk4GwDw
# say "Response: " . $_->as_string for #redirects;
Response: HTTP/1.1 302 Found
Cache-Control: private
Connection: close
Date: Fri, 10 Oct 2014 10:45:41 GMT
Location: http://www.google.co.uk/?gfe_rd=cr&ei=1bg3VJikJ_HH8gfOk4GwDw
Server: GFE/2.0
Content-Length: 261
Content-Type: text/html; charset=UTF-8
Alternate-Protocol: 80:quic,p=0.01
Client-Date: Fri, 10 Oct 2014 10:45:39 GMT
Client-Peer: 74.125.230.102:80
Client-Response-Num: 1
Title: 302 Moved
<HTML><HEAD><meta http-equiv="content-type" content="text/html;charset=utf-8">
<TITLE>302 Moved</TITLE></HEAD><BODY>
<H1>302 Moved</H1>
The document has moved
here.
</BODY></HTML>
My guess is that you've got stuck in a redirect loop, and that is why you're not getting the expected response back from your PHP script.
NB: to enable say and other useful features from Perl 5.10 and later, put
use feature ':5.10';
at the top of your script after use strict; use warnings;.
I'm out of my depth with curl.
I want to integrate PayMill into my site (which is written in Perl).
There isn't a Perl lib for Paymill yet, so I need to connect to them via curl.
I have completed the front end JS Paymill integration, and received a payment token from PayMill.
I now need to pass the token received from Paymill to my backend and use curl to ask PayMill to complete the transaction and charge the user.
At this point I'm stuck.
To make a transaction, the PayMill documentation says that I must do the following:
curl https://api.paymill.de/v2/transactions \
-u b94a7550bd908877cbae5d3cf0dc4b74: \
-d "amount=4200" \
-d "currency=EUR" \
-d "token=098f6bcd4621d373cade4e832627b4f6" \
-d "description=Test Transaction"
I believe -u is the Paymill secret key to authenticate my request although the documentation is not clear here.
I've had a look at WWW::Curl::Easy, Net:Curl::Easy and LWP::Curl, however nothing in the documentation for those methods makes it obvious to me how to form the query above.
I've tried (without really believing it would work), simply encoding a string in perl as described above;
my $request = '-u ' . $private_key . " ";
foreach my $key (keys %$params_in) {
$request .= '-d "' . lc($key) .'='.$params_in->{$key} . ' ';
}
And then passing $request to my attempt at curl as follows;
my $curl = WWW::Curl::Easy->new;
$curl->setopt(WWW::Curl::Easy::CURLOPT_HEADER(), 1);
$curl->setopt(WWW::Curl::Easy::CURLOPT_URL(), $paymill_server);
$curl->setopt(WWW::Curl::Easy::CURLOPT_POST(), 1);
$curl->setopt(WWW::Curl::Easy::CURLOPT_POSTFIELDS(), $request);
my $response;
$curl->setopt(WWW::Curl::Easy::CURLOPT_WRITEDATA(), \$response);
my $retcode = $curl->perform;
however that fails with an Access Denied error, which I assume is because Paymill is not finding my key because I'm messing up the Curl (assuming -u is supposed to be the secret_key).
I feel I'm missing something obvious here.
Could someone point me in the right direction re how to do this?
Thanks
UPDATE
Excellent answers, thanks everyone for your help, it's working now. I went with Matthias's solution in the end and the final complete solution for making a transaction looked as follows;
use LWP::UserAgent;
use MIME::Base64;
use JSON::XS;
my $ua = LWP::UserAgent->new;
$ua->default_header(Authorization => "Basic " . encode_base64(private_key));
my $response = $ua->post(https://api.paymill.de:443/v2/transactions , $params );
if ( $response->is_success ) {
my $obj = eval { decode_json $response->content } || {};
etc
}
Like other answers propose the best way would be using LWP::UserAgent for doing the requests.
Edit: Since PAYMILL is sending challenge responses since a while now I updated the code.
Since Paymill doesn't comply with RFC 2616, Section 14.47 (the API isn't sending a challenge response) LWP::UserAgent and similar are failing in sending a second request with the credentials. The solution is to "force" LWP::UserAgent to send the credentials with the first request by adding them as header:
use LWP::UserAgent;
use MIME::Base64;
my $ua = LWP::UserAgent->new;
# Use the following line no longer:
# $ua->default_header(Authorization => "Basic " . encode_base64("your PRIVATE key"))
$ua->credentials('api.paymill.de:443', '', 'YOUR PRIVATE KEY');
# Dumping only
use Data::Dumper;
print Dumper($ua->get("https://api.paymill.de:443/v2/clients"));
Disclosure: I work at Paymill.
I don't know if the authentication part with the user/password and your token is correct as I don't know what the 'Realm' is supposed to be. Still, have a go with LWP. It's not that I don't like Curl, I just don't know it, but I do know LWP.
use strict; use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->credentials(
'api.paymill.de:80',
'Realm?',
'b94a7550bd908877cbae5d3cf0dc4b74'
);
my $response = $ua->post(
' https://api.paymill.de/v2/transactions',
{
amount => "4200",
currency => "EUR",
token => "098f6bcd4621d373cade4e832627b4f6",
description => "Test Transaction",
}
);
if ( $response->is_success ) {
print $response->decoded_content; # or whatever
} else {
die $response->status_line;
}
Edit: I read a little in the Paymill documentation. It says:
Authentication
Example
% curl https://api.paymill.de/v2/clients \
-u e73fa5e7b87620585b5ea5d73c4d23bb:
To authenticate at the Paymill API, you need the private key of your
test or live account. You have to use http basic access
authentification. Your key has to be set as the username. A password
isn’t required and you don’t have to insert one. But if you want, feel
free to insert an arbitrary string.
Note
Please keep your private keys secure and don’t pass them to anybody. These private keys have extreme secure information for
handling the transactions of your shop.
All your requests must be made via https. Requests which will be made in another way will fail. This is for security reasons of the
submitted data.
There is also a link to http://en.wikipedia.org/wiki/HTTP_Secure, which clears up the -u part pretty much I believe.
You can use LWP::Protocol::Net::Curl to integrate LWP and libcurl organically. Check this:
#!/usr/bin/env perl
use common::sense;
use Data::Printer;
use JSON::XS;
use LWP::Protocol::Net::Curl verbose => 1;
use LWP::UserAgent;
# create user agent
my $ua = LWP::UserAgent->new;
# POST request
my $res = $ua->post(
'https://b94a7550bd908877cbae5d3cf0dc4b74:#api.paymill.de/v2/transactions',
'Accept-Encoding' => 'gzip',
Content => {
amount => 4200,
currency => 'EUR',
token => '098f6bcd4621d373cade4e832627b4f6',
description => 'Test Transaction',
},
);
# parse received data
my $obj = eval { decode_json $res->content } // {};
# output
p $obj;
The output:
* About to connect() to api.paymill.de port 443 (#0)
* Trying 62.138.241.3...
* Connected to api.paymill.de (62.138.241.3) port 443 (#0)
* Connected to api.paymill.de (62.138.241.3) port 443 (#0)
* successfully set certificate verify locations:
* CAfile: /etc/ssl/certs/ca-certificates.crt
CApath: none
* SSL connection using RC4-SHA
* Server certificate:
* subject: OU=Domain Control Validated; OU=PositiveSSL Wildcard; CN=*.paymill.de
* start date: 2012-07
* expire date: 2013-10
* subjectAltName: api.paymill.de matched
* issuer: C=GB; S
* SSL certificate verify ok.
* Server auth using Basic with user 'b94a7550bd908877cbae5d3cf0dc4b74'
> POST /v2/transactions HTTP/1.1
Authorization: Basic Yjk0YTc1NTBiZDkwODg3N2NiYWU1ZDNjZjBkYzRiNzQ6
User-Agent: libwww-perl/6.04 libcurl/7.28.0 OpenSSL/1.0.0e zlib/1.2.3.4 libidn/1.22 libssh2/1.2.8
Host: api.paymill.de
Accept: */*
Accept-Encoding: gzip
Content-Length: 92
Content-Type: application/x-www-form-urlencoded
* upload completely sent off: 92 out of 92 bytes
< HTTP/1.1 200 OK
< Server: nginx
< Date: Wed, 09 Jan 2013 17:22:54 GMT
< Content-Type: application/json
< Transfer-Encoding: chunked
< Connection: close
< Set-Cookie: PHPSESSID=rmdo5a8c6u107gma28lotmmn24; path=/
< Expires: Thu, 19 Nov 1981 08:52:00 GMT
< Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
< Pragma: no-cache
< X-Server: hrtt-frn5-de13
<
* Closing connection #0
Printing in line 28 of paymill.pl:
\ {
data {
amount 4200,
client {
created_at 1357752174,
description undef,
email undef,
id "client_85cb0bfc837f31c81015",
payment [],
subscription undef,
updated_at 1357752174
},
created_at 1357752174,
currency "EUR",
description "Test Transaction",
id "tran_c672daa0538e2a04e919",
livemode false,
origin_amount 4200,
payment {
card_holder undef,
card_type "visa",
client "client_85cb0bfc837f31c81015",
country undef,
created_at 1357752174,
expire_month 12,
expire_year 2014,
id "pay_2732689f44928301c769",
last4 1111,
type "creditcard",
updated_at 1357752174
},
preauthorization undef,
refunds undef,
status "closed",
updated_at 1357752174
},
mode "test"
}
I have a CGI script in Perl that generates HTTP error pages by itself. I am running it under mod_perl via ModPerl::Registry, using the following Apache2 configuration:
Alias /perl "/var/www/perl"
<Directory "/var/www/perl">
SetHandler perl-script
PerlResponseHandler ModPerl::Registry
PerlOptions +ParseHeaders
Options Indexes FollowSymlinks +ExecCGI
AllowOverride None
Order allow,deny
Allow from all
</Directory>
Everything is fine, except a little problem: when HTTP status printed in headers is different than 200 (for instance 404), Apache appends a default HTML error document to my own generated response.
Take for example the following simple CGI script:
#!/usr/bin/perl
use strict;
use warnings;
use CGI qw(:standard :escapeHTML -nosticky);
use CGI::Carp qw(fatalsToBrowser);
use Apache2::Const qw(:http :common);
our $cgi = CGI->new();
print $cgi->header(-type=>'text/html', -charset => 'utf-8',
-status=> '404 Not Found');
our $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
print <<"EOF";
<html>
<head>
<title>die_error_minimal$mod_perl_version
</head>
<body>
404 error
</body>
</html>
EOF
exit;
Running it with Apache configuration mentioned above results in
HTTP/1.1 404 Not Found
Date: Sun, 27 Nov 2011 13:17:59 GMT
Server: Apache/2.0.54 (Fedora)
Connection: close
Transfer-Encoding: chunked
Content-Type: text/html; charset=utf-8
<html>
<head>
<title>die_error_minimal mod_perl/2.0.1
</head>
<body>
404 error
</body>
</html>
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>404 Not Found</title>
</head><body>
<h1>Not Found</h1>
<p>The requested URL /perl/die_error_minimal.cgi was not found on this server.</p>
<hr>
<address>Apache/2.0.54 (Fedora) Server at localhost Port 80</address>
</body></html>
Note that replacing exit; in the example CGI script above with either return Apache2::Const::OK; or return Apache2::Const::DONE;, as recommended in "How do I suppress the default apache error document in mod_perl?" question on SO doesn't help -- the result stays the same.
What should I fix in my Apache configuration, or what should I add to my CGI script to suppress appending error page by mod_perl / Apache to generated response?
The FAQ works for me , after your CGI is done, after headers are sent, tell apache the status is ok, so it doesn't send ErrorDocument
http://search.cpan.org/~gozer/mod_perl-1.31/faq/mod_perl_faq.pod#So_how_do_I_use_mod_perl_in_conjunction_with_ErrorDocument%3F
#!/usr/bin/perl --
use strict; use warnings;
use CGI;
Main( #ARGV );
exit( 0 );
sub Main {
my404();
#~ my $r = CGI::Simple->new->_mod_perl_request;
my $r = CGI->new->r;
$r->status(200);
return;
}
sub my404 {
my $cgi = CGI->new;
print $cgi->header( -status => 404 );
print "<html><title>print404 says tough noogies</title>
<body><h1>tough noogies</h1></body></html>";
}
__END__
GET http://localhost/perl/print404
User-Agent: lwp-request/6.03 libwww-perl/6.03
404 Not Found
Connection: close
Date: Sun, 27 Nov 2011 20:55:39 GMT
Server: Apache/2.0.54 (Win32) mod_ssl/2.0.54 OpenSSL/0.9.7g PHP/4.3.11 mod_perl/2.0.1 Perl/v5.8.9
Content-Type: text/html; charset=ISO-8859-1
Client-Date: Sun, 27 Nov 2011 20:55:39 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
Client-Transfer-Encoding: chunked
Title: print404 says tough noogies
<html><title>print404 says tough noogies</title>
<body><h1>tough noogies</h1></body></html>
My version of the code, but working more stable:
#!/usr/bin/perl
use CGI qw/:standard/ ;
my $Content_of_webpage = 'Oops. 404 error ...' ;
my $status_code = 404 ;
if( $ENV{MOD_PERL} ) { # mod_perl ON
my $r = CGI->new->r ;
$r->status($status_code) ;
$r->content_type("text/html; charset=UTF-8") ;
$r->rflush ; # send the headers out << it is the trick :)
$r->status(200) ;
}
else { # mod_perl OFF
my $cgi = CGI->new ;
print $cgi->header(
-type => "text/html",
-status => $status_code,
-charset => 'UTF-8'
);
}
print $Content_of_webpage ;
I seem to be facing the same problem: I set header status to 400 in case of an error and return JSON array to describe the actual error.
When I do:
print $main::cgi->header(#ret), $html;
With variables:
#ret: {'-type' => 'application/json','-charset' => 'utf-8','-status' => '400 Bad Request'}
$html: '{"errors":{"short_name":["Missing!"]}}'
I will end up with this:
Status Code: 200 OK
Content-Type: application/json; charset=utf-8
Response: {"errors":{"short_name":["Missing!"]}<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>400 Bad Request</title>
</head><body>
<h1>Bad Request</h1>
<p>Your browser sent a request that this server could not understand.<br />
</p>
<hr>
<address>Apache/2.2.3 (CentOS) Server at localhost Port 80</address>
</body></html>
Using the method described by faquer will in deed suppress the error document, but still returns status 200 OK, like Jakub Narębski points out.
BUT! I have found a workaround, where $r is a Apache2::RequestRec, using this:
http://perl.apache.org/docs/2.0/user/coding/coding.html#Forcing_HTTP_Response_Headers_Out
(otherwise you would use $r->send_http_header(), I guess)
print $main::cgi->header(#ret), $html;
my $r = $main::cgi->r;
$r->rflush; # force sending headers (with headers set by CGI)
$r->status(200); # tell Apache that everything was ok, dont send error doc.
HTTP response:
Status Code: 400 Bad Request
Content-Type: application/json; charset=utf-8
Response: {"errors":{"short_name":["Missing!"]}}
Apache config:
PerlModule ModPerl::PerlRun
PerlModule CGI
PerlModule Apache::DBI
PerlRequire /var/www/html/startup.pl
PerlSendHeader On
.htaccess:
<Files *.cgi>
SetHandler perl-script
PerlHandler ModPerl::PerlRun
Options ExecCGI
</Files>
If I have a URL (eg. http://www.foo.com/alink.pl?page=2), I want to determine if I am being redirected to another link. I'd also like to know the final URL (eg. http://www.foo.com/other_link.pl). Finally, I want to be able to do this in Perl and Groovy.
In Perl:
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => 'http://google.com/' );
my $response = $ua->request($request);
if ( $response->is_success and $response->previous ) {
print $request->url, ' redirected to ', $response->request->uri, "\n";
}
Well, I know nothing about either Perl or groovy, so I'll give you an another from an HTTP point of view, and you'll have to adapt.
Normally, you make an HTTP request, and you get back some HTML text along with a response code. The response code for Success is 200. Any response code in the 300 range is some form of a redirect.
Referring to James's answer - sample HTTP session:
$ telnet www.google.com 80
HEAD / HTTP/1.1
HOST: www.google.com
HTTP/1.1 302 Found
Location: http://www.google.it/
Cache-Control: private
Content-Type: text/html; charset=UTF-8
Set-Cookie: ##############################
Date: Thu, 30 Oct 2008 20:03:36 GMT
Server: ####
Content-Length: 218
Using HEAD instead of GET you get only the header. "302" means a temporary redirection, "Location:" is where you are redirected to.
A quick & dirty groovy script to show the concepts -- Note, this is using java.net.HttpURLConnection
In order to detect the redirect, you have to use setFollowRedirects(false). Otherwise, you end up on the redirected page anyway with a responseCode of 200. The downside is you then have to navigate the redirect yourself.
URL url = new URL ('http://google.com')
HttpURLConnection conn = url.openConnection()
conn.followRedirects = false
conn.requestMethod = 'HEAD'
println conn.responseCode
// Not ideal - should check response code too
if (conn.headerFields.'Location') {
println conn.headerFields.'Location'
}
301
["http://www.google.com/"]
In Perl you can use LWP::Useragent for that. I guess the easiest way is to add a response_redirect handler using add_handler.
I think this will work for 301 redirects.
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => 'http://google.com/' );
my $response = $ua->request($request);
if ( $response->is_redirect ) {
print $request->url . " redirected to location " . $response->header('Location') . "\n";
}