|
#!/usr/bin/perl -w # # amsfe --crb3 06Feb07/25may07/25jun07 # from # amsfe.ui.pl --crb3 08May07 spectix # # Front end for allmailscan, providing the functionality of an ams listing # in one xterm and a ytree tag-and-move/delete session in another, with the # program doing the wearisome inode# correlating. This code works fine in # Linux. BSD and Solaris are untried; ditto OSX. The best thing you can do # in Windows is get out. Now. # # In a user-account, display that user's Maildir; in root, display all # Maildirs. Tag relevant mails for deletion or moving (default: from /new to # /qrm, using dqrm to set things up for an sprobe_learn run), viewing as # needed to judge. Hit [DO IT] to iterate through the tags and exit; or # [Apply] to iterate through the tags, reload with current Maildir contents, # then change the XFR: dir and do some more. # # Hotkeys M: move, D: delete, [O-]: okay, V:view... ( 25may07: all buttons # have hotkey equivs shown as caps ) or use the buttons. # # Hit <return> after typing into XFR Entry to return to typing hotkeys. # #Dependencies: # - Perl/Tk, Tk::ROText (CPAN) # - allmailscan # - dqrm, assuming you're setting up a Maildir system like mine, # with SpamProbe, etc; otherwise, edit things in xeq() your way. # # allmailscan and dqrm are posted to http://www.stormbringer.org/pers/crb3/mail/, # along with a brief description of the getmail/qmail modified-Maildir system # they work with. # # --crb 325jun07: one bug on upgrade from Tk800 to Tk804. listbox curselection() # now returns an array, even in single mode. If you're still running Tk800, # edit subs ( next_unit, prior_unit, next_page, prior_page ) to take $idx # directly from curselection, removing $pidx completely. # use Tk; use Tk::ROText; # ...or use Text, and ignore the editability. # implementing editing in this app would be like installing the chainsaw # which came with your kitchen-sink kit: just because it was in the box does # not make it suitable for cleaning your best dishes. $usrlen=12; # BRITTLE: keep it wider than any active username. # no easy way to make this self-adjust in time. $dsplen=1; # allocated disposition-code width $displines=20; # listbox lines $dispmaxlen=0; # filled in by get_ams2list: max length of line. # used to make viewer show up as wide as listbox. $mdir='new'; $usr='undef'; $xfrto='qrm'; $basedir="/home"; $moveit='M'; # move tag symbol $killit='D'; # kill tag symbol $leavit='-'; # duntouchit symbol $dsp=$leavit; # default disposition $dqrm='/usr/local/bin/dqrm'; $ams="/usr/local/bin/allmailscan"; $src="$ams |"; #$src="ams.demo.txt"; # for screenshots $lsep=" \xA6 "; # fixed-field field-delimiter $top=0; # ref. $viewer=0; # ref. one at a time, silently switchable. $textbox_viewfile=0; # ref $ref_listbox=0; # ref $ref_mdirentry=0; # ref $chatty=$debug=$safety=0; while(defined($ARGV[0]) and index($ARGV[0],'-')==0){ $arg=shift(@ARGV); # get any the switches $key=substr($arg,1,1); # get no-arg switches first substr($arg,0,2)=""; if($key eq 'v'){ # verbose? dunno if we'll have that. $chatty ^= 1; next; }elsif($key eq 'D'){ # Debug mode: enable ad-hoc tracers, $debug^=1; # if any next; }elsif($key eq 'S'){ # Safety mode: Do Nothing. Very Loudly. $safety^=1; # see results in the calling xterm. next; } $arg =~ s/^\=//; # handles switch=arg $arg=shift(@ARGV) if($arg eq "" and ($ARGV[0] !~ /^\-\w/) ); # if $arg eq ""; # handles space-separated switch/arg if($key eq 'x'){ # transfer-to dir $xfrto=$arg; }elsif($key eq 'm'){ # Maildir subdir to work over $mdir=$arg; }elsif($key eq 'b'){ # /home, /var/vpopmail/users... $basedir=$arg; }else{ warn "$0: unrecognized option -$key $arg\n"; } } # no commandline tail-args for this pgm. if($debug){ use Data::Dumper; } substr($src,index($src,' '),0)=" -m $mdir" unless $mdir eq 'new'; $top = MainWindow->new(); $top->title("amsFE Maildir/$mdir"); my($main_frame) = $top->Frame()->pack( -fill=>'both', -expand=>1, ); # # idxsel. # # broken out for stabbing in the dark, the index-selection # mechanism... which, apparently, requires prior deselection as # well even if our mode is supposedly 'single'. # sub idxsel { my $idx=shift(@_); my $oldidx=$ref_listbox->curselection(); $ref_listbox->selectionClear($oldidx) if defined $oldidx; $ref_listbox->selectionSet($idx); } # # hotkey_q. # # filter out keystrokes going into XFR: entry, then [Quit] # (button code is just an anon sub exit). # sub hotkey_q { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' exit; } # # hotkey_g. # # filter out keystrokes going into XFR: entry, for [Go] # sub hotkey_g { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &do_it; } # # do_it. # # big red button: execute the list and leave. # sub do_it { &xeq; exit(0); } # # hotkey_a. # # filter out keystrokes going into XFR: entry, for [Apply] # sub hotkey_a { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &do_apply; } # # do_apply. # # execute tags but don't leave. reload with new Maildir contents # for another tag-and-execute round. # sub do_apply { &xeq; &do_reload; &first_unit; } # # xeq. # # iterate the list, deleting/moving as spec'd. # uses dqrm to move stuff new -> qrm, mv otherwise. # sub xeq { my $curdir=`pwd`; chomp $curdir; # or use Cwd module (CPAN) my($idx,$fname,$user,$ddir); my $max=$ref_listbox->size()-1; # returns linecount, we need index foreach $idx (0..$max){ idxsel($idx); $fname=&get_unit_fname; print "FNAME: $fname\n" if $debug; # left in for "what's broken" scenarios my $listel = $ref_listbox->get($idx); my $user = substr($listel,$dsplen+length($lsep),$usrlen); $user =~ s/\s+$//; my $disp = substr($listel,0,length($dsp)); $disp =~ s/\s+$//; print " DISP: $disp\n" if $debug; # ...like fixed-length fields in list-elements chdir("$basedir/$user/Maildir/$mdir"); if($disp eq $moveit){ # relative/absolute detection here: $ddir= (index($xfrto,'/')>-1 ? $xfrto : "$basedir/$user/Maildir/$xfrto/"); unless(-e $ddir){ # kill this if you don't want new subdirs mkdir($ddir); # created. I have to be hastier than that. chown_by_name($ddir,$user); } # dqrm-or-not selection here: my $cmd = (($xfrto eq 'qrm' and $mdir eq 'new') ? "$dqrm $fname" : "mv $fname $ddir"); if($safety){ print "Safety: $cmd\n"; # safety == say it, don't do it. }else{ # recommended during install/edit, if only system($cmd); # because it keeps your test set intact. } }elsif($disp eq $killit){ if($safety){ print "Safety: DEL $fname\n"; }else{ unlink($fname); } } } chdir $curdir; } # # chown_by_name. # # Camel book 2e p.150 # sub chown_by_name { my($user,$pattern)=(@_); chown((getpwnam($user))[2,3],glob($pattern)); } # # FYI: Without the focus manipulations in the next callbacks, letters typed # into the XFR: Entry would be also set as tags in the listbox. Once you # click into the Entry, the focus is held there indefinitely by default, # despite mouse-clicks, so <return> is bound as a key-event to force the # focus back to the toplevel, where bound keystrokes come here as expected # and NOT into the Entry. if you click-select a line in the listbox, it # takes the focus, but tagging keystrokes still go where we want them. This # works; binding key-events to the listbox rather than to top-entry doesn't. # # The hotkey_ filters are driven by just that; they vector into callbacks # which are run by both keybindings and buttons. # # # hotkey_o. # # filter out keystrokes going into XFR: entry, for [set Ok] # sub hotkey_o { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &setunit_ok; } # # setunit_ok. # # mark email to leave as-is # sub setunit_ok { set_unit_disp($leavit); } # # hotkey_d. # # filter out keystrokes going into XFR: entry, for [set Del] # sub hotkey_d { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &setunit_del; } # # setunit_del. # # mark email as doomed # sub setunit_del { set_unit_disp($killit); } # # hotkey_m. # # filter out keystrokes going into XFR: entry, for [set Mov] # sub hotkey_m { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &setunit_mov; } # # setunit_mov. # # mark email to transfer to other dir # sub setunit_mov { set_unit_disp($moveit); } # # page-up/down is twitchy-looking because of the ->see() procedure which # scrolls things around to bring the selection into view, but all lines are # reachable. # # # prior_page. # # page-down for the listbox # sub prior_page { my $pidx=$ref_listbox->curselection(); # 0-based my $idx=$pidx->[0]; return unless defined($idx) and $idx>0; $idx -= $displines; $idx = 0 if $idx < 0; $ref_listbox->see($idx); idxsel($idx); } # # next_page. # # page-up for the listbox # sub next_page { my $pidx=$ref_listbox->curselection(); # 0-based my $idx=$pidx->[0]; my $maxl = $ref_listbox->size()-1; return unless defined($idx) and $idx != $maxl; $idx += $displines; $idx=$maxl if $idx > $maxl; $ref_listbox->see($idx); idxsel($idx); } # # first_unit. # # set selector/index to first line in listbox and keep it visible. # sub first_unit { my $idx=0; $ref_listbox->see($idx); idxsel($idx); } # # prior_unit. # # decrement the selector/index and keep it visible. # sub prior_unit { my $pidx=$ref_listbox->curselection(); # 0-based my $idx=$pidx->[0]; return if(!defined($idx) or $idx<=0); # count of rows $idx--; $ref_listbox->see($idx); idxsel($idx); } # # next_unit. # # increment the selector/index and keep it visible. # # upgrade from Tk800 Tk804: curselection returns an array now, # even when the selection mode is single. grab the first element for $idx. # --crb3 25Jun07 # sub next_unit { my $pidx=$ref_listbox->curselection(); # 0-based my $idx=$pidx->[0]; # --crb3 25Jun07: it's an array now. return if(!defined($idx) or $idx==($ref_listbox->size()-1)); # count of rows $idx++; $ref_listbox->see($idx); idxsel($idx); } # # last_unit. # # set selector/index to last line in listbox and keep it visible. # sub last_unit { my $idx=$ref_listbox->size()-1; $ref_listbox->see($idx); idxsel($idx); } # # set_unit_disp. # # update the row with the keypress's disposition character. # these are tags which will be batch-processed. # sub set_unit_disp { my($disp)=shift(@_); my $idx=$ref_listbox->curselection(); $listel = $ref_listbox->get($idx); return unless defined $listel; substr($listel,0,1)=$disp; $ref_listbox->delete($idx); $ref_listbox->insert($idx,$listel); $ref_listbox->selectionSet($idx); &next_unit; # auto-increment } # # hotkey_e. # # filter out keystrokes going into XFR: entry, for [rEvert] # sub hotkey_e { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &do_revert; } # # do_revert. # # clear all 'disp' tags to 'ok' ('-') # sub do_revert { my $cursel = $ref_listbox->curselection(); # save our place my $maxl = $ref_listbox->size()-1; &first_unit; while($ref_listbox->curselection() < $maxl){ set_unit_disp($leavit); # untag all } $ref_listbox->see($cursel); idxsel($cursel); # where we were } # # hotkey_v. # # filter out keystrokes going into XFR: entry, for [View] # sub hotkey_v { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &view_unit; } # # view_unit. # # present the selected email for viewing. only one of thee # view-windows is open at a time; opening another email # silently replaces the first in the view window. # sub view_unit { my $fn=&get_unit_fname; view_file($fn) if defined $fn; } # # get_unit_fname. # # return the filename of the email selected in the listbox # sub get_unit_fname { my $idx=$ref_listbox->curselection(); return(undef) unless defined $idx; my $listel = $ref_listbox->get($idx); my $user = substr($listel,$dsplen+length($lsep),$usrlen); $user =~ s/\s+$//; my $inode = substr($listel,$dsplen+$usrlen+(2*length($lsep)),10); $inode =~ s/\s+$//; if($debug){ # again, useful for "what broke" stuff (username > max size??) my $ruler='0123456789' x 6; print <<EOT; INODE: $inode USER: $user $ruler $listel EOT } my $subdir=lc($mdir); my $udir="$basedir/$user/Maildir/$subdir"; my $curdir=`pwd`; chomp $curdir; chdir($udir); foreach $f (<*>){ # look for the file. it might have been next unless -f $f; # deleted or moved by something cron'd already. next unless index($f,$inode)>-1; $fname=$f; last; } chdir($curdir); return("$udir/$fname"); } # # view_file. # # show the text of a file: read-only, both because it's got a smaller # footprint, and so nobody thinks this should become an editor. # sub view_file { my $file=shift(@_); if($viewer==0){ # create it if it's gone $viewer=$top->Toplevel(); # NOT my()! $viewer->iconify(); $viewer->title("amsFE: Viewing $file..."); $textbox_viewfile = $viewer->Scrolled ( 'ROText', # just a scrolled text window -scrollbars => 'osoe', -font => '-*-helvetica-Medium-R-Normal-*-*-80-*-*-*-*-*-*', -height => '12', -width => $dispmaxlen, # we want same width as listbox -background => '#f7f7d7', # with a dirty yellow tint ); my($button_viewfile_done) = $viewer->Button ( -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*', -text => 'done', # and a go-away button. ); $textbox_viewfile->grid( -in => $viewer, -column => '1', -row => '1', -sticky => 'news', ); $button_viewfile_done->grid( -in => $viewer, -column => '1', -row => '2', ); # container $frame_top (rows) $viewer->gridRowconfigure(1, -weight => 20, -minsize => 30); $viewer->gridRowconfigure(2, -weight => 0, -minsize => 30); # container $frame_top (columns) $viewer->gridColumnconfigure(1, -weight => 1, -minsize => 30); $button_viewfile_done->focus; $button_viewfile_done->configure( -command => \&viewfile_done ); }else{ $viewer->title("amsFE: Viewing $file..."); # retitle $textbox_viewfile->delete('1.0','end'); # clean out earlier text } if(open(H,"<$file")){ $filetext=join('',(<H>)); close(H); }else{ # could have been moved/deleted before we got round to it $filetext="Ooops! $file text unavailable\n"; } $textbox_viewfile->insert('end',$filetext); # now fill with this file $viewer->deiconify(); $viewer->raise(); } # # viewfile_done. # # close the file-viewer window # sub viewfile_done { $viewer->destroy; $viewer=0; } # # get_ams2list. # # stuffs ams lines into a Listbox, prepended with disposition code and # username. tuned to allmailscan's default output. did you remember to # download/install allmailscan? # # --crb3 22May07: fill in dispmaxlen, so viewer opens at same width # sub get_ams2list { my($src,$listbox)=(@_); open(A,$src) or die "can't open ams source $src\n"; while(defined($ln=<A>)){ chomp $ln; if(index($ln,'MAIL SUMMARY')>-1){ $mdir=lc(substr($ln,0,index($ln,' '))); }elsif($ln =~ /^\w+:/){ ($usr=$ln) =~ s/\:$//; $usr .= ' ' x ($usrlen - length($usr)); }else{ next if $ln =~ /^\s*$/; $ln =~ s/^\s+//; my $str = "$dsp$lsep$usr$lsep$ln"; $dispmaxlen=length($str) if length($str) > $dispmaxlen; # global $listbox->insert('end',$str); } } close(A); } # # hotkey_r. # # filter out keystrokes going into XFR: entry for [Reload] # sub hotkey_r { my $who=$ref_mdirentry->focusCurrent(); # returns a name and a hash-address return if index($who,'Entry')>-1; # like 'MainWindow=HASH(0x83b3a88)' &do_reload; } # # do_reload. # # reload the list with current Maildir contents. # not the same as reverting all 'disp' flags, not if there's new mail. # sub do_reload { $ref_listbox->delete(0,'end'); get_ams2list($src,$ref_listbox); &first_unit; } # # bind_key. # # swiped from APP's tetris demo by Sriram Srinivasan ('Sriram'), # for succinctness. # sub bind_key { my ($keychar, $callback) = @_; if ($keychar eq ' ') { $keychar = "KeyPress-space"; } $top->bind("<${keychar}>", $callback); } # # amsfe_ui. # # an admin work-window into the qmail system's Maildirs, by # default showing /home/*/Maildir/new. # # this tool cuts down on the effort required to clean up # spams that get through the filtering, and machine-sent # email reports from things like firewalls. # # interface generated by SpecTix (Perl enabled) version 1.2 # from amsfe.ui # For use with Tk400.202, using the gridbag geometry manager # sub amsfe_ui { my($root) = @_; my $buttonfont='-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*'; # widget creation my($frame_button) = $root->Frame ( ); my($frame_top) = $root->Frame ( ); my($label_amsfe) = $root->Label ( -font => '-*-lucidabright-Medium-R-Normal-*-*-160-*-*-*-*-*-*', -text => 'amsFE', ); my($label_maildir) = $root->Label ( -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*', -text => 'Maildir: ', ); my($label_mdir) = $root->Label ( -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*', -textvariable => \$mdir, ); my($label_disp) = $root->Label ( -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*', -text => 'XFR: ', ); my($entry_xfrdir) = $root->Entry ( -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*', -width => '40', -textvariable => \$xfrto, -background => 'white', ); $ref_mdirentry=$entry_xfrdir; my($listbox_mainlist) = $root->Scrolled ( 'Listbox', -font => '-*-courier-Medium-R-Normal-*-*-80-*-*-*-*-*-*', -height => $displines, -width => '0', -selectmode => 'single', -background => 'white', ); $ref_listbox=$listbox_mainlist; my($button_reload) = $root->Button ( -font => $buttonfont, -text => 'Reload', -command => \&do_reload, ); my($button_revert) = $root->Button ( -font => $buttonfont, -text => 'rEvert', -command => \&do_revert, ); my($button_ok) = $root->Button ( -font => $buttonfont, -text => 'Go', -command => \&do_it ); my($button_cancel) = $root->Button ( -font => $buttonfont, -text => 'Quit', -command => sub{ exit(0); } ); my($button_apply) = $root->Button ( -font => $buttonfont, -text => 'Apply', -command => \&do_apply, ); my($button_setM) = $root->Button ( -font => $buttonfont, -text => 'set Mov', -command => \&setunit_mov, ); my($button_setK) = $root->Button ( -font => $buttonfont, -text => 'set Del', -command => \&setunit_del, ); my($button_setO) = $root->Button ( -font => $buttonfont, -text => 'set Ok', -command => \&setunit_ok, ); my($button_doV) = $root->Button ( -font => $buttonfont, -text => 'View', -command => \&view_unit, ); # Geometry management $frame_button->grid( -in => $root, -column => '1', -row => '3', -sticky => 'ew', ); $frame_top->grid( -in => $root, -column => '1', -row => '1', -sticky => 'ew', ); $label_amsfe->grid( -in => $frame_top, -column => '1', -row => '1', -sticky => 'w', ); $label_maildir->grid( -in => $frame_top, -column => '3', -row => '1', -sticky => 'e' ); $label_mdir->grid( -in => $frame_top, -column => '4', -row => '1', -sticky => 'w' ); $label_disp->grid( -in => $frame_top, -column => '6', -row => '1', -sticky => 'e' ); $entry_xfrdir->grid( -in => $frame_top, -column => '7', -row => '1', -sticky => 'w' ); $listbox_mainlist->grid( -in => $root, -column => '1', -row => '2', -sticky => 'nesw' ); $button_reload->grid( -in => $frame_button, -column => '1', -row => '1' ); $button_revert->grid( -in => $frame_button, -column => '2', -row => '1' ); $button_ok->grid( -in => $frame_button, -column => '3', -row => '1' ); $button_apply->grid( -in => $frame_button, -column => '4', -row => '1' ); $button_cancel->grid( -in => $frame_button, -column => '5', -row => '1' ); $button_setO->grid( -in => $frame_button, -column => '7', -row => '1' ); $button_setM->grid( -in => $frame_button, -column => '8', -row => '1' ); $button_setK->grid( -in => $frame_button, -column => '9', -row => '1' ); $button_doV->grid( -in => $frame_button, -column => '10', -row => '1' ); # Resize behavior management # container $root (rows) $root->gridRowconfigure(1, -weight => 1, -minsize => 30); $root->gridRowconfigure(2, -weight => 10, -minsize => 30); $root->gridRowconfigure(3, -weight => 1, -minsize => 30); # container $root (columns) $root->gridColumnconfigure(1, -weight => 1, -minsize => 300); # container $frame_top (rows) $frame_top->gridRowconfigure(1, -weight => 0, -minsize => 30); # container $frame_top (columns) $frame_top->gridColumnconfigure(1, -weight => 0, -minsize => 50); $frame_top->gridColumnconfigure< |