mira que bonito mi trabajo!
###############################################################################
require 5.003 ;
use strict ;
use Getopt::Std ;
my $do_debug = 0 ;
my ( %mtext , %dmesg , %bouncing , %bqp , %opt , $pat ) ;
###############################################################################
#
# show usage
sub usage()
{
print <<EOF ;
$0 [options] [inputfile [...]]
Reads qmail-send log lines from specified input file(s) (or from standard
input if no files are specified.) Prints the same lines to standard output,
grouped by which message they pertain to.
Options:
-d Show debug messages.
-h Show this help message.
-i Pattern matching is NOT case-sensitive.
-p ___ Only show log line groups which contain this regular expression.
Note that you may need to quote some regular expressions in order
to keep the shell from trying to interpret them. Only one regular
expression may be specified. If no pattern is specified, all groups
will be shown.
-s Show a "-------" line before showing any un-delivered messages.
-u When all input log lines have been read, the log lines for any
un-delivered messages (i.e. messages which are still in the queue,
which haven't been fully delivered yet) will still be in memory.
The program will print a "-------" line, followed by these groups.
Normally the program will only show those groups which contain the
search pattern, this option makes it show all un-delivered messages.
EOF
exit 0 ;
}
###############################################################################
#
# debug routine
sub debug
{
$do_debug && ( print @_ ) ;
}
###############################################################################
#
# function to MAYBE print a given set of log lines
sub maybe_show($;$)
{
my $text = shift ;
my $force = ( shift || 0 ) ;
if ( $force )
{
print $text , "\n" ;
}
elsif ( $pat )
{
if ( $opt{"i"} )
{
if ( $text =~ /$pat/i )
{
print $text , "\n" ;
}
}
else
{
if ( $text =~ /$pat/ )
{
print $text , "\n" ;
}
}
}
else
{
print $text , "\n" ;
}
}
###############################################################################
###############################################################################
###############################################################################
#
# get options
#
# -d debug
# -h help
# -i case-INsensitive pattern matching
# -p___ pattern to match.
# -u show all incomplete messages regardless of pattern match
getopts ( 'dhip:u' , \%opt ) ;
$opt{'h'} && usage() ;
$do_debug = ( $opt{'d'} ? 1 : 0 ) ;
$pat = ( $opt{'p'} || "" ) ;
while ( my $line = <> )
{
my $oline = $line ;
chomp $line ;
my @w = split ( /\s+/ , $line ) ;
########################################
# ignore timestamp
if ( $line =~ /^[A-Z]/ ) # syslog timestamp
{
shift @w ;
shift @w ;
shift @w ;
shift @w ;
}
elsif ( $line =~ /^[0-9]/ ) # tai64nlocal output
{
shift @w ;
shift @w ;
}
elsif ( $line =~ /^\@/ ) # raw multilog output
{
shift @w ;
}
########################################
# process the line
debug "[$line]\n" ;
if ( $w[0] eq "new" )
{
# new msg {mmm}
$mtext{$w[2]} .= $oline ;
}
elsif ( $w[0] eq "info" )
{
# info msg {mmm}: bytes {ccc} from <{sender}> qp {qqq} uid {?}
$w[2] =~ s/\:// ;
$mtext{$w[2]} .= $oline ;
$line =~ / qp (\d+)/ ;
my $q = ( $1 || 0 ) ;
my $z = ( $bqp{$q} || "" ) ;
debug "[-- \$bqp{$q}=[$z] --]\n" ;
if ( $q && $bqp{$q} )
{
$mtext{$w[2]} = $mtext{$bqp{$q}} . $mtext{$w[2]} ;
delete $mtext{$bqp{$q}} ;
delete $bqp{$q} ;
}
}
elsif ( $w[0] eq "starting" )
{
# starting delivery {ddd}: msg {mmm} to {local/remote} {recip}
$w[2] =~ s/\:// ;
$dmesg{$w[2]} = $w[4] ;
$mtext{$w[4]} .= $oline ;
}
elsif ( $w[0] eq "delivery" )
{
# delivery {ddd}: {success/failure/deferral}: ...
$w[1] =~ s/\:// ;
my $m = ( $dmesg{$w[1]} || "" ) ;
$mtext{$m} .= $oline ;
}
elsif ( $w[0] eq "end" )
{
# end msg {mmm}
$mtext{$w[2]} .= $oline ;
if ( ( exists $bouncing{$w[2]} ) && ( exists $bqp{$bouncing{$w[2]}} ) )
{
my $qp = $bouncing{$w[2]} ;
debug "[-- \$qp=[$qp] \$bqp{$qp}=$bqp{$qp} --]\n" ;
$mtext{$bqp{$qp}} = $mtext{$w[2]} ;
debug "[-- \$mtext{$bqp{$qp}} = $mtext{$bqp{$qp}} --]\n" ;
}
else
{
maybe_show ( $mtext{$w[2]} ) ;
}
delete $mtext{$w[2]} ;
}
elsif ( $w[0] eq "bounce" )
{
# bounce msg {mmm} qp {qqq}
$bqp{$w[4]} = "b" . $w[2] ;
$bouncing{$w[2]} = $w[4] ;
$mtext{$w[2]} .= $oline ;
debug "[-- \$bqp{$w[4]} = [$bqp{$w[4]}] --]\n" ;
}
elsif ( $w[0] eq "triple" )
{
# triple bounce: discarding bounce/{mmm}
$w[3] =~ s/bounce\/// ;
$mtext{$w[3]} .= $oline ;
}
}
my @zk = sort keys %mtext ;
if ( $#zk > -1 )
{
$opt{'s'} && ( print "-" x 79 , "\n\n" ) ;
map { maybe_show ( $mtext{$_} , $opt{'u'} ) } @zk ;
}
![[+risas]](/images/smilies/nuevos/risa_ani3.gif "más risas")
![[poraki]](/images/smilies/nuevos/dedos.gif "por aquí!")
![[fumando]](/images/smilies/nuevos/fumando.gif "fumando")
![[looco]](/images/smilies/nuevos2/borracho.gif "loco")
![[snif]](/images/smilies/nuevos/triste_ani1.gif "llorando")
![[buenazo]](/images/smilies/nuevos/risa_tonta.gif "buenazo")
, lo metere en Kcho cuenta y yata 