#!/usr/local/bin/perl

# $Header: /mhub4/sources/imap-tools/purgeMbx.pl,v 1.2 2010/06/15 15:03:51 rick Exp $

############################################################################
#   Program name    purgeMbx.pl                                            #
#   Written by      Rick Sanders                                           #
#   Date            5/24/2008                                              #
#                                                                          #
#   Description                                                            #
#                                                                          #
#   This script deletes all of the messages in a user's IMAP               #
#   mailbox.                                                               #
#                                                                          #
#   purgeMbx.pl is called like this:                                       #
#       ./purgeMbx.pl -s host/user/password -m <mailbox>                   # 
#                                                                          #
#   Note that the mailbox name is case-sensitive.                          #
#                                                                          #
#   Optional arguments:                                                    #
#	-d debug                                                           #
#       -L <logfile>                                                       #
############################################################################

############################################################################
# Copyright (c) 2008 Rick Sanders <rfs9999@earthlink.net>                  #
#                                                                          #
# Permission to use, copy, modify, and distribute this software for any    #
# purpose with or without fee is hereby granted, provided that the above   #
# copyright notice and this permission notice appear in all copies.        #
#                                                                          #
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES #
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         #
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  #
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   #
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    #
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  #
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           #
############################################################################

use Socket;
use FileHandle;
use Fcntl;
use Getopt::Std;
use IO::Socket;
use IMAP::Utils;

#################################################################
#            Main program.                                      #
#################################################################

   init();

   sigprc();

   #  Get list of all messages on the source host by Message-Id
   #
   connectToHost($host, \$conn);
   login($user,$pwd, $conn);

   Log("Purging the \"$mbx\" mailbox");
   @sourceMsgs = ();
   getMsgList( $mbx, \@msgs, $conn ); 
   Log("$mbx mailbox is empty") unless @msgs;
   foreach $msgnum ( @msgs ) {
     $total++;
     deleteMsg( $msgnum, $conn );
   }
   expungeMbx( $mbx, $conn ) if @msgs;

   Log("$total messages were deleted from \"$mbx\" mailbox");

   logout( $conn );

   exit;


sub init {

   $version = 'V1.0.1';
   $os = $ENV{'OS'};

   processArgs();

   $timeout = 60 unless $timeout;

   IMAP::Utils::init();

   #  Open the logFile
   #
   if ( $logfile ) {
      openLog($logfile);
   }
   Log("\n$0 starting");
   $total=0;

}

sub usage {

   print STDOUT "usage:\n";
   print STDOUT " iu-purge -S host/user/pwd -m <mbx>\n";
   print STDOUT " Optional arguments:\n";
   print STDOUT "    -d debug\n";
   print STDOUT "    -L <logfile>\n";
   exit;

}

sub processArgs {

   if ( !getopts( "dIs:L:m:h" ) ) {
      usage();
   }

   ($host,$user,$pwd) = split(/\//, $opt_s);

   $mbx = $opt_m;
   $logfile = $opt_L;
   $debug = $showIMAP = 1 if $opt_d;
   $showIMAP = 1 if $opt_I;
   usage() if $opt_h;

}

sub dieright {
   local($sig) = @_;
   print STDOUT "caught signal $sig\n";
   logout( $conn );
   exit(-1);
}

sub sigprc {

   $SIG{'HUP'} = 'dieright';
   $SIG{'INT'} = 'dieright';
   $SIG{'QUIT'} = 'dieright';
   $SIG{'ILL'} = 'dieright';
   $SIG{'TRAP'} = 'dieright';
   $SIG{'IOT'} = 'dieright';
   $SIG{'EMT'} = 'dieright';
   $SIG{'FPE'} = 'dieright';
   $SIG{'BUS'} = 'dieright';
   $SIG{'SEGV'} = 'dieright';
   $SIG{'SYS'} = 'dieright';
   $SIG{'PIPE'} = 'dieright';
   $SIG{'ALRM'} = 'dieright';
   $SIG{'TERM'} = 'dieright';
   $SIG{'URG'} = 'dieright';
}

#  getMailboxList
#
#  get a list of the user's mailboxes
#
sub getMailboxList {

my $conn = shift;
my @mbxs;
my $mbx;

   #  Get a list of the user's mailboxes
   #
   Log("Get list of user's mailboxes") if $debug;

   sendCommand ($conn, "1 LIST \"\" *");
   undef @response;
   while ( 1 ) {
	$response = readResponse ($conn);
	if ( $response =~ /^1 OK/i ) {
		last;
	}
	elsif ( $response !~ /^\*/ ) {
		Log ("unexpected response: $response");
		return 0;
	}
   }

   undef @mbxs;
   for $i (0 .. $#response) {
	$response[$i] =~ s/\s+/ /;
	($dmy,$mbx) = split(/"\/"/,$response[$i]);
	$mbx =~ s/^\s+//;  $mbx =~ s/\s+$//;
	$mbx =~ s/"//g;

	if ($response[$i] =~ /NOSELECT/i) {
		if ($debugMode) { Log("$mbx is set NOSELECT,skip it",2); }
		next;
	}
	if ($mbx =~ /^\./) {
		# Skip mailboxes starting with a dot
		next;
	}
	push ( @mbxs, $mbx ) if $mbx ne '';
   }

   return @mbxs;
}

