Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
I posted a question earlier, but it would probably be easier if my fellow monks could see the code. This program is monitoring syslog messages - a pipe from syslog-ng sends the data into STDIN. This is never supposed to reach EOF or anything... the syslog process will kill and restart this program as needed (during rotate logs).

It appears to die on a line that contains a single quote:

Sep 9 05:09:53 bouncer postfix/smtpd[6709]: reject: RCPT from 200-158 +-180-26.dsl.telesp.net.br[200.158.180.26]: 554 <rrrrrrrr@osprey.net>: + Recipient address rejected: Service unavailable; [200.158.180.26] bl +ocked by brazil.blackholes.us See http://www.blackholes.us/ for detai +ls. ]; from=<jh.o'Reillyop@easynet.co.uk> to=<rrrrrrr@osprey.net>

But I use placeholders and such in my sql code.

Can anyone help figure out what is happening?

#!/usr/bin/perl use FileHandle; use strict; use Data::Dumper; use DBI; my $dbh = DBI->connect("DBI:mysql:database=postfix;host=xxxxx", "xxxx", "xxxx") or die; my $debug = 1; use vars qw($line); ################################################################### # Main Script # First, lets collect the data, then we'll process it # open LOGFILE, ">>/var/log/dgmtest"; autoflush LOGFILE 1; while (1) { $_ = <>; $line = $_; if (/postfix\S+ reject: RCPT from (\S+) (530|554|450) (\S+): (.*) +from=<(.*?)> to=<(.*?)>/) { my ($from, $to, $message, $o, $t, $th) = (lc($5),lc($6),$4, $1 +, $2, $3); #print "Blocked message from: $from to: $to because: $message\ +n"; $message = ($message =~ /www.ordb.org/ ? "ORDB" : $message); $message = ($message =~ /www.spamcop.net/ ? "SPAMCOP" : $messa +ge); $message = ($message =~ /dun.dnsrbl.net/ ? "DUNDNSRBL" : $mess +age); $message = ($message =~ /spam.dnsrbl.net/ ? "SPAMDNSRBL" : $me +ssage); $message = ($message =~ /Cannot find your hostname/ ? "RDNS" : + $message); $message = ($message =~ /relays.osirusoft.com/ ? "OSFT" : $mes +sage); $message = ($message =~ /Relay access denied/ ? "RELAYDENIED" +: $message); $message = ($message =~ /Recipient address rejected: Access de +nied/ ? "BLACKLIST" : $message); $message = ($message =~ /china.blackholes.us/ ? "CHINA" : $mes +sage); $message = ($message =~ /cn-kr.blackholes.us/ ? "KOREA" : $mes +sage); $message = ($message =~ /argentina.blackholes.us/ ? "ARGENTINA +" : $message); $message = ($message =~ /brazil.blackholes.us/ ? "BRAZIL" : $m +essage); $message = ($message =~ /blackholes.easynet.nl/ ? "EASYNET" : +$message); $message = ($message =~ /opm.blitzed.org/ ? "BLITZED" : $messa +ge); $message = ($message =~ /trustic.com/ ? "TRUSTIC" : $message); # some ID-10T is trying to spam through us as if we were an op +en relay. Let's not count them. if ($message =~ /RELAYDENIED/ and $from =~ /(blvelasq|douglasl +|meinsen|ecr)/) { print LOGFILE "dropping relay from $o, $from to $to\n"; + next; } my $result = Check($to, $from); $result ? Update($result, 1, $message) : Insert($to,$from,$message,1); UpdateStats($to, $message); print LOGFILE $_; } elsif (/bouncer postfix\S+ reject: /) { print LOGFILE $_; } } END { print "dying"; print LOGFILE scalar localtime() ." screport.pl ending. Last Line: + $line\n"; close LOGFILE; } sub Check($$) { my ($rcpt, $from) = @_; my $id; my $sth = $dbh->prepare("SELECT id from per_user_errors WHERE rcpt +=? AND sender=?") or die $dbh->errstr; #$rcpt = $dbh->quote($rcpt); #$from = $dbh->quote($from); $sth->execute($rcpt, $from); ($id) = $sth->fetchrow_array(); $sth->finish(); return $id; } sub Insert ($$$$) { my ($rcpt, $from, $why, $count) = @_; if ($debug) { print "INSERT INTO per_user_errors VALUES ('','$rcpt','$from', +'$why','$count',CURRENT_DATE)\n"; return; } my $sth = $dbh->prepare("INSERT INTO per_user_errors VALUES ('','$ +rcpt','$from','$why','$count',CURRENT_DATE)"); $sth->execute() or die $dbh->errstr; $sth->finish(); } sub Update ($$$) { my ($id, $count, $why) = @_; if ($debug) { print "UPDATE per_user_errors SET tries=tries+$count, tstamp=C +URRENT_DATE, method='$why' WHERE id=$id\n"; return; } my $sth = $dbh->prepare("UPDATE per_user_errors SET tries=tries+$c +ount, tstamp=CURRENT_DATE WHERE id=$id"); #print ("UPDATE per_user_errors SET tries=tries+$count, tstamp=CUR +RENT_DATE WHERE id=$id"); $sth->execute() or die $dbh->errstr; $sth->finish(); } sub UpdateStats($$) { my ($address, $type) = @_; return if $type !~ /RDNS|SPAMCOP|OSFT|ORDB|BLACKLIST|DUNSDNSRBL|SP +AMDNSRBL/; #Check for entry my $sth = $dbh->prepare("SELECT id FROM control_stats WHERE addres +s=? AND type=?"); my $numrows = $sth->execute($address, $type); $sth->finish(); #insert or update if ($numrows == 0) { #INSERT $sth = $dbh->prepare("INSERT INTO control_stats VALUES ('',?,? +,1)"); } else { #UPDATE $sth = $dbh->prepare("UPDATE control_stats set count=count+1 W +HERE address=? AND type=?"); } $sth->execute($address,$type); $sth->finish(); #update global stats $sth = $dbh->prepare("UPDATE control_stats set count=count+1 WHERE + address='system' AND type=? OR type='total'"); $sth->execute($type); $sth->finish(); } #sample error message #Jul 3 11:19:00 bouncer postfix/smtpd[14071]: reject: RCPT from unkno +wn[207.250.144.22]: 530 <rrrrrr@osprey.net>: Recipient address reject +ed: Cannot find your hostname, [207.250.144.22]. Ask your system mana +ger to fix your reverse domain name registration. If you are sending + spam, go away. ; from=<bounce-isp-equipment-34419@lists.isp-lists.co +m> to=<rrrrrrrr@osprey.net> #Jan 15 19:52:29 staypuft postfix/smtpd[8530]: reject: RCPT from pp2.d +ailyprmo1.com[64.70.17.74]: 554 <rrrrrr@osprey.net>: Recipient addres +s rejected: Service unavailable; [64.70.17.74] blocked by relays.osir +usoft.com. See http://relays.osirusoft.com for details. ]; from=<rrrr +r@dailyprmo1.com> to=<rrrrrr@osprey.net>

In reply to Why does this script die? by Notromda

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (2)
As of 2022-09-27 02:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer my indexes to start at:




    Results (118 votes). Check out past polls.

    Notices?