Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | magnus | 1 | #!/usr/bin/perl |
2 | # ---------------------------------------------------------------------- |
||
3 | # Copyright (C) 2005 Mark Lawrence <nomad@null.net> |
||
4 | # |
||
5 | # This program is free software; you can redistribute it and/or modify |
||
6 | # it under the terms of the GNU General Public License as published by |
||
7 | # the Free Software Foundation; either version 2 of the License, or |
||
8 | # (at your option) any later version. |
||
9 | # ---------------------------------------------------------------------- |
||
10 | # greylistclean - remove expired SA-Exim greylist entries from the filesystem. |
||
11 | # |
||
12 | # This is basically a perl implementation of the old shell commands that |
||
13 | # used to be shipped with sa-exim, combined with simple syslog reporting. |
||
14 | # This perl script cleans old tuplets and directories in |
||
15 | # /var/spool/sa-exim/tuplets/ |
||
16 | # |
||
17 | # You can call this script with '-v' to see what files and |
||
18 | # directories are being removed (sent to STDERR). |
||
19 | # Otherwise during normal operation there is no output. |
||
20 | # |
||
21 | # To use this in production you either: |
||
22 | # 1. Copy this file to your cron.hourly directory if you accept the risk of |
||
23 | # running this script as root (it is uncessary) |
||
24 | # or |
||
25 | # 2. Copy this file to /usr/local/bin and create a crontab entry |
||
26 | # that looks something like the following (this works on Debian): |
||
27 | # |
||
28 | # 33 * * * * debian-exim /usr/local/bin/greylistclean |
||
29 | # ^^^^^^^^^^^ |
||
30 | # (a) |
||
31 | # (a) find out under which user tuplets are created, it could be mail, exim |
||
32 | # or something else depending on your system ("debian-exim" on debian) |
||
33 | # |
||
34 | # Changelog |
||
35 | # --------- |
||
36 | # 2005-02-14 Original version. Mark Lawrence <nomad@null.net> |
||
37 | # 2005-02-21 Added example cron entry comment. Mark Lawrence <nomad@null.net> |
||
38 | # 2006-01-09 Added a few comments on how to run without root, inclusion in |
||
39 | # sa-exim / verbose is -v ( -d would be debug ) |
||
40 | # |
||
41 | # ---------------------------------------------------------------------- |
||
42 | use strict; |
||
43 | use warnings; |
||
44 | use Sys::Syslog; |
||
45 | use File::Find; |
||
46 | use File::stat; |
||
47 | |||
48 | my $tuplet_dir = '/var/spool/sa-exim/tuplets'; |
||
49 | |||
50 | my $max_grey_age = 60*60*24*2; # seconds to keep greylisted entries (2 days) |
||
51 | my $max_age = 60*60*24*14; # seconds to keep all entries (14 days) |
||
52 | |||
53 | my $tcount = 0; # total number of tuplets |
||
54 | my $rm_tcount = 0; # number of tuplets removed |
||
55 | |||
56 | my $dircount = 0; # total number of directories |
||
57 | my $rm_dircount = 0; # number of directories removed |
||
58 | |||
59 | my @empty_dirs = (); # list of empty directories |
||
60 | |||
61 | my $verbose = 0; |
||
62 | my $now = time(); |
||
63 | |||
64 | |||
65 | if (@ARGV == 1 and $ARGV[0] eq '-v') { |
||
66 | $verbose = 1; |
||
67 | print STDERR "$0 running at $now\n" |
||
68 | } |
||
69 | |||
70 | |||
71 | # |
||
72 | # Open the reporting channel |
||
73 | # |
||
74 | openlog('sa-exim', 'pid,ndelay', 'mail'); |
||
75 | |||
76 | # |
||
77 | # Process the tuplets |
||
78 | # |
||
79 | find({wanted => \&prune, postprocess => \&dircheck}, $tuplet_dir); |
||
80 | |||
81 | syslog('info', 'Removed %d of %d greylist tuplets in %d seconds', $rm_tcount, |
||
82 | $tcount, time() - $now); |
||
83 | |||
84 | # |
||
85 | # Remove empty directories found by dircheck() |
||
86 | # |
||
87 | $now = time(); |
||
88 | |||
89 | foreach my $dir (@empty_dirs) { |
||
90 | rmdir $dir && $rm_dircount++; |
||
91 | $verbose && print STDERR "removed empty directory $dir\n"; |
||
92 | } |
||
93 | |||
94 | syslog('info', 'Removed %d of %d greylist directories in %d seconds', |
||
95 | $rm_dircount, $dircount, time() - $now); |
||
96 | |||
97 | closelog(); |
||
98 | exit; |
||
99 | |||
100 | |||
101 | |||
102 | # |
||
103 | # Called from File::Find::find() function with $_ set to filename/directory. |
||
104 | # Search for the line 'Status: Greylisted' in files modified more than |
||
105 | # $max_grey_age seconds ago and remove the files that contain it. |
||
106 | # Remove any entry that is older than $max_age seconds ago. |
||
107 | # |
||
108 | sub prune { |
||
109 | return if (-d $_); # we don't do directories |
||
110 | $tcount++; |
||
111 | |||
112 | my $file = $_; |
||
113 | my $sb = stat($file); |
||
114 | my $age = $now - $sb->mtime; |
||
115 | |||
116 | # |
||
117 | # Remove all old entries (older than $max_age) |
||
118 | # |
||
119 | if ($age > $max_age) { |
||
120 | $verbose && print STDERR 'removing old entry ', |
||
121 | "${File::Find::dir}/$file (age: ", |
||
122 | $now - $sb->mtime, " seconds)\n"; |
||
123 | unlink($file); |
||
124 | $rm_tcount++; |
||
125 | return; |
||
126 | } |
||
127 | |||
128 | # |
||
129 | # Do nothing if not old enough to expire |
||
130 | # |
||
131 | return if ($age < $max_grey_age); |
||
132 | |||
133 | # |
||
134 | # Check if this tuplet has been 'greylisted'. Use the 3 argument |
||
135 | # form of 'open', because a lot of these files have funny characters |
||
136 | # in their names. |
||
137 | # |
||
138 | if (!open(FH, '<', $file)) { |
||
139 | print STDERR "Could not open ${File::Find::name}: $!\n"; |
||
140 | return; |
||
141 | } |
||
142 | |||
143 | while (my $line = <FH>) { |
||
144 | if ($line =~ /^Status: Greylisted$/) { |
||
145 | $verbose && print STDERR 'removing greylisted ', |
||
146 | "${File::Find::dir}/$file (age: ", |
||
147 | $now - $sb->mtime, " seconds)\n"; |
||
148 | unlink($file); |
||
149 | $rm_tcount++; |
||
150 | last; |
||
151 | } |
||
152 | } |
||
153 | |||
154 | close FH; |
||
155 | } |
||
156 | |||
157 | |||
158 | # |
||
159 | # Called from File::Find::find() function when all entries in a directory |
||
160 | # have been processed. We check if there are any files left in the directory |
||
161 | # and if not then add it to a list for later deletion |
||
162 | # |
||
163 | sub dircheck { |
||
164 | return if ($File::Find::dir eq $tuplet_dir); # don't check top dir. |
||
165 | $dircount++; |
||
166 | |||
167 | # |
||
168 | # Check if directory is empty and add to $empty_dirs hash |
||
169 | # |
||
170 | if (opendir(DIR, $File::Find::dir)) { |
||
171 | my $files = grep {!/^\./} readdir(DIR); |
||
172 | if ($files == 0) { |
||
173 | push(@empty_dirs, $File::Find::dir); |
||
174 | } |
||
175 | closedir(DIR); |
||
176 | } |
||
177 | } |