Subject: Automated IMAP Expunge

From: Travis Beal <[email-masked]>
Date: Thu, 02 Oct 2003 10:19:36 -0400

I solved the automated expunge problem this way.
1.  Create user postmaster.
2.  Create group mailadm.  Anyone in this group can work with user's
IMAP folders.
3.  Add postmaster to group mailadm.
4.  Run script 1 as cron job.  Script 1 shuts down mail and web
services, generates a list of mailbox lists to process, calls the
processing script, deletes the list of mailbox lists, and then restarts
all services.  Script 2 expunges all messages marked for deletion from
IMAP folders and the regular /var/spool/mail inbox.  It also moves
messages in the Sent folder more than N days old to the trash.

As you may expect, there is no guarantee that this will work for anyone
else.  It works on my system, but it should be used on other systems at
one's own peril.  It may cause data loss, mail corruption, and a plague
of locusts o'er the land.  I accept no responsibility for this script
other than use on my own system.

SCRIPT 1
--------------
#!/bin/bash
#This script, run as a cron job, will expurge messages marked for
deletion from IMAP mailboxes.
#The Perl script below does the actual expurging.
#Version 1.0     26 Sept 03
#broadcast stop
echo 'Starting purge of folders.'
date

#stop internet services
/etc/init.d/httpd stop
/etc/init.d/sendmail stop

#generate list of IMAP mailboxes
ls /home/*/.mailboxlist > /root/listofmailboxlists

#Perl purge
/root/purge_folders_perl

#start services
/etc/init.d/sendmail start
/etc/init.d/httpd start

#remove the list
rm -rf /root/listofmailboxlists

#broadcast
echo 'Purge of folders complete.'
date

************************
SCRIPT 2
------------------
#!/usr/bin/perl
#get the Perl tools
use Mail::IMAPClient;
use Date::Manip;

#this is the perl script that purges the folders.  Works with
purge_imap_folders
print "Entering Perl section.....\n";

#variables
$AGE = 60;  #how many days a message may stay in Sent

#read only open this list of mailbox lists
open (LISTOFMAILBOXLISTS, "<listofmailboxlists");

#go through file
while(<LISTOFMAILBOXLISTS>){
       #load next line in file
       chop;
       #parse out next data file
    ($mailboxlisttoscan) = $_;
    ($file_prefix,$junk) = split (/\/.mailbox/,$mailboxlisttoscan);
    ($trash, $user_name) = split (/ome\//,$file_prefix);
       # (returns a new, authenticated Mail::IMAPClient object)
    $host = "localhost";
       $id = "$user_name*postmaster"; #logging in with postmaster for
admin
    $pass = "XXXXXXXXXXXXXXX";  #postmasters password
       $imap = Mail::IMAPClient->new(  
                       Server => $host,
                       User    => $id,
                       Password=> $pass,
       )       or die "Cannot connect to $host as $id: $@";

    #expunge the normal mail spool
    $imap->expunge("/var/spool/mail/$user_name") or die "Could not
expunge: $@\n";

    #read only open this mailbox lists
    open (MAILBOXLIST, "<$mailboxlisttoscan");
    #go through this list
    while(<MAILBOXLIST>){
            #load next line in file
            chop;
         $mailboxtopurge = $_;
               $folder_to_expunge = "$file_prefix/$mailboxtopurge";
         #check to see if this is Sent
         $sentcheck = index($mailboxtopurge,"Sent"); 
         $truthcheck = ($sentcheck != -1);  #kluge, but it works
         if ($truthcheck != 1) {
         #if not Sent folder, expurge normally
              #determine if the file exists
              if (-e "$folder_to_expunge"){
              #if it exists, expunge it
              $imap->expunge($folder_to_expunge) 
               }  #end of exists check if
              else {print "$folder_to_expunge does not exist.\n";}
              }  #end of exists check else
         else {
         #if the folder is Sent, then clean it out
         #determine where the trash is
         #chop Sent off folder location
               ($trash_location,$junk) =
split(/\/Sent/,$folder_to_expunge);
               $trash_location = "$trash_location/Trash";

               #return message ID numbers
               $imap->Uid(1);
               #select this folder
               $imap->select("$folder_to_expunge") or die "cannot select
the Sent folder for $user_name: $@\n";
               #calculate cutoff date
               #figure out today in seconds
               $right_now = time;
               #subtract the age difference in seconds
               $cutoff_date = $right_now - ($AGE * 24 * 3600);
              #convert to RFC2060 format
		$Rfc2060_date = $imap->Rfc2060_date($cutoff_date);
		#fetch all messages before that time
               @message_list = $imap->search("before",$Rfc2060_date) or
warn "No messages found before $Rfc2060_date.\n";
               #how many messages are in the list
               $number_of_messages = @message_list;
               #pack this list to the trash
               for($counter = 0; $counter < $number_of_messages;
$counter++)
               {
               $msg_id = @message_list[$counter];
               my $yes = $imap->move($trash_location,$msg_id);
            #see if the move was successful
               if ($yes) {
                  #If we successfully moved it, then delete it from Sent
                      $imap->delete_message($msg);
                  }  #end of if to see if we moved
                } #end of for loop
 		  #now expunge the Sent folder
                $imap->expunge($folder_to_expunge) or warn "Could not
expunge: $folder_to_expunge\n";
          }  #end of else
    }  #end of mailboxlists while
    close (MAILBOXLIST);
    #close the connection
    $imap->disconnect;
}  #end of listofmailboxlists while
close (LISTOFMAILBOXLISTS); 

print "Exiting Perl section.\n";

-- 
------------------------------------------------------------------
 For information about this mailing list, and its archives, see: 
 http://www.washington.edu/imap/c-client-list.html
------------------------------------------------------------------