Welcome, guest | Sign In | My Account | Store | Cart

This script was written before I found out about the Cyrus "ipurge" command. It connects to a Cyrus IMAP server as the administrator, finds all Trash folders and deletes all messages older than 1 day based on the Received date. Requires JavaMail's mail.jar and activation.jar in the classpath.

Tcl, 49 lines
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
#!/bin/env jaclsh
set mailhost mymailserver.lan
set username cyrus
set password "*******"

package require java

java::import java.util.Properties
java::import javax.mail.Folder

set props [java::new Properties]
$props put mail.debug true
set ses [java::call javax.mail.Session getInstance $props]
set store [$ses getStore imap]
$store connect $mailhost $username $password

set delFlag [java::field {javax.mail.Flags$Flag} DELETED]
set cal [java::call java.util.Calendar getInstance]
$cal add [java::field java.util.Calendar DAY_OF_MONTH] -1
set yesterday [$cal getTime]
unset cal

set folderArr [[$store getDefaultFolder] list "user.*.Trash"]
for {set fi 0} {$fi < [$folderArr length]} {incr fi} {
    set f [java::cast com.sun.mail.imap.IMAPFolder [$folderArr get $fi]]
    set acls [$f getACL]
    if {[$acls length] < 2} {
        if {![info exists cyracl]} {
            set cyracl [java::new com.sun.mail.imap.ACL $username \
                    [[$acls get 0] getRights] ]
        }
        $f addACL $cyracl
    }
    $f open [java::field Folder READ_WRITE]
    puts "Folder: [$f getFullName]: [$f getMessageCount] messages"
    for {set mi 1} {$mi <= [$f getMessageCount]} {incr mi} {
        set msg [$f getMessage $mi]
        if {[$yesterday compareTo [$msg getReceivedDate]] >= 0} {
            puts "OLD MSG:"
            puts "- Subject: [$msg getSubject]"
            puts "- Received: [[$msg getReceivedDate] toString]"
            $msg setFlag $delFlag true
            puts "- Now marked as deleted."
        }
    }
    $f close true
    puts "... Expunged folder [$f getFullName]"
    unset f
}

Makes several assumptions about the folder names, based on the Cyrus folder heirarchy and separators. You will definitely need to alter the "set folderArr" line on other IMAP servers.

It also has a section to add an ACL entry so that the administrator (cyrus) can open the user's Trash folder in r/w mode. (search for "cyracl"). Other mail servers may not require this -- comment out or remove the whole if $acls length Makes several assumptions about the folder names, based on the Cyrus folder heirarchy and separators. You will definitely need to alter the "set folderArr" line on other IMAP servers.

It also has a section to add an ACL entry so that the administrator (cyrus) can open the user's Trash folder in r/w mode. (search for "cyracl"). Other mail servers may not require this -- comment out or remove the whole if $acls length

Created by D. J. Hagberg on Thu, 10 Nov 2005 (MIT)
Tcl recipes (162)
D. J. Hagberg's recipes (1)

Required Modules

  • (none specified)

Other Information and Tasks