lists.def blocks http mboxes, unused otherwise
[mharc.git] / bin / filter-spool
1 #!/usr/bin/perl
2 ##--------------------------------------------------------------------------##
3 ##  File:
4 ##      $Id: filter-spool,v 1.11 2002/09/27 05:01:07 ehood Exp $
5 ##  Description:
6 ##      Script to grab mail spool and filter mail to raw mbox archives.
7 ##--------------------------------------------------------------------------##
8 ##  Copyright (C) 2002  Earl Hood <earl@earlhood.com>
9 ##
10 ##  This program is free software; you can redistribute it and/or modify
11 ##  it under the terms of the GNU General Public License as published by
12 ##  the Free Software Foundation; either version 2 of the License, or
13 ##  (at your option) any later version.
14 ##  
15 ##  This program is distributed in the hope that it will be useful,
16 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ##  GNU General Public License for more details.
19 ##  
20 ##  You should have received a copy of the GNU General Public License
21 ##  along with this program; if not, write to the Free Software
22 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ##  02111-1307, USA
24 ##--------------------------------------------------------------------------##
25
26 package MHArc::filter_spool;
27
28 ##--------------------------------------------------------------------------##
29 # <x-boot-strap>
30 BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); }
31 my $Dir; BEGIN { $Dir = `dirname $0`; chomp $Dir; }
32 use lib "$Dir/../lib";  # Add relative lib to search path
33 # </x-boot-strap>
34 ##--------------------------------------------------------------------------##
35 # <x-config>
36 use MHArc::Config;
37 my $config = MHArc::Config->load("$Dir/../lib/config.sh");
38 # </x-config>
39 ##--------------------------------------------------------------------------##
40
41
42 use Getopt::Long;
43 use MHArc::Util qw( cmd run_prg usage );
44
45 my @_term_sigs  = qw(
46     ABRT ALRM BUS FPE HUP ILL INT IOT PIPE POLL PROF QUIT SEGV
47     TERM TRAP USR1 USR2 VTALRM XCPU XFSZ
48 );
49
50 my $Procmail = $config->{'PROCMAIL'} || 'procmail';
51 my $Lockfile = $config->{'LOCKFILE'} || 'lockfile';
52 my $Formail  = $config->{'FORMAIL'}  || 'formail';
53
54 my $TmpSpool     = '.newmail';
55 my $TmpSpoolLock = $TmpSpool.'.lock';
56
57 MAIN: {
58   # Make sure umask is set to make things readable by default
59   umask 022;
60
61   # Grap command-line options
62   my %opt = ( );
63   my $clstatus = GetOptions(\%opt,
64     'verbose!',
65     'home=s',
66     'html-dir=s',
67     'is-spool!',
68     'log-dir=s',
69     'lock-timeout=i',
70     'mail=s',
71     'mbox-dir=s',
72     'procmailrc=s',
73     'procmailvars=s',
74
75     'help',
76     'man',
77   );
78   usage(0) unless $clstatus;
79   usage(1) if $opt{'help'};
80   usage(2) if $opt{'man'};
81
82   my $verbose = $opt{'verbose'};
83   if ($verbose) {
84     $MHArc::Util::ECHO_CMDS = 1;
85   }
86
87   my $home              = $opt{'home'} ||
88                                 $config->{'SW_ROOT'} ||
89                                 "$Dir/..";
90   my $html_dir          = $opt{'html-dir'} ||
91                                 $config->{'HTML_DIR'} ||
92                                 join('/', $home, 'html');
93   my $log_dir           = $opt{'log-dir'} ||
94                                 $config->{'LOG_DIR'} ||
95                                 join('/', $home, 'log');
96   my $mbox_dir          = $opt{'mbox-dir'} ||
97                                 $config->{'MBOX_DIR'} ||
98                                 join('/', $home, 'mbox');
99   my $procmailrc        = $opt{'procmailrc'} ||
100                                 $config->{'PROCMAILRC'} ||
101                                 join('/', $home, 'procmailrc.mharc');
102   my $procmailvars      = $opt{'procmailvars'} ||
103                                 $config->{'PROCMAILVARS'} ||
104                                 "";
105   my $mail              = $opt{'mail'} ||
106                                 $config->{'ORGMAIL'} ||
107                                 join('/', '/var/mail', $ENV{'LOGNAME'});
108   my $is_spool          = $opt{'is-spool'} ||
109                                 $config->{'IS_MAIL_SPOOL'} ||
110                                 1;
111   my $lock_to           = $opt{'lock-timeout'} ||
112                                 $config->{'ORGMAIL_LOCK_TIMEOUT'} ||
113                                 3600;
114
115   die qq/ERROR: "$home" not a directory/
116       if (! -d $home);
117   die qq/ERROR: Unable to change directory to "$home": $!/
118       unless chdir($home);
119
120   # Make sure certain directories exist
121   cmd('mkdir', '-p', $log_dir, $mbox_dir, $html_dir);
122
123   # Check that we have data to process
124   my $have_spool = 1;
125   if ((! -e $mail) || ((stat($mail))[7] == 0)) {
126     $have_spool = 0;
127     if (! -e $TmpSpool) {
128       print qq/"$mail" does not exist or is zero bytes/  if $verbose;
129       exit 1;
130     }
131     print qq/No new mail, but $TmpSpool exists\n/  if $verbose;
132   }
133
134   if (cmd("$Lockfile -r5 -l$lock_to $TmpSpoolLock 2>/dev/null") != 0) {
135     print qq/Unable to obtain lock, exiting/  if $verbose;
136     exit 1;
137   }
138
139   eval {
140     local @SIG{@_term_sigs} = (\&clean_lock) x scalar(@_term_sigs);
141     if ($have_spool) {
142       if ($is_spool) {
143         run_prg($Lockfile, "-l$lock_to", '-ml');
144       } else {
145         run_prg($Lockfile, "-l$lock_to", "$mail.lock");
146       }
147       if (cmd("/bin/cat '$mail' >>$TmpSpool") == 0) {
148         cmd("/bin/cat /dev/null >'$mail'");
149       }
150       if ($is_spool) {
151         cmd($Lockfile, '-mu');
152       } else {
153         unlink("$mail.lock") ||
154             warn qq/Warning: Unable to remove "$mail.lock": $!\n/;
155       }
156     }
157
158     if (cmd("$Formail -s $Procmail $procmailrc $procmailvars <$TmpSpool")
159                 == 0) {
160       unlink($TmpSpool) ||
161           warn qq/Warning: Unable to remove "$TmpSpool"\n/;
162     }
163   };
164   clean_lock();
165   if ($@) {
166     die $@, "\n";
167   }
168
169 } # End: MAIN
170
171 ##---------------------------------------------------------------------------##
172
173 sub clean_lock {
174   unlink($TmpSpoolLock);
175 }
176
177 ##---------------------------------------------------------------------------##
178 __END__
179
180 =head1 NAME
181
182 filter-spool - Filter incoming mail into raw archives
183
184 =head1 SYNOPSIS
185
186   filter-spool
187   filter-spool [options]
188
189 =head1 DESCRIPTION
190
191 This program is part of mharc and has the responsibility of filtering
192 incoming mail into the raw message archives.  This script is called
193 by the L<read-mail|read-mail> script before L<web-archive|web-archive>
194 is invoked.
195
196 =head1 OPTIONS
197
198 This program is generally called without any command-line options
199 since it will read C<E<lt>mharc-rootE<gt>/lib/config.sh> for all configurable
200 options.  However, the following command-line options are
201 available:
202
203 =over
204
205 =item C<-help>
206
207 Print out usage information.
208
209 =item C<-home> I<pathname>
210
211 Root pathname of archiving software and data.  If not specified,
212 C<SW_ROOT> variable in C<config.sh> is used, else the parent directory
213 that contains this program is used.
214
215 =item C<-html-dir> I<pathname>
216
217 Root pathname containing HTML archives.  If not specified,
218 C<MBOX_DIR> variable in C<config.sh> is used, else C<I<-home>/html>
219 is used.
220
221 B<Note:> This program does not do any processing of the HTML archives.
222 This option is used to insure that the HTML archive root directory
223 exists for subsequent processing by other mharc scripts.
224
225 =item C<-is-spool>
226
227 Specifies that C<-mail> represents a mail spool file.  If not
228 specified, the value of the C<IS_MAIL_SPOOL> variable in C<config.sh>
229 is used, else C<-mail> is assumed to be a mail spool file.
230
231 =item C<-lock-timeout> I<seconds>
232
233 The age of a lock before it is forceably removed.  This is used
234 to help deal with stale locks.
235
236 If this option is not specified, C<ORGMAIL_LOCK_TIMEOUT> variable in
237 C<config.sh> is used, else C<3600> is used.
238
239 =item C<-log-dir> I<pathname>
240
241 Root pathname to place log files.  If not specified,
242 C<LOG_DIR> variable in C<config.sh> is used, else C<I<-home>/log>
243 is used.
244
245 =item C<-mail> I<pathname>
246
247 Pathname to incoming mailbox file.
248 If not specified, C<ORGMAIL> variable in C<config.sh> is used,
249 else C</var/mail/$LOGNAME> is used, where C<$LOGNAME> represents the
250 value of the C<LOGNAME> environment variable.
251
252 =item C<-man>
253
254 Print out entire manpage.
255
256 =item C<-mbox-dir> I<pathname>
257
258 Root pathname containing raw mailbox archives.  If not specified,
259 C<MBOX_DIR> variable in C<config.sh> is used, else C<I<-home>/mbox>
260 is used.
261
262 =item C<-procmailrc> I<pathname>
263
264 Pathname to procmailrc file to use when filtering mail.
265 If not specified, C<PROCMAILRC> variable in C<config.sh> is used,
266 else C<I<-home>/procmailrc.mharc> is used.
267
268 =item C<-procmailvars> I<variable-list>
269
270 Additional variables to pass into C<procmail>.
271 If not specified, C<PROCMAILVARS> variable in C<config.sh> is used.
272
273 =item C<-verbose>
274
275 Print out status messages.
276
277 =back
278
279 =head1 EXIT VALUES
280
281 If there was mail to process, and no errors occurred during processing,
282 a zero exit status will be returned.  Otherwise, a non-zero exit status
283 will be returned.
284
285 =head1 FILES
286
287 =over
288
289 =item C<E<lt>mharc-rootE<gt>/lib/config.sh>
290
291 Main configuration file for mharc.
292
293 =back
294
295 =head1 VERSION
296
297 $Id: filter-spool,v 1.11 2002/09/27 05:01:07 ehood Exp $
298
299 =head1 AUTHOR
300
301 Earl Hood, earl@earlhood.com
302
303 This program is part of the mharc archiving system and comes with
304 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
305 the GNU General Public License, which may be found in the mharc
306 distribution.
307
308 =cut
309