A bug was given to me where https isn't allowed to be entered into one of our forms. After searching the form I noticed that we are using Regexp::Common qw /URI/
I have tried
if ($params{URL} =~ /$RE{URI}{HTTP}{-keep}{-scheme}/)
{
$form{URL} = $1;
}
else
{
$error .= '<li>Website Address is invalid. The URL must be in this form: <b>http://example.com</b></li>';
}
and that allows http and https but only saves ://www.google.com into the database
if ($params{URL} =~ /$RE{URI}{HTTP}{-keep}/)
{
$form{URL} = $1;
}
else
{
$error .= '<li>Website Address is invalid. The URL must be in this form: <b>http://example.com</b></li>';
}
allows only http but saves the entire url into the database
if ($params{URL} =~ /$RE{URI}{HTTP}{-scheme}/)
{
$form{URL} = $1;
}
else
{
$error .= '<li>Website Address is invalid. The URL must be in this form: <b>http://example.com</b></li>';
}
allows http and https but doesn't save ANYTHING to the database
What I would like is to have https and http valid AND have the complete url saved in the database.
The -scheme flag for Regexp::Common::URI::http takes an argument which is a regex to match allowed schemes. It defaults to just matching http and leaving out the argument seems to mean the scheme is not included in the match at all. So to match both http and https you can pass it a regex of https?:
m/$RE{URI}{HTTP}{-scheme => qr<https?>}{-keep}/
Related
I've currently got a small script running that sends a 401 to the client, upon cancelling and not providing user details the script will return nothing.
I'd like to send a redirect to the page they have come from instead.
The main subroutine looks like this;
#!usr/bin/perl
use strict;
use CGI;
sub checkAuth {
my ($user, $pass) = &getAuthUsers(); # Get the user and pass of already authenticated users.
unless ($user) {
&sendAuthenticationHeader(); # Send 401
}
# Check user against DB and return 1 for success.
if ( &checkUser($user, $pass) eq 'Y') { return 1 };
else { # This is the redirect I'm trying to issue.
my $cgi = CGI->new();
print $cgi->redirect($ENV{HTTP_REFERER}); # Redirect to the referer url
exit;
}
}
Unfortunately whenever I try to send new headers it's just received as plain text.
Any help is appreciated, thanks in advance.
sendAuthenticationHeader() emits a header with a 401 status code.
print $cgi->redirect($ENV{HTTP_REFERER}); emits a header with a 302 status code. Of course, since you've already emitted a header, this gets treated as the body.
There's no point to return a 401 if you want to redirect. Change your code to
sub checkAuth {
my ($user, $pass) = getAuthUsers();
if (!$user || !checkUser($user, $pass)) {
print CGI::redirect($ENV{HTTP_REFERER});
exit;
}
}
Notes:
Removed incorrect &. Don't tell Perl to ignore the prototype of subs. Address the underlying issue instead if required.
The return value of checkUser is boolean, so it should return either a true or a false value (e.g. 0 or 1), not two true values (e.g. N or Y). The above code assumed you fixed this.
I'm talking to what seems to be a broken HTTP daemon and I need to make a GET request that includes a pipe | character in the URL.
LWP::UserAgent escapes the pipe character before the request is sent.
For example, a URL passed in as:
https://hostname/url/doSomethingScript?ss=1234&activities=Lec1|01
is passed to the HTTP daemon as
https://hostname/url/doSomethingScript?ss=1234&activities=Lec1%7C01
This is correct, but doesn't work with this broken server.
How can I override or bypass the encoding that LWP and its friends are doing?
Note
I've seen and tried other answers here on StackOverflow addressing similar problems. The difference here seems to be that those answers are dealing with POST requests where the formfield parts of the URL can be passed as an array of key/value pairs or as a 'Content' => $content parameter. Those approaches aren't working for me with an LWP request.
I've also tried constructing an HTTP::Request object and passing that to LWP, and passing the full URL direct to LWP->get(). No dice with either approach.
In response to Borodin's request, this is a sanitised version of the code I'm using
#!/usr/local/bin/perl -w
use HTTP::Cookies;
use LWP;
my $debug = 1;
# make a 'browser' object
my $browser = LWP::UserAgent->new();
# cookie handling...
$browser->cookie_jar(HTTP::Cookies->new(
'file' => '.cookie_jar.txt',
'autosave' => 1,
'ignore_discard' => 1,
));
# proxy, so we can watch...
if ($debug == 1) {
$browser->proxy(['http', 'ftp', 'https'], 'http://localhost:8080/');
}
# user agent string (pretend to be Firefox)
$agent = 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-GB; rv:1.7.12) Gecko/20050919 Firefox/1.0.7';
# set the user agent
$browser->agent($agent);
# do some things here to log in to the web site, accept session cookies, etc.
# These are basic POSTs of filled forms. Works fine.
# [...]
my $baseURL = 'https://hostname/url/doSomethingScript?ss=1234&activities=VALUEA|VALUEB';
#values = ['Lec1', '01', 'Lec1', '02'];
while (1) {
if (scalar(#values) < 2) { last; }
my $vala = shift(#values);
my $valb = shift(#values);
my $url = $basEURL;
$url =~ s/VALUEA/$vala/g;
$url =~ s/VALUEB/$valb/g;
# simplified. Would usually check request for '200' response, etc...
$content = $browser->get($url)->content();
# do something here with the content
# [...]
# fails because the '|' character in the url is escaped after it's handed
# to LWP
}
# end
As #bchgys mentions in his comment, this is (almost) answered in the linked thread. Here are two solutions:
The first and arguably cleanest one is to locally override the escape map in URI::Escape to not modify the pipe character:
use URI;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $res;
{
# Violate RFC 2396 by forcing broken query string
# local makes the override take effect only in the current code block
local $URI::Escape::escapes{'|'} = '|';
$res = $ua->get('http://server/script?q=a|b');
}
print $res->request->as_string, "\n";
Alternatively, you can simply undo the escaping by modifying the URI directly in the request after the request has been created:
use HTTP::Request;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new(GET => 'http://server/script?q=a|b');
# Violate RFC 2396 by forcing broken query string
${$req->uri} =~ s/%7C/|/;
my $res = $ua->request($req);
print $res->request->as_string, "\n";
The first solution is almost certainly preferable because it at least relies on the %URI::Escape::escapes package variable which is exported and documented, so that's probably as close as you're gonna get to doing this with a supported API.
Note that in either case you are in violation of RFC 2396 but as mentioned you may have no choice when talking to a broken server that you have no control over.
I have a CGI server side script that accepts GET and POST, with login parameters.
I want to test it to make sure it is not vulnerable. So the plan is to use Perl LWP, and send login parameters in GET and POST, and compare the results. the interface has been changed, so that only in POST we can send user-name and password in session cookies ( not sure if that is a great idea ) , so how do i test it ? Here is what i have so far:
#!/usr/bin/perl
use LWP;
print "This is libwww-perl-$LWP::VERSION\n";
# Create a user agent object
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("MyApp/0.1 ");
# Create a request
#my $req = HTTP::Request->new(POST => 'http://search.cpan.org/search');
#my $req = HTTP::Request->new(GET => 'https://qa.co.net:443/cgi-bin/n-cu.cgi');
my $req = HTTP::Request->new(GET => 'https://qa.co.net:443/cgi-bin/n-cu.cgi?mode=frameset&JScript=1&remote_user&login=foo&password=foo HTTP/1.1');
$req->content_type('application/x-www-form-urlencoded');
$req->content('query=libwww-perl&mode=dist');
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
# Check the outcome of the response
if ($res->is_success) {
print $res->content;
#print $res->code;
#print $res->message;
}
else {
print $res->status_line, "\n";
}
This is not going to do it, since it does not have the session cookie stuff. But might be a good start though. Is this the right way to test the GET and POST ?
Here is what was implemented in the cgi:
#cr_login for POST && login for GET -- leave GET param as it used to be.
if ($m eq 'GET' && defined($req->param('login'))) {
$msg = 'parameter "login" is invalid for this request type.';
+ my $seclog = $event_logging_directory . '/invalid_request.log';
+ open(S, ">>$seclog") or die $!;
+ my $logmsg = sprintf("%4d-%02d-%02d %02d:%02d:%02d",Today_and_Now())
+ . "|mode:" . $req->param('mode')
+ . "|login:" . $req->param('login')
+ . "|remote_addr:" . $ENV{REMOTE_ADDR}
+ . "|$msg\n";
+ print S $logmsg;
and :
POST request to n-cu.cgi should use parameter "cr_login". If the parameter "login" is passed in a post request, it should throw error and return to login screen.
GET request to n-cu.cgi should use the parameter "login". If the parameter "cr_login" is passed in a post request, it should throw error and return to login screen.
so here is how we do it:
Keep the session cookie and context alive :
my $browser = LWP::UserAgent->new(keep_alive => 10);
$browser->cookie_jar( {} );
$browser->agent('Mozilla/8.0');
#$browser->ssl_opts({ verify_hostname => 0 });
$browser->show_progress(1);
and later: print the response
print "Cookies:\n", Dumper($browser->cookie_jar()), "\n\n";
my $content = $response->as_string;
print "$content\n";
Sending password in a cookie? Nope.
Disallow GET for /login.
POST username and password to /login, over SSL.
In CGI, the GET/POST is indicated via the REQUEST_METHOD environment variable.
You cannot stop determined people from issuing a GET request to your server, but you can refuse to process it like so (untested code - you have to fill in details):
if ($ENV{REQUEST_METHOD} ne 'POST') {
# issue a redirect to a suitable error page, then return.
}
my $q = CGI->new();
my $user = $q->params('username');
my $password = $q->params('password');
my $encrypted_password = my_password_encryptor($password);
unless ( can_log_in($user, $encrypted_password) ) {
# issue an error message - redirect&return or fall-through...
}
else {
$session->set_user_logged_in();
}
Most people do not roll their own authentication or session handling. They mostly use one from CPAN, or one included with the larger app framework. If you're doing CGI, you can use CGI::Session.
You might give CGI::Application and/or its offspring a look. Those authors have already solved a bunch of the problems that you're encountering.
To implement recaptcha in my website.
One option is google API . But for that i need to signup with domain name to get API key.
Is there any other way we can do it ?
You don't necessarily need a domain name to sign up, per se.
They have a concept of a "global key" where one single domain key would be used on several domains. When signing up, select the "Enable this key on all domains (global key)" option, and use a unique identifier (domainkey.abhilasha.com) and this will be fine, you can use the key from any domain in the end.
One way: add this code to your perl file that is called by an html form:
Simplified of course
my #field_names=qw(name branch email g-recaptcha-response);
foreach $field_name (#field_names)
{
if (defined param("$field_name"))
{
$FIELD{$field_name} = param("$field_name");
}
}
$captcha=$FIELD{'g-recaptcha-response'};
use LWP::Simple;
$secretKey = "put your key here";
$ip = remote_host;
#Remove # rem to test submitted variables are present
#print "secret= $secretKey";
#print " and response= $captcha";
#print " and remoteip= $ip";
$URL = "https://www.google.com/recaptcha/api/siteverify?secret=".$secretKey."&response=".$captcha."&remoteip=".$ip;
$contents = get $URL or die;
# contents variable takes the form of: "success": true, "challenge_ts": "2016-11-21T16:02:41Z", "hostname": "www.mydomain.org.uk"
use Data::Dumper qw(Dumper);
# Split contents variable by comma:
my ($success, $challenge_time, $hostname) = split /,/, $contents;
# Split success variable by colon:
my ($success_title, $success_value) = split /:/, $success;
#strip whitespace:
$success_value =~ s/^\s+//;
if ($success_value eq "true")
{
print "it worked";
}else{
print "it did not";
}
If you are just trying to block spam, I prefer the honeypot captcha approach: http://haacked.com/archive/2007/09/10/honeypot-captcha.aspx
Put an input field on your form that should be left blank, then hide it with CSS (preferably in an external CSS file). A robot will find it and will put spam in it but humans wont see it.
In your form validation script, check the length of the field, if it contains any characters, do not process the form submission.
I need a regular expression or module for validating the website URL using Perl.
Regexp::Common::URI::http
I don't use regular expressions. I try to create a URI object and see what happens. If it works, I have a URI object that I can query to get the scheme (the other things get turned into "schemeless" URIs).
use URI;
while( <DATA> )
{
chomp;
my $uri = URI->new( $_, 'http' );
if( $uri->scheme ) { print "$uri is a URL\n"; }
else { print "$uri is not a URL\n"; }
}
__END__
foo.html
http://www.example.com/index.html
abc
www.example.com
If I'm looking for a specific sort of URI, I can query the object to see if it satisfies whatever I need, such as a particular domain name. If I'm doing something with URLs, I'm probably going to make an object anyway, so I might as well start with it.
Since you are talking about "a website URL", I guess you are interested in HTTP and HTTPS URLs only.
For that, instead of using regex, you can use the Perl's Data::Validate::URI module.
For example, to validate HTTP and HTTPS URLs:
use Data::Validate::URI;
my $url = "http://google.com";
my $uriValidator = new Data::Validate::URI();
print "Valid web URL!" if $uriValidator->is_web_uri($url)
And, to validate HTTP URL only:
print "Valid HTTP URL!" if $uriValidator->is_http_uri($url)
Finally, to validate any well-formatted URI:
print "Valid URI!" if $uriValidator->is_uri($url)
If instead, for any reason, you actually want a regex, then you can use something like the following to validate HTTP/HTTPS/FTP/SFTP URLs:
print "Valid URL!\n" if $url =~ /^(?:(?:https?|s?ftp))/i;
use Regexp::Common qw /URI/;
while (<>) {
/($RE{URI}{HTTP})/ and print "$1 is an HTTP URI.\n";
}