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.
Related
My code is to enter an actor name and the program, via the given actor's filmography in IMDB, lists on a hash table all the cinematic genres of the movies he has acted in as well as their frequency. However, I have a problem: When I type a name like "brad pitt" or "bruce willis" after running the program at the prompt, execution takes indefinitely. How do you know what the problem is?
Another problem: when I type "nicolas bedos" (an actor name that I entered from the beginning), it works but it seems that the index is only made for a single movie selected in the #url_links list. Should the look_down function of the TreeBuilder module within a foreach loop be adapted? I was telling myself that the #genres list was overwritten on each iteration so I added a push () but the result remains the same.
use LWP::Simple;
use PerlIO::locale;
use HTML::TreeBuilder;
use WWW::Mechanize;
binmode STDOUT, ':locale';
use strict;
use warnings;
print "Enter the actor's name:";
my $acteur1 = <STDIN>; # the user enters the name of the actor
print "We will analyze the filmography of the actor $actor1 by genre\n";
#we put the link with the given actor in Mechanize variable in order to browse the internet links
my $lien1 = "https://www.imdb.com/find?s=nm&q=$acteur1";
my $mech = WWW::Mechanize->new();
$mech->get($lien1); #we access the search page with the get function
$mech->follow_link( url_regex => qr/nm0/i ); #we access the first result using the follow_link function and the regular expression nm0 which is in the URL
my #url_links= $mech->find_all_links( url_regex => qr/title\/tt/i ); #owe insert in an array all the links having as regular expression "title" in their URL
my $nb_links = #url_links; #we record the number of links in the list in this variable
my $tree = HTML::TreeBuilder->new(); #we create the TreeBuilder module to access a specific text on the page via the tags
my %index; #we create a hashing table
my #genres = (); #we create the genre list to insert all the genres encountered
foreach (#url_links) { #we make a loop to browse all the saved links
my $mech2 = WWW::Mechanize->new();
my $html = $_->url(); #we take the url of the link
if ($html =~ m=^/title=) { #if the url starts with "/title"
$mech2 ->get("https://www.imdb.com$html"); #we complete the link
my $content = $mech2->content; #we take the content of the page
$tree->parse($content); #we access the url and we use the tree to find the strings that interest us
#genres = $tree->look_down ('class', 'see-more inline canwrap', #We have as criterion to access the class = "see-more .."
sub {
my $link = $_[0]->look_down('_tag','a'); #new conditions: <a> tags
$link->attr('href') =~ m{genres=}; #autres conditions: "genres" must be in the URL
}
);
}
}
my #genres1 = (); #we create a new list to insert the words found (the genres of films)
foreach my $e (#genres){ #we create a loop to browse the list
my $genre = $e->as_text; #the text of the list element is inserted into the variable
#genres1 = split(/[à| ]/,$genre); #we remove the unnecessary characters that are spaces, at and | which allow to keep that the terms of genre cine
}
foreach my $e (#genres1){ #another loop to filter listing errors (Genres: etc ..) and add the correct words to the hash table
if ($e ne ("Genres:" or "") ) {
$index{$e}++;
}
}
$tree->delete; #we delete the tree as we no longer need it
foreach my $cle (sort{$index{$b} <=> $index{$a}} keys %index){
print "$cle : $index{$cle}\n"; #we display the hash table with the genres and the number of times that appear in the filmography of the given actor
}
Thank you in advance for your help,
wobot
The IMDB Conditions of Use say this:
Robots and Screen Scraping: You may not use data mining, robots, screen scraping, or similar data gathering and extraction tools on this site, except with our express written consent as noted below.
So you might want to reconsider what you're doing. Perhaps you could look at the OMDB API instead.
I would like to view my account balance (online banking) with a Perl script using WWW::Mechanize. The site is Sparkasse Duerenen (online banking) However, the field IDs seem to have a special encryption mechanism. On each new page load the id is generated with a new unique name.
If you view the HTML source you will see following in the field "Legimtation ID" located on the left where you can input login data.
<input id="TgQZqInrKGXTjHOP" class="loginfeld" type="text" onkeyup="testEmptyInput(event,this);" onblur="testEmptyInput(event,this);" onfocus="testEmptyInput(event,this);" value="" maxlength="16" size="10" name="TgQZqInrKGXTjHOP"></input>
Same thing on the PIN/Password.
The input ID seems to have every time an unique generated name. I'am not able to fill this field with a static pre-defined field-name with WWW::Mechanize. What would you folks suggest now? How to fill this field in order to submit a POST request.
I would suggesting using Mojo::DOM to parse the returned HTML and look for an input with class="loginfeld" and type="text". Then just pull the attribute name.
For a short 8 minute video on using Mojo::DOM check out Mojocast Episode 5
The following prints the login field names to STDOUT. You'll just have to feed the return html from WWW::Mechanize to Mojo::DOM instead of this method of using Mojo::UserAgent
#!/usr/bin/perl
use strict;
use warnings;
use Mojo::UserAgent;
my $url = 'https://bankingportal.sparkasse-dueren.de/portal/portal/Starten';
my $ua = Mojo::UserAgent->new;
my $dom = $ua->get($url)->res->dom;
# Print Login field names
for my $input ($dom->find('input')->each) {
if ($input->attr('class') eq 'loginfeld') {
if ($input->attr('type') eq 'text') {
print "Login field name = " . $input->attr('name') . "\n";
}
if ($input->attr('type') eq 'password') {
print "Password field name = " . $input->attr('name') . "\n";
}
}
}
I wish I was lying, but I've spent several months trying to get this to work and I have to admit defeat on my perl scripting skills. I'm at a loss to make this work and need help (for which I wil be very grateful).
The background:
I am running a discussion email list using a third party Listserv. I want to change the "From" header on incoming emails to an address at my domain, by doing a database lookup for the email address, and then adding the users name and company code to the From header, and sending it on.
For example, Super Dave , is changed to David Smith (ABC - LON) , and then the list members will see that header instead of whatever he has chosen as his "From free text".
The script I have developed works very well ... except that more complex emails seem to stun it. Right now the script takes a text version of the email, strips out all the MIME parts and html bits, and changes the header. If it encounters an email format thats new to it (and I havent written a code line to handle), it stops. I could continue fixing each type of email coming in, but I think thats overkill - I need to get back to the KISS method.
Note: the database lookup is without issue. The problem is in the way the email body finally arrives at the listserver.
Instead of this, I want to leave the original email untouched, but just change the From header. Nothing else. Is there any way to do that? Here is (the salient part of) the script.
What Im after is a much simpler method to search the email for the from Header, change it to another value, and then send it on.
Thoughts?
$connect = DBI->connect($dsn, $user, $pw);
open FH, ">mail.txt" or die "can't open mail.txt: $!";
while ( $_ = <STDIN>) {
print FH "$_";
}
close(FH);
$file_content = `cat 'mail.txt' | grep -m1 From |tail -n+1`;
chomp($file_content);
$from = `echo "$file_content"| sed -e "s/.*<//;s/>.*//"`;
chomp($from);
$subject=`cat mail.txt |grep -m1 Subject| sed -e "s/.*Subject: //"`;
chomp($subject);
system('./body.sh');
$encoded=`cat body.txt`;
#Decode the mail and save output to dbody.txt. Still have header+body at this stage.
$body=decode_qp($encoded);
open FF, ">dbody.txt" or die $!;
print FF $body;
close FF;
#If body still has headers, Look for first blank line, and delete all before - this is the body
$bodycheck =`cat dbody.txt`;
if ($bodycheck =~ /Message-Id/ ){
$bodyfinal= `sed '0,/^\$/d' dbody.txt`;
} else {
$bodyfinal =$bodycheck
}
#Save the output to bodyfinal.txt
open FF, ">bodyfinal.txt" or die $!;
print FF $bodyfinal;
close FF;
#THIS SECTION contains code to query the database with the original FROM email address
#get username and domain and then change to lower case for the query
$case_username = substr($from, 0, index($from, '#'));
$m_username = lc($case_username);
$case_domain = substr($from, index($from, '#')+1);
$m_domain = lc($case_domain);
#print "\n##############$m_username\#$m_domain#################\n";
$query = "select user_real_name, company_code, location_code from user where user_email='$m_username\#$m_domain'";
$query_handle = $connect->prepare($query);
$query_handle->execute() or die $DBI::errstr;
#result=$query_handle->fetchrow_array();
print "\n#result\n";
##Forward the mail
sub sendEmail
{
my ($to, $from_sub, $subject, $message) = #_;
my $sendmail = '/usr/sbin/sendmail';
open(MAIL, "|$sendmail -oi -t");
print MAIL "From: $from_sub\n";
print MAIL "To: $to\n";
print MAIL "Subject: $subject\n\n";
print MAIL "$message\n";
close(MAIL);
}
{my $msg = MIME::Lite->new
(
Subject => "$subject",
From => "$result[0] ($result[1]/$codes[0]-$result[2])<listmail#>",
To => 'opg#maillist.com',
Type => 'text/plain',
Encoding => '7bit',
Data => "From: $result[0]/$result[1]-$codes[0]/$result[2] \n________________________________________________ \n \n$bodyfinal \n"
);
$msg->send();
}
To only answer "what is a simple method to search some file for a From: header,
change it to another value, and send it on?": use Tie::File;
Given a file named 'email' that contains the example headers from this page,
#! /usr/bin/env perl
use common::sense;
use Tie::File;
tie my #f, 'Tie::File', 'email' or die $!;
for (#f) {
if (/^From:/) {
say "old: $_";
s/(?<=^From:).*$/ A New Sender <anewsender\#ans.com>/;
say "new: $_";
last
}
}
untie #f;
Output:
$ perl tie-ex
old: From: Taylor Evans <example_from#dc.edu>
new: From: A New Sender <anewsender#ans.com>
$ grep ^From email
From: A New Sender <anewsender#ans.com>
Mind, there's all kinds of wrong with this. Headers don't need to be neatly on one line; there can be more than one From: header (by someone else's scripting error, for instance); there can even be no From: header in the headers and then a From: randomly in the body. Spammers do strange things. But if your original code already contains these limitations and you're happy enough with them, try this.
Meanwhile, there are already great Perl modules that handle mail. Take a look through the Email:: modules listed here.
I am currently attempting to create a Perl webspider using WWW::Mechanize.
What I am trying to do is create a webspider that will crawl the whole site of the URL (entered by the user) and extract all of the links from every page on the site.
But I have a problem with how to spider the whole site to get every link, without duplicates
What I have done so far (the part im having trouble with anyway):
foreach (#nonduplicates) { #array contain urls like www.tree.com/contact-us, www.tree.com/varieties....
$mech->get($_);
my #list = $mech->find_all_links(url_abs_regex => qr/^\Q$urlToSpider\E/); #find all links on this page that starts with http://www.tree.com
#NOW THIS IS WHAT I WANT IT TO DO AFTER THE ABOVE (IN PSEUDOCODE), BUT CANT GET WORKING
#foreach (#list) {
#if $_ is already in #nonduplicates
#then do nothing because that link has already been found
#} else {
#append the link to the end of #nonduplicates so that if it has not been crawled for links already, it will be
How would I be able to do the above?
I am doing this to try and spider the whole site to get a comprehensive list of every URL on the site, without duplicates.
If you think this is not the best/easiest method of achieving the same result I'm open to ideas.
Your help is much appreciated, thanks.
Create a hash to track which links you've seen before and put any unseen ones onto #nonduplicates for processing:
$| = 1;
my $scanned = 0;
my #nonduplicates = ( $urlToSpider ); # Add the first link to the queue.
my %link_tracker = map { $_ => 1 } #nonduplicates; # Keep track of what links we've found already.
while (my $queued_link = pop #nonduplicates) {
$mech->get($queued_link);
my #list = $mech->find_all_links(url_abs_regex => qr/^\Q$urlToSpider\E/);
for my $new_link (#list) {
# Add the link to the queue unless we already encountered it.
# Increment so we don't add it again.
push #nonduplicates, $new_link->url_abs() unless $link_tracker{$new_link->url_abs()}++;
}
printf "\rPages scanned: [%d] Unique Links: [%s] Queued: [%s]", ++$scanned, scalar keys %link_tracker, scalar #nonduplicates;
}
use Data::Dumper;
print Dumper(\%link_tracker);
use List::MoreUtils qw/uniq/;
...
my #list = $mech->find_all_links(...);
my #unique_urls = uniq( map { $_->url } #list );
Now #unique_urls contains the unique urls from #list.
I am trying to set up this script for my local bands newsletter.
Currently, someone sends an email with a request to be added, we manually add it to newsletter mailer I set up.
(Which works great thanks to help I found here!)
The intent now is to have my script below log into the email account I set up for the list on our server, grab the info to add the email automatically.
I know there are a bunch of apps that do this but, I want to learn myself.
I already have the "add to list" working when there is an email address returned from the header(from) below BUT, sometimes the header(from) is a name and not the email address (eg "persons name" is returned from persons name<email#address> but, not the <email#address>.)
Now, I am not set in stone on the below method but, it works famously... to a point.
I read all the docs on these modules and there was nothing I could find to get the darn email in there all the time.
Can someone help me here? Verbose examples are greatly appreciated since I am struggling learning Perl.
#!/usr/bin/perl -w
##########
use CGI;
use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL; #optional i think if no ssl is needed
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
######################################################
# fill in your details here
my $username = '#########';
my $password = '#############';
my $mailhost = '##############';
#######################################################
print CGI::header();
# Connect
my $imap = Net::IMAP::Simple->new($mailhost, port=> 143, use_ssl => 0, ) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log in
if ( !$imap->login( $username, $password ) ) {
print STDERR "Login failed: " . $imap->errstr . "\n";
exit(64);
}
# Look in the INBOX
my $nm = $imap->select('INBOX');
# How many messages are there?
my ($unseen, $recent, $num_messages) = $imap->status();
print "unseen: $unseen, <br />recent: $recent, <br />total: $num_messages<br />\n\n";
## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( $imap->seen($i) ) {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
next;
}## in the long version these are pushed into different arrays for experimenting purposes
else {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
}
}
# Disconnect
$imap->quit;
exit;
use Email::Address;
my #addresses = Email::Address->parse('persons name <email#address>');
print $addresses[0]->address;
The parse method returns an array, so the above way works for me.
I'm making this a separate answer because even though this information is hidden in the comments of the accepted answer, it took me all day to figure that out.
First you need to get the From header using something like Email::Simple. THEN you need to extract the address portion with Email::Address.
use Email::Simple;
use Email::Address;
my $email = Email::Simple->new($input);
my $from = $email->header('From');
my #addrs = Email::Address->parse($from);
my $from_address = $addrs[0]->address; # finally, the naked From address.
Those 4 steps in that order.
The final step is made confusing by the fact that Email::Address uses some voodoo where if you print the parts that Email::Address->parse returns, they will look like simple strings, but they are actually objects. For example if you print the result of Email::Address->parse like so,
my #addrs = Email::Address->parse($from);
foreach my $addr (#addrs) { say $addr; }
You will get the complete address as output:
"Some Name" <address#example.com>
This was highly confusing when working on this. Granted, I caused the confusion by printing the results in the first place, but I do that out of habit when debugging.