PerlScript to take certain words from text file - perl

Question

I have a text File with data such that:
#alstrong textert tcp $EXTERNAL_NET $HTTP_PORTS -> $HOME_NET any (msg:"ET ACTIVEX Microsoft Whale Intelligent Application Gateway ActiveX Buffer Overflow-1"; flow:established,to_client; file_data; **content:"8D9563A9-8D5F-459B-87F2-BA842255CB9A"**; nocase; **content:"CheckForUpdates"**; nocase; distance:0; pcre:"/<OBJECT\s+[^>]*classid\s*=\s*[\x22\x27]?\s*clsid\s*\x3a\s*\x7B?\s*8D9563A9-8D5F-459B-87F2-BA842255CB9A/si";reference:url,dev.metasploit.com/redmine/projects/framework/repository/entry/modules/exploits/windows/browser/mswhale_checkforupdates.rb; reference:url,www.kb.cert.org/vuls/id/789121; reference:url,doc.emergingthreats.net/2010562; classtype:web-application-attack; sid:2010562; rev:6; metadata:affected_product Windows_XP_Vista_7_8_10_Server_32_64_Bit, attack_target Client_Endpoint, created_at 2010_07_30, deployment Perimeter, signature_severity Major, tag ActiveX, updated_at 2016_07_01;)
I need to extract all words in the fields named "Content" and store them in another text file. I found this code in Perl (I have no experience with it), Is it extract all fields or only the first one?
#!/local/bin/perl5 -w
# Description:
# Extract bit-pattern from content-part of Snort-rules.
# Choose rules that have only one content-part.
# Store distinct patterns only.
# Choose length of shortest and longest pattern to store.
$rulesdir = "/hom/geirni/www_docs/research/snort202_win32/Snort/rules";
#rulefiles = `ls $rulesdir/*.rules`;
$camfile = "camdata.txt";
#
$minLength = 4; # Bytes
$maxLength = 32;
#
# Find content-part of rules
for $rulefile(#rulefiles){
#
open(INFILE, "<".$rulefile) or die
"Can't open ".$rulefile."\n";
#rules = <INFILE>;
close(INFILE);
#
for $rule(#rules){
#
$contentParts = 0;
#
if($rule =~ /content:/){
#parts = split(/;/, $rule);
for $part(#parts){
if($part =~ /content:/){
$content = $part;
$contentParts++;
# Remove anything before content-part
$content =~ s/^.*content:.*?\"//i;
# Remove anything after content-part
$content =~ s/\"$.*//g;
}
}
}
#
# Store content-part
if ($contentParts == 1){
push(#contents, $content);
}
}
}
#
#
#
# Convert content-strings to hex. Store only distinct patterns
for $content(#contents){
#
$pipe = 0; # hex patterns are limited by pipes; |00 bc 55|
$char = ""; # Current character in content; ASCII or hex
$pattern = ""; # Content converted to hex
#
# Loop through current content-string
for ($i=0; $i<=length($content)-1; $i++){ # -1 for newline
#
$char = substr($content, $i, 1);
#
# Control over pipes
if($char =~ /\|/){
if(!$pipe){
$pipe = 1;
}
else {
$pipe = 0;
}
next; # Skip to next character
}
#
# Convert to lowcase hex
if(!$pipe){ # ASCII-value
$pattern .= sprintf("%x", ord($char));
}
else { # hex-value
$char =~ s/ //; # Remove blanks
$pattern .= "\l$char";
}
}
#
# Store converted pattern
if((length($pattern) >= $minLength*2) &&
(length($pattern) <= $maxLength*2)){
$hexPatterns{$pattern} = "dummyValue"; # Keys will be distinct
}
}
#
#
#
# Print patterns, that have no subsets, to file
open(OUTFILE, ">".$camfile) or die
"Can't open ".$camfile."\n";
#
#patterns = keys %hexPatterns;
$count = 0; # Count patterns that are written to file
#
HEXLOOP:
for($i=0; $i<=$#patterns; $i++){
for($j=0; $j<=$#patterns; $j++){ # Search for subsets
#
next if($i==$j); # Do not compare a pattern with itself
#
next HEXLOOP if # Skip if subset is found
((length($patterns[$i]) <= length($patterns[$j])) &&
($patterns[$j] =~ /$patterns[$i]/));
}
print OUTFILE $patterns[$i]."\n";
$count++;
}
#
close(OUTFILE);
#
#
#
# msg
print
"\n".
" Wrote ".$count." patterns to file: \"".$camfile."\"\n".
"\n";

Answer 1

The following perl script extracts "content" data to screen (on line by line basis). To store data, redirect output into a file.
#!/usr/bin/env perl
#
# vim: ai ts=4 sw=4
use strict;
use warnings;
use feature 'say';
while( my $line = <> ) {
my #array = $line =~ /content:"(.*?)"/g;
say join "\t", #array;
}
Run the script as script.pl filename
Output
8D9563A9-8D5F-459B-87F2-BA842255CB9A CheckForUpdates

Answer 2

I found this code in Perl (I have no experience with it)
Rather than a Perl script you dare not even read the comments of which, consider just to use:
grep -Po 'content:".*?"' <text >another_text
To remove content:, the quotes and the dashes, you can use:
grep -Po '(?<=content:").*?(?=")' <text | tr -d - >another_text

Answer 3

#Armali
I want to edit this part in the code so that it can check again in the same line if there are other content Parts and also extract them and print them in different lines:
#
if($rule =~ /content:/){
#parts = split(/;/, $rule);
for $part(#parts){
if($part =~ /content:/){
$content = $part;
$contentParts++;
# Remove anything before content-part
$content =~ s/^.*content:.*?\"//i;
# Remove anything after content-part
$content =~ s/\"$.*//g;
}
}
}
#
# Store content-part
if ($contentParts == 1){
push(#contents, $content);
}
}
}