use strict; use Irssi; use Encode qw(decode); use IO::Handle; use Log::Procmail; use MIME::Words qw(decode_mimewords); use Time::HiRes qw(usleep); our $VERSION = '2.02'; our %IRSSI = ( authors => 'Cyprien Debu', contact => '[email protected]', name => 'procmaillog', description => 'Gets new mails from procmail.log file', license => 'Public Domain', url => '', changed => '06-2014' ); my $sn = $IRSSI{name}; Irssi::settings_add_level $sn, $sn.'_default_level', 'MSGS'; Irssi::settings_add_int $sn, $sn.'_folder_pad', 15; Irssi::settings_add_str $sn, $sn.'_folders_color', '4,^error$'; Irssi::settings_add_str $sn, $sn.'_folders_level', ''; Irssi::settings_add_str $sn, $sn.'_folders_silent', 'spam'; Irssi::settings_add_str $sn, $sn.'_logfile', '~/.procmail.log'; Irssi::settings_add_int $sn, $sn.'_max_length', 90; Irssi::settings_add_str $sn, $sn.'_split_chars', ',;'; Irssi::settings_add_str $sn, $sn.'_window', '(status)'; Irssi::theme_register([ $sn.'_mail', '$0', $sn.'_crap', '{line_start}{hilight '.$sn.':} $0' ]); sub print_help { print( <: the folders that match the regex will be colorized following the codes listed here: http://irssi.org/documentation/formats (mIRC colors) Example: 5,foo;8,bar -> colorize foo in red and bar in yellow - folders_level: same behaviour as folders_color but with levels instead of color numbers. NOTICES,foo will print folders matching foo with a NOTICES level - folders_silent: regex, folders you don't want to print - logfile: path to your procmail.log (default: ~/.procmail.log) - max_length: max length of the line - split_chars: ,; by default, split characters used in folders_color and folders_level strings Change them if you use these characters in your folders names - window: the target window name Available subcommands: help, start, stop. The script may fail at first launch if it doesn't find your procmail.log file, just set the option and do /${sn} start. EOF ); } my $child; sub print_crap { Irssi::printformat MSGLEVEL_CLIENTCRAP, $sn.'_crap', $_ foreach @_; } sub print_error { print_crap "\x034Error:\x03 ".shift, @_; } # Utility function to parse folders_color and folders_level options. sub parse_option { my $setting = shift; my ($s2, $s1) = split '', Irssi::settings_get_str($sn.'_split_chars'); my %hash; foreach (split $s1, Irssi::settings_get_str($setting)) { my ($key, $rx) = split $s2; $hash{$key} = $rx if $rx; } return %hash; } sub colorize_folder { my $folder = shift; my $border = "\x03"; my %folders = parse_option $sn.'_folders_color'; foreach (keys %folders) { return $border.$_.$folder.$border if ($folder =~ /$folders{$_}/); } $border = "\x02"; return $border.$folder.$border; } sub format_folder { my $folder = shift; my $folder_pad = Irssi::settings_get_int $sn.'_folder_pad'; my $pad = $folder_pad - length $folder; my $padding = $pad > 0 ? ' ' x $pad : ''; return colorize_folder($folder).$padding; } # Used in format_subject sub decode_mime { my $str = shift; my $decoded; foreach (decode_mimewords $str) { $decoded .= decode $_->[1] || 'US-ASCII', $_->[0]; } return $decoded; } sub format_subject { my $str = shift; if (index($str, '=?') == -1) { # If no MIME encoding, choose between utf8 and latin-1 my $utf8 = 0; foreach (split '', $str) { $utf8 = 1 if (ord == 0xc2 or ord == 0xc3); } $str = decode('ISO-8859-1', $str) unless $utf8; return $str; } my $tmp = substr $str, rindex($str, '=?'); if (index($tmp, '?=') == -1) { if (not $tmp =~ /=\?[a-z0-9_-]+\?[bq]\?/i) { # Encoding pattern not complete $str = substr $str, 0, rindex($str, '=?'); } elsif (my ($c) = ($tmp =~ /=\?\S+\?([bq])\?/i)) { # Encoding complete, lacks '?=' or just '=' if ($c =~ /q/i and index($str, '=', length($str)-2) != -1) { # Remove trailing '=' (beginning of new special character) $str = substr $str, 0, index($str, '=', length($str)-2) } $str .= ($str =~ /\?$/) ? '=' : '?='; } } eval { $str = decode_mime $str }; if ($@) { chomp $@; print_error "Error while decoding subject: $@"; $str = "\x034(error)\x03 " . $str; } return $str; } # Get the print level from folder name sub get_level { my $folder = shift; my $level = Irssi::settings_get_level $sn.'_default_level'; return $level unless $folder; my %levels = parse_option $sn.'_folders_level'; foreach (keys %levels) { $level = Irssi::level2bits $_ if ($folder =~ /$levels{$_}/); } return $level; } # Find the right window, build and print the line sub printfmt { my ($raw_folder, $raw_subject) = @_; my $level = get_level $raw_folder; my $folder = format_folder $raw_folder; my $subject = format_subject $raw_subject; my $line = "| $folder | $subject"; my $max_length = Irssi::settings_get_int $sn.'_max_length'; $line = substr($line, 0, $max_length) if ($max_length > 0); my $win_name = Irssi::settings_get_str $sn.'_window'; my $window = Irssi::window_find_item $win_name; unless ($window) { print_error "Could not find window '$win_name'. Stopping.", "Please set ${sn}_window."; do_stop(); return; } $window->printformat($level, $sn.'_mail', $line); } # Main loop sub read_log { my $args = shift; my ($log, $tagref) = @$args; my $rec = $log->next; unless ($rec) { if (defined $child) { # If $child is still running, we just got called too early # (the record is not fully written) return if (system("kill -0 $child &>/dev/null") == 0); # Our child was killed by something external print_error "Child killed. Stopping."; undef $child; } # Child killed, close the pipe Irssi::input_remove $$tagref; return; } my $folders_silent = Irssi::settings_get_str $sn.'_folders_silent'; # We can get several mails in a row # Double braces to use next in a do-while loop do {{ unless (ref $rec) { # If $rec is not a ref it is an error string printfmt "error", $rec; next; } next if ($folders_silent and $rec->folder =~ /$folders_silent/); printfmt $rec->folder, $rec->subject; }} while ($rec = $log->next); } sub do_start { my $filename = Irssi::settings_get_str $sn.'_logfile'; my ($logfile, @rest) = glob $filename; if ($#rest != -1) { print_crap "I found several files with the given filename ($filename).", "I will use $logfile."; } unless (-f $logfile and -r $logfile) { print_error "Could not find $filename, or file not readable.", "See /set ${sn}_logfile."; return; } my $log = Log::Procmail->new; my $wh = IO::Handle->new; pipe $log->fh, $wh; $log->errors(1); $log->fh->blocking(0); $wh->autoflush(1); $child = fork; if (not defined $child) { print_error "Can't fork. Aborting."; return; } if ($child > 0) { # parent Irssi::pidwait_add $child; my $tag; my @args = ($log, \$tag); $tag = Irssi::input_add fileno($log->fh), Irssi::INPUT_READ, \&read_log, \@args; return $logfile; } else { # child open STDOUT, '>&', $wh; open STDERR, '>&', $wh; exec qw(tail -fn0), $logfile; } } sub do_stop { qx(kill $child); undef $child; } sub cmd_start { if (defined $child) { print_crap "Already started, restarting..."; do_stop(); Irssi::timeout_add_once 200, \&cmd_start, undef; return; } my $win_name = Irssi::settings_get_str $sn.'_window'; my $window = Irssi::window_find_item $win_name; unless ($window) { print_error "Could not find window '$win_name'. Aborting.", "Please set ${sn}_window."; return; } if (my $file = do_start) { print_crap "Started on window '$win_name' and file '$file'."; } } sub cmd_stop { unless (defined $child) { print_crap "Not running."; return; } do_stop(); print_crap "Stopped."; } sub UNLOAD { do_stop() if $child; } # Subcommands handler Irssi::command_bind $sn, sub { my ($data, $server, $item) = @_; $data =~ s/\s+$//g; Irssi::command_runsub $sn, $data, $server, $item; }; # Subcommands Irssi::command_bind "$sn help", \&print_help; Irssi::command_bind "$sn start", \&cmd_start; Irssi::command_bind "$sn stop", \&cmd_stop; # Help command handler Irssi::command_bind 'help', sub { $_[0] =~ s/\s+$//g; return unless $_[0] eq $sn; print_help; Irssi::signal_stop; }; # Timeout here to print our message after the loading notice Irssi::timeout_add_once 200, \&cmd_start, undef;