#!/usr/bin/perl -w

# $Id: qvmenu.pl,v 1.16 2004/12/02 00:44:30 root Exp $
#
# postfix queue manager/browser with curses interface.
#
# allows user to view, delete, and extract URLs from messages
# in postfix queue.
#
# requires 'urlview' program from mutt.
#
# (C) Copyright Craig Sanders <cas@taz.net.au>, 2004
#
# this program is licensed under the terms of the GNU General Public 
# License (GPL)
#
# the latest version can always be found at http://taz.net.au/postfix/scripts
#
# TODO/IDEAS:
#  - allow switching between different queues (e.g. main queue, hold queue)
#  - use URI::Find::Schemeless instead of urlview???

use strict;

use Curses::UI;

use URI::Escape;
use MIME::QuotedPrint;
use HTML::Entities;

#use diagnostics;
#use Carp;

# pre-declare subroutines (see below for implementation)
use subs qw(postsuper view_message urlview_message fork_shell parse_mailq toggle_heldonly bounce);

# external binary locations

my $postsuper = '/usr/sbin/postsuper';
my $postcat = '/usr/sbin/postcat';
my $mailq = '/usr/bin/mailq';
my $urlview = '/usr/bin/urlview';

my $pager = $ENV{'PAGER'} || '/usr/bin/less';

my $debug = 0;

my @bouncelist = ('sa-spam',
                  'sa-ham',
                  '<Cancel>',
                 );

my $bouncedefault = 0;

# Create the root Curses::UI object.
my $cui = new Curses::UI(-clear_on_exit => 0, 
                         -mouse_support => 0,
                         -debug => $debug,
                        );

# create window objects
my ($w,$w0);

my %args = (-border        => 1, 
            -titlereverse  => 1, 
            -padtop        => 0, 
            -padbottom     => 4, 
            -ipad          => 0,
           );

$w = $cui->add('w', 'Window', 
               -title => "Postfix Queue Lister",
               %args
              );

$w0 = $cui->add('w0', 'Window', 
                -border        => 1, 
                -y             => -1, 
                -height        => 4,
               );

$w0->add('explain', 'Label', 
         -text => "v=view   u=url   S=shell   h/H=Hold/Un   R=Requeue   D=Delete   Q=quit" .
                  "\n^T Toggle Held-Only          ^R/^L redraw                 /,?=search"
        );


my (@values, %labels);
my $held_only = 0;

parse_mailq();

sub listbox_callback() {
    # add/remove current item to/from @sel when space/enter is pressed
    my $listbox = shift;
    my $label = $listbox->parent->getobj('listboxlabel');
    my @sel = $listbox->get;
    @sel = ('<none>') unless @sel;
    my $sel = "selected: " . join (", ", @sel);
    $label->text($listbox->title . " $sel");
}

$w->add('mylistbox', 'Listbox',
        -y          => 0,
        -padbottom  => 2,
        -values     => \@values,
        -labels     => \%labels,
        -border     => 1,
        -title      => 'Mail Queue',
        -vscrollbar => 1,
        -multi      => 1,
        -onchange   => \&listbox_callback,
);

$w->add('listboxlabel', 'Label',
        -y => -1,
        -bold => 1,
        -text => "Select a message....",
        -width => -1,
);


# ----------------------------------------------------------------------
# Setup bindings and focus 
# ----------------------------------------------------------------------

# Bind Q to quit.
#$cui->set_binding( sub{ exit }, "q" );
$cui->set_binding( sub{ exit }, "Q" );

# bind keys for postsuper operations
# h = hold
# H = unhold
# R = requeue
# D = delete
$cui->set_binding( sub{ postsuper('h') }, "h" );
$cui->set_binding( sub{ postsuper('H') }, "H" );
$cui->set_binding( sub{ postsuper('r') }, "R" );
$cui->set_binding( sub{ postsuper('d') }, "D" );

# bind v,V keys to view
$cui->set_binding( sub{ view_message }, "v" );
$cui->set_binding( sub{ view_message }, "V" );

# bind u,U keys to view
$cui->set_binding( sub{ urlview_message }, "u" );
$cui->set_binding( sub{ urlview_message }, "U" );

# bind s,S keys to shell
$cui->set_binding( sub{ fork_shell }, "s" );
$cui->set_binding( sub{ fork_shell }, "S" );

# bind <Ctrl+R> & <Ctrl-L> to parse_mailq
$cui->set_binding( sub{ parse_mailq ; $cui->draw; $w->draw}, "\cR" );
$cui->set_binding( sub{ parse_mailq ; $cui->draw; $w->draw}, "\cL" );

# bind <Ctrl+T> to toggle_heldonly
$cui->set_binding( sub{ toggle_heldonly ; parse_mailq ; $cui->draw; $w->draw}, "\cT" );

# bind b,B to bounce
# disabled because bounce isn't finished yet.
#$cui->set_binding( sub{ bounce }, "b" );
#$cui->set_binding( sub{ bounce }, "B" );


# Bind <CTRL+X> to menubar.
#$cui->set_binding( sub{ shift()->root->focus('menu') }, "\cX" );

$w->focus;

# ----------------------------------------------------------------------
# Get things rolling...
# ----------------------------------------------------------------------

MainLoop;



###
###
### subroutines
###
###

sub parse_mailq {
  @values = ();
  %labels = ();

  #$cui->leave_curses();
  #print STDERR "entering parse_mailq()\n";

  my $line = '';

  foreach (`$mailq`) {

    # skip header, "(reason)", total and "is empty" lines.
    next if /-Queue ID-|^\s*\(|^--|^Mail queue is empty$/;

    chomp;

    if (/^\w|^\s*$/) {  # line is empty or begins with non-space

      # process current cumulative line if non-empty;
      if ($line ne '') {
        my (@q, $id, $status, $size);

        @q = split /\s+/, $line;
        $id = shift @q;
        $status = ($id =~ m/.*([!*])/ ? $1 : " ");
        $id =~ s/[*!]//;
        $size = shift @q;
        $size = sprintf "%8i", $size;

        unless ($held_only & $status ne '!') {
	  #print STDERR "  pushing $id onto \@values\n";
          push @values, $id;
          $labels{$id} = join(' ',"$id $status $size ",@q);
	};
      } ;

      # begin new line
      $line = $_;  

    } else {            # line is continuation of prev line.
      # strip off leading and trailing spaces and append to current line
      s/^\s*|\s*$//;
      $line .= " $_";
    };
  } ;

  #print STDERR "leaving parse_mailq()\n";
  #$cui->reset_curses();
};


sub postsuper {
  my ($pq_arg) = (@_);
  my (@sel, $sel, $lbl, $plural, $action, $confirm);

  my %actions=qw(d Delete h Hold H Unhold r Requeue);
  $action = $actions{$pq_arg};

  my $label = $w->getobj('listboxlabel');

  my $listbox = $w->getobj('mylistbox');

  # get current multi-selections
  @sel = $listbox->get;
  if (@sel) {
    $sel = join (", ", @sel);
  } else {
    # get current highlighted item if none selected
    $sel = $listbox->get_active_value ;
    @sel = ($sel);
  };

  return unless $sel;

  $confirm = $cui->root->dialog(
    -message => "Are you sure you want to $action\n$sel\n",
    -buttons => ['no', 'yes'],
    -title   => 'Confirmation');
  return unless $confirm;

  $plural = (@sel == 1) ? "" : "s";

  $lbl = "$action message" . $plural . " $sel";
  $label->text($lbl);
  print STDERR "$lbl\n" if $debug;

  $cui->leave_curses();

  # be careful of link races while debugging!
  #open(POSTSUPER,">>/tmp/postsuper-debug.log") || die "couldn't open debug log: $!\n"; 
  #print POSTSUPER "$postsuper -$pq_arg - \nsel=$sel\n" ;

  open(POSTSUPER,"|$postsuper -$pq_arg -") || die "couldn't open pipe to $postsuper: $!\n";

  foreach (@sel) {
    print POSTSUPER "$_\n";
  };
  close(POSTSUPER);

  $cui->reset_curses();

  parse_mailq();

  $cui->draw;
  $w->draw;
};


sub view_message {
  my $label = $w->getobj('listboxlabel');

  my $listbox = $w->getobj('mylistbox');
  my $sel = $listbox->get_active_value;

  return unless $sel;

  my $lbl = "view message $sel";
  $label->text("$lbl");
  print STDERR "$lbl\n" if $debug;

  $cui->leave_curses();
  system("$postcat -q $sel | $pager");
  $cui->reset_curses();

  $cui->draw;
  $w->draw;
};

sub urlview_message {
  my $label = $w->getobj('listboxlabel');

  my $listbox = $w->getobj('mylistbox');
  my $sel = $listbox->get_active_value;

  return unless $sel;

  my $lbl = "urlview message $sel";
  $label->text("$lbl");
  print STDERR "$lbl\n" if $debug;

  $cui->leave_curses();

  my $str;
  my $decoded;

  $str = `$postcat -q $sel`;
  $str =~ s/\n|\r//g;

  # first decode & unescape any obfuscated entities
  $decoded = uri_unescape($str);
  $decoded = uri_unescape($decoded);
  $decoded = uri_unescape($decoded);
  $decoded = decode_qp($decoded);
  $decoded = decode_entities($decoded);

  open(PIPE,"|$urlview -") || die "couldn't open $urlview: $!\n" ;
  print PIPE "$decoded\n" ;
  close(PIPE);

  $cui->reset_curses();

  $cui->draw;
  $w->draw;
};

sub fork_shell {
  my $label = $w->getobj('listboxlabel');

  my $listbox = $w->getobj('mylistbox');
  my $sel = $listbox->get_active_value;

  return unless $sel;

  my $lbl = "urlview message $sel";
  $label->text("$lbl");
  print STDERR "exec shell on $lbl\n" if $debug;

  $cui->leave_curses();
  print "forking shell.  type 'exit' to return to menu\n";
  print $labels{$sel}, "\n";
  system("/bin/bash");
  $cui->reset_curses();

  $cui->draw;
  $w->draw;
};

sub toggle_heldonly {
	$held_only = 1 - $held_only;
}

sub bounce {
  my (@sel, $sel, $lbl, $plural, $confirm, @bbuttons, $bselected);

  my $label = $w->getobj('listboxlabel');

  my $listbox = $w->getobj('mylistbox');

  # get current multi-selections
  @sel = $listbox->get;
  if (@sel) {
    $sel = join (", ", @sel);
  } else {
    # get current highlighted item if none selected
    $sel = $listbox->get_active_value ;
    @sel = ($sel);
  };

  #return unless $sel;

  @bbuttons = ();
  foreach (@bouncelist) {push @bbuttons, { -label => $_, -value => $_} };

  # get address to bounce to
  $bselected = $cui->root->dialog(
    -message => 'Choose address to bounce message to:',
    -buttons => \@bbuttons,
    -title   => 'Bounce',
    -buttonalignment => 'left',
    -vertical => 1);

  # annoying.  "-vertical" doesn't seem to work for basic dialogs like this.

  return if ($bselected eq '<Cancel>');

  # confirm that user really wants to bounce
  $confirm = $cui->root->dialog(
    -title => 'Confirm',
    -message => "Are you sure you want to bounce the following messages to $bselected?\n\n$sel\n",
    -buttons => ['no', 'yes'],
  );
  return unless $confirm;

  $plural = (@sel == 1) ? "" : "s";

  $lbl = "bounce message" . $plural . " $sel";
  $label->text($lbl);
  print STDERR "$lbl\n" if $debug;

  # now code in here to postcat each message, and re-inject it.  haven't yet
  # decided whether to use smtpd, pickup, or qmqpd.
  # .
  # .
  # .
  # .

};