Perl: IRC Notice Printing - perl

Having a few issues with the below code..
my $file=File::Tail->new("/var/log/messages");
while (defined(my $line=$file->read)) {
print $sock "NOTICE #logs $line";
}
As you can see I'm tailing the servers message logs (which works) and printing it into an IRC socket as a NOTICE, but for some reason it's only printing out the first word of each line into the channel - for example, it's only printing out 'Jan' as that's the month.
Can anyone help with this?
[06:55:48] IRCBOT (~IRCBOT#10.1.0.4) joined the channel.
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:02] -IRCBOT- Jan
Many Thanks in Advance!
EDIT: Just in case it matters, this is how I'm connecting to the IRC server..
use IO::Socket;
use File::Tail;
my $file=File::Tail->new("/var/log/messages");
my $server = "irc.example.co.uk";
my $nick = "IRCBOT";
my $login = "IRCBOT";
my $channel = "#logs";
my $sock = new IO::Socket::INET(PeerAddr => $server,
PeerPort => 6667,
Proto => 'tcp') or
die "Can't connect\n";

You need to prefix the text string with a : character,
print $sock "NOTICE #logs :$line";
If you want to escape the "$line", you can do something like:
print $sock "NOTICE #logs :\x01$line\x01";
By default, the IRC protocol separates parameters by spaces, you need to include the leading semicolon before a text string to indicate it is the trailing parameter and should not be separated.
NOTICE #logs Jan 1st 2014
is treated as a command plus 4 parameters,
NOTICE #logs :Jan 1st 2014 ... more stuff ... long line
is treated as a command plus one parameter that extends to CR LF (possibly including trailing whitespace)

Related

Extract multiline output if consist certain word AND inside a bracket

I have an input of such:
Jun 29 16:46:13 iPhone SomeThing[79987] <Notice>: [AppName] file.x:115 DEBUG: ClassNumberOne viewControllers: (
"<UINavigationController: 0x105031a00>",
"<UINavigationController: 0x10505ba00>",
"<UINavigationController: 0x10486fe00>",
"<UINavigationController: 0x105052600>",
"<UINavigationController: 0x105065c00>"
)
Jun 29 16:46:13 iPhone SomeThing[79987] <Notice>: [AppName] file.x:151 DEBUG: ClassNumberTwo ARG2 2
There's two case to be matched here, one is of multi-line, another is of single line. The criteria is that it must have the DEBUG: keyword. For multiline, if that line has the keyword and and a (, then it should match until the end of ). Each line is separated by a newline separator. I can't figure this out. Currently I'm using a simple grep DEBUG: and that's it. But for the multi-line scenario, everything is lost beside the first one. And I'm not familiar with perl, any idea? Thanks in advance!
Note that I'm on iOS (jailbroken), thus another tool might be limited.
EDIT:
Expected output will be the whole line that matched the criteria, that's the same as the input example shown above. The actual input have tonnes of other lines that doesn't have the keyword DEBUG:, and thus will be ignored.
With any awk in any shell on every UNIX box:
$ awk 'f; /\)/{f=0} /DEBUG:/{print; f=/\(/}' file
Jun 29 16:46:13 iPhone SomeThing[79987] <Notice>: [AppName] file.x:115 DEBUG: ClassNumberOne viewControllers: (
"<UINavigationController: 0x105031a00>",
"<UINavigationController: 0x10505ba00>",
"<UINavigationController: 0x10486fe00>",
"<UINavigationController: 0x105052600>",
"<UINavigationController: 0x105065c00>"
)
Jun 29 16:46:13 iPhone SomeThing[79987] <Notice>: [AppName] file.x:151 DEBUG: ClassNumberTwo ARG2 2
Explanation:
awk ' # WHILE read line DO
f; # IF the flag `f` is set THEN print the current line ENDIF
/\)/{f=0} # IF the current line contains `)` THEN clear the flag ENDIF
/DEBUG:/ { # IF the current line contains `DEBUG:` THEN
print; # print the line
f=/\(/ # set the flag `f` to 1 if the line contains `(`, 0 otherwise
} # ENDIF
' file # ENDWHILE
Here is an example of using a Regexp in Perl (but this should probably be handled more accurately by a parser like Regexp::Grammars):
use feature qw(say);
use strict;
use warnings;
my $data = do { local $/; <> };
my #lines = $data
=~ /
^( (?:(?!$).)* DEBUG:
(?:
(?: [^(]*? $ )
|
(?: (?:(?!$).)* \( [^)]* \) .*? $ )
)
)/gmsx;
say for #lines;

Compilation Error in perl script while giving present date in input file name

As per below script, Trying to give two Input files. Test_DDD111_20120731.csv and DDD111.txt.
Inside one folder this Test_DDD111*.csv file with different date will be available. I want to give only current date file as input inside this script.
I assign date as $deviationreportdate. But i am getting error, can anyone help me to solve this problem.
Error which i am getting:
Scalar found where operator expected at subscriberdump.pl line 58, near "/Test_DDD(\d+)/${deviationreportdate}"
(Missing operator before ${deviationreportdate}?)
syntax error at subscriberdump.pl line 58, near "/Test_DDD(\d+)/${deviationreportdate}"
Execution of test.pl aborted due to compilation errors.
#!/usr/bin/perl
use strict;
use warnings;
use strict;
use POSIX;
my #array123;
my $daysbefore;
my %month="";
my ($f2_field, #patterns, %patts, $f2_rec);
while (#ARGV)
{
my $par=shift;
if( $par eq "-d" )
{
$daysbefore=shift;
next;
}
}
sub getDate
{
my $daysago=shift;
$daysago=0 unless ($daysago);
my #months=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
Localtime(time(86400*$daysago));
# YYYYMMDD, e.g. 20060126
return sprintf("%d%02d%02d",$year+1900,$mon+1,$mday);
}
my $deviationreportdate=getDate($daysbefore-1);
my $transactiondate=getDate($daysbefore);
my $filename="output.txt");
open(OUTPUTFILE,"> /tmp/$filename");
for my $Test_file (<Test_DDD*${deviationreportdate}*>)
{
if ($Test_file =~ /Test_DDD(\d+)/${deviationreportdate}*)
{
my $file = "DDD$1.txt";
my $ID="DDD$1";
open AIN, "<$file" or die($file);
open BIN, "<$Test_file" or die($Test_file);
my %seen;
}
This regular expression is invalid
$Test_file =~ /Test_DDD(\d+)/${deviationreportdate}*
you can only have modifiers after the last slash in a regex. I'm not exactly sure what you're trying to do with this, otherwise I would post the correct regex for you. maybe you ment this?
$Test_file =~ /Test_DDD(\d+)\/${deviationreportdate}*/
or this
$Test_file =~ /Test_DDD(\d+)${deviationreportdate}*/

Perl code to change the date format from IST/UTC to YYYY-MM-DD format

Input:
$str="Thu Mar 25 01:48:45 IST 2011";
Desired output:
2011-03-25
I want only date, not the time.
#!/usr/bin/env perl
use strict;
use warnings;
use Time::Piece;
my $tstamp = Time::Piece->strptime
("Thu Mar 25 01:48:45 2011", "%a %b %d %H:%M:%S %Y");
print $tstamp->strftime("%Y-%m-%d\n");
use Date::Manip;
$str =~ s/[[:upper:]]{3}//; # Remove timezone
$d = ParseDate($str);
die "Invalid date\n" unless $d;
$d=~s/(....)(..)(..).*/$1-$2-$3/;
print "$d\n";
Heck, if you know the format of the date, you don't even need to use a Perl module to manipulate the date and time:
my %months = (Jan => 1, Feb => 2, Mar => 3, Apr => 4 ...);
my $st r= "Thu Mar 25 01:48:45 IST 2011";
$st =~! /\S+\s+(\S+)\s+(\S+)\s+\S+\s+\S+(\S+)/;
my $date = sprintf "%s-%02s-%02s", $3, $months{$1}, $2;
Okay, this is very error prone, and you probably want to do a lot of error checking. The regular expression I used could be formatted a bit stronger (checking for characters and numbers instead of just "not white space". And, you probably want to make sure the month is valid too.
Actually, you're better off using a Date/Time module to do this. I was going to recommend Time::Piece, but James_R_Ferguson beat me to it.

Parsing a syslog entry

This is what an entry looks like:
Jan 26 20:53:31 hostname logger: System rebooted for hard disk upgrade
I'm writing a small application to parse entries like this and email a nicely formatted message to the admin. I'm writing in Perl and found the split() function which is exactly what I'm looking for:
my #tmp = split(/ /, $string, 4);
#tmp = {$date, $hostname, $facility, $message)
That's what I'm hoping to get. Split() can handle the spaces in the $message part because I limit the amount of "words" to split off. However, the spaces in the $date part throw it off. Is there a clean way I can get these variables to represent what they're supposed to?
I know I could use substr() to grab the first 15 characters (the date), then use split() and limit it to 3 words instead of 4, then grab all my strings from there. But is there a more elegant way to do this?
If one-lined-ness is important to elegance, split on spaces that are not followed by a digit:
my ( $time, $hostname, $facility, $message ) = split /\s+(?=\D)/, $string, 4;
But it makes more sense to use a combination of split and unpack to address the need:
my ( $timeStamp, $log ) = unpack 'A15 A*', $string;
my ( $host, $facility, $msg ) = split /\s+/, $log;
Does Parse::Syslog do what you need without the i-try-this-regexp-oh-it-does-not-work-ok-i-hcanged-and-it-works-oh-not-always-hmm-let-me-try-that-much-better-yay-oh-no-it-broke-let-me-try-this-one-has-nobody-done-this-yet feeling?
Use a regex. Here is a simple example:
$mystring = "Jan 26 20:53:31 hostname logger: System rebooted for hard disk upgrade";
if($mystring =~ m/(\w{3}\s+\d{1,2}\s\d{2}:\d{2}:\d{2})\s([^\s]*)\s([^\s:]*):\s(.*$)/) {
$date=$1;
$host=$2;
$facility=$3;
$mesg=$4;
print "Date: $date\nHost: $host\nFacility: $facility\nMesg: $mesg";
}
Old question, but I experienced similar problem and rectified by formatting of my syslog messages ( hence modified rsyslog.conf)
I created rsyslog template as follows
template(name="CustomisedTemplate" type="list") {
property(name="timestamp")
constant(value=" ")
property(name="$year")
constant(value=";")
property(name="hostname")
constant(value=";")
property(name="programname")
constant(value=";")
property(name="msg" spifno1stsp="on")
property(name="msg" droplastlf="on")
constant(value="\n")
}
then
I set my customised template as default by adding
$ActionFileDefaultTemplate CustomisedTemplate.
to (r)syslog.conf
I could also create the filter for my program (logger), which will use template and redirect message created by program ( logger) to separate file. To achieve that, I added
if $programname contains "logger" then /var/logs/logger.err;CustomisedTemplate
to (r)syslog.conf
So at the end my syslog entry looks like
Jan 26 20:53:31 2016;hostname;logger:;System rebooted for hard disk upgrade
which is rather easy to parse.

How can I remove an element from a Perl array after I've processed it?

I am reading a postfix mail log file into an array and then looping through it to extract messages. On the first pass, I'm checking for a match on the "to=" line and grabbing the message ID. After building an array of MSGIDs, I'm looping back through the array to extract information on the to=, from=, and client= lines.
What I'd like to do is remove a line from the array as soon as I've extracted the data from it in order to make the processing a bit faster (i.e. one less line to check against).
Any suggestions? This is in Perl.
Edit: gbacon's answer below was enough to get me rolling with a solid solution. Here's the guts of it:
my %msg;
while (<>) {
my $line = $_;
if (s!^.*postfix/\w+\[.+?\]: (\w+):\s*!!) {
my $key = $1;
push #{ $msg{$key}{$1} } => $2
while /\b(to|from|client|size|nrcpt)=<?(.+?)(?:>|,|\[|$)/g;
}
if ($line =~ s!^(\w+ \d+ \d+:\d+:\d+)\s(\w+.*)\s+postfix/\w+\[.+?\]: (\w+):\s*removed!!) {
my $key = $3;
push #{ $msg{$key}{date} } => $1;
push #{ $msg{$key}{server} } => $2;
}
}
use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper \%msg;
I'm sure that second regexp can be made more impressive, but it gets the job done for what I need. I can now take the hash of all messages and pull out the ones I'm interested in.
Thanks to all who answered.
Do it in a single pass:
#! /usr/bin/perl
use warnings;
use strict;
# for demo only
*ARGV = *DATA;
my %msg;
while (<>) {
if (s!^.*postfix/\w+\[.+?\]: (\w+):\s*!!) {
my $key = $1;
push #{ $msg{$key}{$1} } => $2
while /\b(to|from|client)=(.+?)(?:,|$)/g;
}
}
use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper \%msg;
__DATA__
Apr 8 14:22:02 MailSecure03 postfix/smtpd[32388]: BA1CE38965: client=mail.example.com[x.x.x.x]
Apr 8 14:22:03 MailSecure03 postfix/cleanup[32070]: BA1CE38965: message-id=<49dc4d9a.6020...#example.com>
Apr 8 14:22:03 MailSecure03 postfix/qmgr[19685]: BA1CE38965: from=<mailt...#example.com>, size=1087, nrcpt=2 (queue active)
Apr 8 14:22:04 MailSecure03 postfix/smtp[32608]: BA1CE38965: to=<us...#test.com>, relay=127.0.0.1[127.0.0.1]:10025, delay=1.7, delays=1/0/0/0.68, dsn=2.0.0, status=sent (250 OK, sent 49DC509B_360_15637_162D8438973)
Apr 8 14:22:04 MailSecure03 postfix/smtp[32608]: BA1CE38965: to=<us...#test.com>, relay=127.0.0.1[127.0.0.1]:10025, delay=1.7, delays=1/0/0/0.68, dsn=2.0.0, status=sent (250 OK, sent 49DC509B_360_15637_162D8438973)
Apr 8 14:22:04 MailSecure03 postfix/qmgr[19685]: BA1CE38965: removed
Apr 8 14:22:04 MailSecure03 postfix/smtpd[32589]: 62D8438973: client=localhost.localdomain[127.0.0.1]
Apr 8 14:22:04 MailSecure03 postfix/cleanup[32080]: 62D8438973: message-id=<49dc4d9a.6020...#example.com>
Apr 8 14:22:04 MailSecure03 postfix/qmgr[19685]: 62D8438973: from=<mailt...#example.com>, size=1636, nrcpt=2 (queue active)
Apr 8 14:22:04 MailSecure03 postfix/smtp[32417]: 62D8438973: to=<us...#test.com>, relay=y.y.y.y[y.y.y.y]:25, delay=0.19, delays=0.04/0/0.04/0.1, dsn=2.6.0, status=sent (250 2.6.0 <49dc4d9a.6020...#example.com> Queued mail for delivery)
Apr 8 14:22:04 MailSecure03 postfix/smtp[32417]: 62D8438973: to=<us...#test.com>, relay=y.y.y.y[y.y.y.y]:25, delay=0.19, delays=0.04/0/0.04/0.1, dsn=2.6.0, status=sent (250 2.6.0 <49dc4d9a.6020...#example.com> Queued mail for delivery)
Apr 8 14:22:04 MailSecure03 postfix/qmgr[19685]: 62D8438973: removed
The code works by first looking for a queue ID (e.g., BA1CE38965 and 62D8438973 above), which we store in $key.
Next, we find all matches on the current line (thanks to the /g switch) that look like to=<...>, client=mail.example.com, and so on—with and without the separating comma.
Of note in the pattern are
\b - matches on a word boundary only (prevents matching xxxto=<...>)
(to|from|client) - match to or from or client
(.+?) - matches the field's value with a non-greedy quantifier
(?:,|$) - matches either a comma or at end of string without capturing into $3
The non-greedy (.+?) forces the match to stop at the first comma it encounters rather than the last. Otherwise, on a line with
to=<foo#example.com>, other=123
you'd get <foo#example.com>, other=123 as the recipient!
Then for each field matched, we push it onto the end of an array (because there may be multiple recipients, for example) connected to both the queue ID and field name. Take a look at the result:
$VAR1 = {
'62D8438973' => {
'client' => [
'localhost.localdomain[127.0.0.1]'
],
'to' => [
'<us...#test.com>',
'<us...#test.com>'
],
'from' => [
'<mailt...#example.com>'
]
},
'BA1CE38965' => {
'client' => [
'mail.example.com[x.x.x.x]'
],
'to' => [
'<us...#test.com>',
'<us...#test.com>'
],
'from' => [
'<mailt...#example.com>'
]
}
};
Now say you want to print all the recipients of the message whose queue ID is BA1CE38965:
my $queueid = "BA1CE38965";
foreach my $recip (#{ $msg{$queueid}{to} }) {
print $recip, "\n":
}
Maybe you want to know only how many recipients:
print scalar #{ $msg{$queueid}{to} }, "\n";
If you're willing to assume each message has exactly one client, access it with
print $msg{$queueid}{client}[0], "\n";
It won't actually make the processing faster, as removing from the middle of an array is an expensive operation.
Better options:
Do everything in one pass
When you build the array of IDs, include pointers (indexes, really) into the main array so that you can access its elements quickly for a given ID
Why not do this:
my #extracted = map extract_data($_),
grep msg_rcpt_to( $rcpt, $_ ), #log_data;
When you are done, you'll have an array of extracted data in the same order it appeared in the log.
In perl you can use the splice() routine to remove elements from an array.
As usual, use caution when deleting from an array when looping through an array as your array indexes will change.
Assuming you have the index at hand, use splice:
splice(#array, $indextoremove, 1)
But be careful. Your index will be invalid once you remove an element.
Common methods for manipulating the contents of an array:
# start over with this list for each example:
my #list = qw(a b c d);
splice:
splice #list, 2, 1, qw(e);
# #list now contains: qw(a b e d)
pop and unshift:
pop #list;
# #list now contains: qw(a b c)
unshift #list;
# #list now contains: qw(b c d)
map:
#list = map { $_ eq 'b' ? () : $_ } #list;
# list now contains: qw(a c d);
array slices:
#list[3..4] = qw(e f);
# list now contais: qw(a b c e f);
for and foreach loops:
foreach (#list)
{
# $_ is aliased to each element of the list in turn;
# assignments will be propogated back to the original structure
$_ = uc if m/[a-c]/;
}
# list now contains: qw(A B C d);
Read about all these functions at perldoc perlfunc, slices in perldoc perldata, and for loops in perldoc perlsyn.