I'm trying to build a quick script that will take a url, and check it against a list of PCREs to see if there's a match. However, it doesn't seem to be working. I've tried printing everything to make sure it's output the way I want (including the ARGV[0], passing it with single quotes appears to keep all the characters in tact). But it's still not working.
This is the script
#!/usr/bin/perl
use strict;
use warnings;
if (not($ARGV[0])) {
die "Useage: checkurl.pl \"<url>\"";
}
if ($ARGV[1]) {
die "Too many command line arguments, try checkurl.pl \"<url>\"";
}
$_ = $ARGV[0];
print "$_\n";
my $file = "pcre.txt";
open my $info, $file or die "Could not open $file: $!";
while( my $line = <$info>) {
if (/$line/) {
print "Match found, the url matches the following PCRE: \n";
print "$line\n";
}
}
This is the test URL (warning, this was an actual Angler EK link, I've defanged it, just in case it's still live, so you have to fix it to properly check the PCRE)
hxxp://nosprivsliikeradan.pfgfoxriver-localguide2[.]com/boards/viewforum.php?f=5x827&sid=7q0as14.5i4x8
This is the PCRE in the pcre.txt file that matches the above URL
^http:\/\/(?!www|forums?)[^\.]+\.[^\.]+\.(?:[^\.\x2f]+?|[^\.]+\.[^\.]{2})\/[a-z]+\/?view(?:forum|topic)\.php\?[a-z]=(?=[^\n]{0,64}\.)[0-9a-z\.]{1,6}(?:&[a-z0-9]*=[0-9a-z\.]*){1,2}$
Your pattern is actually /^...$\n/ because you read it from a file and it contains a newline character. You need to chomp the line before interpolating it into the match operator:
while (my $line = <$info>) {
chomp($line);
if (/$line/) {
...
}
}
Related
I'm new to programming and I've run into an issue. We have to use Perl to write a script that opens a file, then loops through each line using a Regex - then print out the results. The opening of the file and the loop I have, but I can't figure out how to implement the Regex. It outputs 0 matched results, when the assignment outline suggests the number to be 338. If I don't use the Regex, it outputs 2987, which is the total number of lines - which is correct. So there's something incorrect with the Regex I just can't figure out. Any help would be greatly appreciated!
Here's what I have thus far:
use warnings;
use strict;
my $i = 0;
my $filename = 'C:\Users\sample.log.txt';
open (fh, '<', $filename) or die $!;
while(<fh>) {
if ($filename=~ /(sshd)/){
$i++;
}
}
close(fh);
print $i;
Consider this piece of code of yours:
while(<fh>) {
if ($filename=~ /(sshd)/){
$i++;
}
}
You are indeed looping through the file lines, but you keep checking if the file name matches your regex. This is clearly not what you intend.
You meant:
while (my $line = <fh>) {
if ($line =~ /sshd/){
$i++;
}
}
Parentheses around the regex seem superfluous (they are meat to capture, while you are only matching).
Since expression while (<fh>) assigns the content of the line to special variable $_ (which is the default argument for regexp matching), this can be shortened as:
while (<fh>) {
$i++ if /sshd/;
}
OP code has some errors which I've correcte
use warnings;
use strict;
use feature 'say';
my $i = 0;
my $filename = 'C:\Users\sample.log.txt';
open my $fh, '<', $filename
or die "Couldn't open $filename";
map{ $i++ if /sshd/ } <$fh>;
close($fh);
say "Found: $i";
I'm new to perl so please excuse me if my question seems obvious. I made a small perl script that just examines itself to extract a particular substring I'm looking for and I'm getting results that I can't explain. Here is the script:
use 5.006;
use strict;
use warnings;
use File::Find;
my #files;
find(
sub { push #files, $File::Find::name unless -d; },
"."
);
my #filteredfiles = grep(/.pl/, #files);
foreach my $fileName (#filteredfiles)
{
open (my $fh, $fileName) or die "Could not open file $fileName";
while (my $row = <$fh>)
{
chomp $row;
if ($row =~ /file/)
{
my ($substring) = $row =~ /file\(([^\)]*)\)/;
print "$substring\n" if $substring;
}
}
close $fh;
}
# file(stuff)
# directory(stuff)
Now, when I run this, I get the following output:
stuff
[^\
Why is it printing the lines out of order? Since the "stuff" line occurs later in the file, shouldn't it print later?
Why is it printing that second line wrong? It should be "\(([^\". It's missing the first 3 characters.
If I change my regex to the following: /directory\(([^\)]*)\)/, I get no output. The only difference is the word. It should be finding the second comment. What is going on here?
use 5.006 kind of odd if you are just beginning to learn Perl ... That is an ancient version.
You should not build a potentially huge list of all files in all locations under the current directory and then filter it. Instead, push only the files you want to the list.
Especially with escaped meta characters, regex patterns can be become hard to read very quickly, so use the /x modifier to insert some whitespace into those patterns.
You do not have to match twice: Just check & capture at the same time.
If open fails, include the reason in the error message.
Your second question above does not make sense. You seem to expect your pattern to match the literal string file\(([^\)]*)\)/, but it cannot.
use strict;
use warnings;
use File::Find;
my #files;
find(
sub {
return if -d;
return unless / [.] pl \z/x;
push #files, $File::Find::name;
},
'.',
);
for my $file ( #files ) {
open my $fh, '<', $file
or die "Could not open file $file: $!";
while (my $line = <$fh>) {
if (my ($substring) = ($line =~ m{ (?:file|directory) \( ([^\)]*) \) }x)) {
print "$substring\n";
}
}
close $fh;
}
# file(stuff)
# directory(other)
Output:
stuff
other
I'm a regex newbie, and I am trying to use a regex to return a list of dates from a text file. The dates are in mm/dd/yy format, so for years it would be '55' for '1955', for example. I am trying to return all entries from years'50' to '99'.
I believe the problem I am having is that once my regex finds a match on a line, it stops right there and jumps to the next line without checking the rest of the line. For example, I have the dates 12/12/12, 10/10/57, 10/09/66 all on one line in the text file, and it only returns 10/10/57.
Here is my code thus far. Any hints or tips? Thank you
open INPUT, "< dates.txt" or die "Can't open input file: $!";
while (my $line = <INPUT>){
if ($line =~ /(\d\d)\/(\d\d)\/([5-9][0-9])/g){
print "$&\n" ;
}
}
A few points about your code
You must always use strict and use warnings 'all' at the top of all your Perl programs
You should prefer lexical file handles and the three-parameter form of open
If your regex pattern contains literal slashes then it is clearest to use a non-standard delimiter so that they don't need to be escaped
Although recent releases of Perl have fixed the issue, there used to be a significant performance hit when using $&, so it is best to avoid it, at least for now. Put capturing parentheses around the whole pattern and use $1 instead
This program will do as you ask
use strict;
use warnings 'all';
open my $fh, '<', 'dates.txt' or die "Can't open input file: $!";
while ( <$fh> ) {
print $1, "\n" while m{(\d\d/\d\d/[5-9][0-9])}g
}
output
10/10/57
10/09/66
You are printing $& which gets updated whenever any new match is encountered.
But in this case you need to store the all the previous matches and the updated one too, so you can use array for storing all the matches.
while(<$fh>) {
#dates = $_ =~ /(\d\d)\/(\d\d)\/([5-9][0-9])/g;
print "#dates\n" if(#dates);
}
You just need to change the 'if' to a 'while' and the regex will take up where it left off;
open INPUT, "< a.dat" or die "Can't open input file: $!";
while (my $line = <INPUT>){
while ($line =~ /(\d\d)\/(\d\d)\/([5-9][0-9])/g){
print "$&\n" ;
}
}
# Output given line above
# 10/10/57
# 10/09/66
You could also capture the whole of the date into one capture variable and use a different regex delimiter to save escaping the slashes:
while ($line =~ m|(\d\d/\d\d/[5-9]\d)|g) {
print "$1\n" ;
}
...but that's a matter of taste, perhaps.
You can use map also to get year range 50 to 99 and store in array
open INPUT, "< dates.txt" or die "Can't open input file: $!";
#as = map{$_ =~ m/\d\d\/\d\d\/[5-9][0-9]/g} <INPUT>;
$, = "\n";
print #as;
Another way around it is removing the dates you don't want.
$line =~ s/\d\d\/\d\d\/[0-4]\d//g;
print $line;
I need help with my script. I am writing a script that will check if the username is still existing in /etc/passwd. I know this can be done on BASH but as much as possible I want to avoid using it, and just focus on writing using Perl instead.
Okay, so my problem is that, my script could not find the right match in my $password_file. I still got the No root found error even though it is still in the file.
Execution of the script.
jpd#skriv ~ $ grep root /etc/passwd
root:x:0:0:root:/root:/bin/bash
jpd#skriv ~ $ ~/Copy/documents/scripts/my_perl/test.pl root
Applying pattern match (m//) to #id will act on scalar(#id) at /home/jpd/Copy/documents/scripts/my_perl/test.pl line 16.
No root found!
jpd#skriv ~ $
Also, why do I always get this "Applying pattern match..." warning?
Here's the code:
#!/usr/bin/perl
use strict;
use warnings;
my $stdin = $ARGV[0];
my $password_file = '/etc/passwd';
open (PWD, $password_file) || die "Error: $!\n";
my #lines = (<PWD>);
close PWD;
for my $line (#lines) {
my #list = split /:/, $line;
my #id = "$list[0]\n";
if (#id =~ m/$stdin/) {
die "Match found!\n";
} else {
print "No $stdin found!\n";
exit 0;
}
}
Thanks in advance! :)
Regards,
sedawkgrep
Perl Newbie
I have a few things to point out regarding your code:
Good job using use strict; and use warnings;. They should be included in EVERY perl script.
Pick meaningful variable names.
$stdin is too generic. $username does a better job of documenting the intent of your script.
Concerning your file processing:
Include use autodie; anytime you're working with files.
This pragma will automatically handle error messages, and will give you better information than just "Error: $!\n". Also, if you are wanting to do a manual error messages, be sure to remove the new line from your message or die won't report the line number.
Use Lexical file handles and the three argument form of open
open my $fh, '<', $password_file;
Don't load an entire file into memory unless you need to. Instead, use while loop and process the file line by line
Concerning your comparison: #id =~ m/$stdin/:
Always use a scalar to the left of comparison =~
The comparison operator binds a scalar to a pattern. Therefore the line #id =~ m/$stdin/ is actually comparing the size of #id to your pattern: "1" =~ m/$stdin/. This is obviously a bug.
Be sure to escape the regular expression special characters using quotemeta or \Q...\E:
$list[0] =~ m/\Q$stdin/
Since you actually want a direct equality, don't use a regex at all, but instead use eq
You're exiting after only processing the first line of your file.
In one fork you're dying if you find a match in the first line. In your other fork, you're exiting with the assumption that no other lines are going to match either.
With these changes, I would correct your script to the following:
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
my $username = $ARGV[0];
my $password_file = '/etc/passwd';
open my $fh, '<', $password_file;
while (<$fh>) {
chomp;
my #cols = split /:/;
if ($cols[0] eq $username) {
die "Match found!\n";
}
}
print "No $username found!\n";
#!/usr/bin/perl
use strict;
use warnings;
my $stdin = $ARGV[0];
my $password_file = '/etc/passwd';
open (PWD,"<$password_file");
my #lines = <PWD>;
my #varr = grep (m/root/, #lines);
Then check varr array and split it if you need.
You'd be better off using a hash for key lookups, but with minimal modification this should work:
open my $in, '<', 'in.txt';
my $stdin = $ARGV[0];
while(<$in>){
chomp;
my #list = split(/\:/);
my ($id) = $list[0];
if ($id eq $stdin) {
die "Match found\n";
}
}
This question is similar to my last one, with one difference to make the toy script more similar to my actual one.
Here is the toy script, replace.pl (Edit: now with 'use strict;', etc)
#! /usr/bin/perl -w
use strict;
open(REPL, "<", $ARGV[0]) or die "Couldn't open $ARGV[0]: $!!";
my %replacements;
while(<REPL>) {
chomp;
my ($orig, $new, #rest) = split /,/;
# Processing+sanitizing of orig/new here
$replacements{$orig} = $new;
}
close(REPL) or die "Couldn't close '$ARGV[0]': $!";
print "Performing the following replacements\n";
while(my ($k,$v) = each %replacements) {
print "\t$k => $v\n";
}
open(IN, "<", $ARGV[1]) or die "Couldn't open $ARGV[1]: $!!";
while ( <IN> ) {
while(my ($k,$v) = each %replacements) {
s/$k/$v/gee;
}
print;
}
close(IN) or die "Couldn't close '$ARGV[1]': $!";
So, now lets say I have two files, replacements.txt (using the best answer from the last question, plus a replacement pair that doesn't use substitution):
(f)oo,q($1."ar")
cat,hacker
and test.txt:
foo
cat
When I run perl replace.pl replacements.txt test.txt I would like the output to be
far
hacker
but instead it's '$1."ar"' (too much escaping) but the results are anything but (even with the other suggestions from that answer for the replacement string). The foo turns into ar, and the cat/hacker is eval'd to the empty string, it seems.
So, what changes do I need to make to replace.pl and/or replacements.txt? Other people will be creating the replacements.txt's, so I'd like to make that file as simple as possible (although I acknowledge that I'm opening the regex can of worms on them).
If this isn't possible to do in one step, I'll use macros to enumerate all possible replacement pairs for this particular file, and hope the issue doesn't come up again.
Please don't give us non-working toy scripts that don't use strict and warnings. Because one of the first things people will do in debugging is to turn those on, and you've just caused work.
Second tip, use the 3-argument version of open rather than the 2-argument version. It is safer. Also in your error checking do as perlstyle says (see http://perldoc.perl.org/perlstyle.html for the full advice) and include the file name and $!.
Anyways your problem is that the code you were including was q($1."ar"). When executed this returns the string $1."ar". Get rid of the q() and it works fine. BUT it causes warnings. That can be fixed by moving the quoting into the replace script, and out of the original script.
Here is a fixed script for you:
#! /usr/bin/perl -w
use strict;
open(REPL, "<", $ARGV[0]) or die "Couldn't open '$ARGV[0]': $!!";
my %replacements;
while(<REPL>) {
chomp;
my ($orig, $new) = split /,/;
# Processing+sanitizing of orig/new here
$replacements{$orig} = '"' . $new . '"';
}
close(REPL) or die "Couldn't close '$ARGV[0]': $!";
print "Performing the following replacements\n";
while(my ($k,$v) = each %replacements) {
print "\t$k => $v\n";
}
open(IN, "<", $ARGV[1]) or die "Couldn't open '$ARGV[1]': $!!";
while ( <IN> ) {
while(my($k,$v) = each %replacements) {
s/$k/$v/gee;
}
print;
}
close(IN) or die "Couldn't close '$ARGV[1]': $!";
And the modified replacements.txt is:
(f)oo,${1}ar
cat,hacker
You have introduced one more level of interpolation since the last question.
You can get the right result by either:
Lay a 3rd "e" modifier on your substitution
s/$k/$v/geee; # eeek
Remove a layer of interpolation in replacements.txt by making the first line
(f)oo,$1."ar"
Get rid of the q() in the replacement string;
Should be just
(f)oo,$1."ar"
as in ($k,$v) = split /,/, $_;
Warning: using external input data in evals is very, very dangerous
Or, just make it
(f)oo,"${1}ar"
No modification to the code is necessary either way e.g. s///gee.
Edit #drhorrible, if it doesen't work then you have other problems.
use strict;use warnings;
my $str = "foo";
my $repl = '(f)oo,q(${1}."ar")';
my ($k,$v) = split /,/, $repl;
$str =~ s/$k/$v/gee;
print $str,"\n";
$str = "foo";
$repl = '(f)oo,$1."ar"';
($k,$v) = split /,/, $repl;
$str =~ s/$k/$v/gee;
print $str,"\n";
$str = "foo";
$repl = '(f)oo,"${1}ar"';
($k,$v) = split /,/, $repl;
$str =~ s/$k/$v/gee;
print $str,"\n";
output:
${1}."ar"
far
far