Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | ##---------------------------------------------------------------------------## |
2 | ## File: | |
3 | ## $Id: mhamain.pl,v 2.50.2.1 2002/12/22 00:43:56 ehood Exp $ | |
4 | ## Author: | |
5 | ## Earl Hood mhonarc@mhonarc.org | |
6 | ## Description: | |
7 | ## Main library for MHonArc. | |
8 | ##---------------------------------------------------------------------------## | |
9 | ## MHonArc -- Internet mail-to-HTML converter | |
10 | ## Copyright (C) 1995-2002 Earl Hood, mhonarc@mhonarc.org | |
11 | ## | |
12 | ## This program is free software; you can redistribute it and/or modify | |
13 | ## it under the terms of the GNU General Public License as published by | |
14 | ## the Free Software Foundation; either version 2 of the License, or | |
15 | ## (at your option) any later version. | |
16 | ## | |
17 | ## This program is distributed in the hope that it will be useful, | |
18 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ## GNU General Public License for more details. | |
21 | ## | |
22 | ## You should have received a copy of the GNU General Public License | |
23 | ## along with this program; if not, write to the Free Software | |
24 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
25 | ## 02111-1307, USA | |
26 | ##---------------------------------------------------------------------------## | |
27 | ||
28 | package mhonarc; | |
29 | ||
30 | require 5; | |
31 | ||
32 | $VERSION = '2.5.14'; | |
33 | $VINFO =<<EndOfInfo; | |
34 | MHonArc v$VERSION (Perl $] $^O) | |
35 | Copyright (C) 1995-2002 Earl Hood, mhonarc\@mhonarc.org | |
36 | MHonArc comes with ABSOLUTELY NO WARRANTY and MHonArc may be copied only | |
37 | under the terms of the GNU General Public License, which may be found in | |
38 | the MHonArc distribution. | |
39 | EndOfInfo | |
40 | ||
41 | $CODE = 0; | |
42 | $ERROR = ""; | |
43 | @OrgARGV = (); | |
44 | $ArchiveOpen = 0; | |
45 | ||
46 | $_msgid_cnt = 0; | |
47 | ||
48 | my %_sig_org = (); | |
49 | my @_term_sigs = qw( | |
50 | ABRT ALRM BUS FPE HUP ILL INT IOT PIPE POLL PROF QUIT SEGV | |
51 | TERM TRAP USR1 USR2 VTALRM XCPU XFSZ | |
52 | ); | |
53 | ||
54 | ||
55 | ############################################################################### | |
56 | ## Public routines | |
57 | ############################################################################### | |
58 | ||
59 | ##--------------------------------------------------------------------------- | |
60 | ## initialize() does some initialization stuff. Should be called | |
61 | ## right after mhamain.pl is called. | |
62 | ## | |
63 | sub initialize { | |
64 | ## Turn off buffered I/O to terminal | |
65 | my($curfh) = select(STDOUT); $| = 1; select($curfh); | |
66 | ||
67 | ## Check what system we are executing under | |
68 | require 'osinit.pl'; &OSinit(); | |
69 | ||
70 | ## Require essential libraries | |
71 | require 'mhlock.pl'; | |
72 | require 'mhopt.pl'; | |
73 | ||
74 | ## Init some variables | |
75 | $ISLOCK = 0; # Database lock flag | |
76 | ||
77 | $StartTime = 0; # CPU start time of processing | |
78 | $EndTime = 0; # CPU end time of processing | |
79 | } | |
80 | ||
81 | ##--------------------------------------------------------------------------- | |
82 | ## open_archive opens the archive | |
83 | ## | |
84 | sub open_archive { | |
85 | eval { $StartTime = (times)[0]; }; | |
86 | ||
87 | ## Set @ARGV if options passed in | |
88 | if (@_) { @OrgARGV = @ARGV; @ARGV = @_; } | |
89 | ||
90 | ## Get options | |
91 | my($optstatus); | |
92 | eval { | |
93 | set_handler(); | |
94 | $optstatus = get_resources(); | |
95 | }; | |
96 | ||
97 | ## Check for error | |
98 | if ($@ || $optstatus <= 0) { | |
99 | if ($@) { | |
100 | if ($@ =~ /signal caught/) { | |
101 | $CODE = 0; | |
102 | } else { | |
103 | $CODE = int($!) ? int($!) : 255; | |
104 | } | |
105 | $ERROR = $@; | |
106 | warn "\n", $ERROR; | |
107 | ||
108 | } else { | |
109 | if ($optstatus < 0) { | |
110 | $CODE = $! = 255; | |
111 | $ERROR = "ERROR: Problem loading resources\n"; | |
112 | } else { | |
113 | $CODE = 0; | |
114 | } | |
115 | } | |
116 | close_archive(); | |
117 | return 0; | |
118 | } | |
119 | $ArchiveOpen = 1; | |
120 | 1; | |
121 | } | |
122 | ||
123 | ##--------------------------------------------------------------------------- | |
124 | ## close_archive closes the archive. | |
125 | ## | |
126 | sub close_archive { | |
127 | my $reset_sigs = shift; | |
128 | ||
129 | ## Remove lock | |
130 | &$UnlockFunc() if defined(&$UnlockFunc); | |
131 | ||
132 | ## Reset signal handlers | |
133 | reset_handler() if $reset_sigs; | |
134 | ||
135 | ## Stop timing | |
136 | eval { $EndTime = (times)[0]; }; | |
137 | my $cputime = $EndTime - $StartTime; | |
138 | ||
139 | ## Output time (if specified) | |
140 | if ($TIME) { | |
141 | printf(STDERR "\nTime: %.2f CPU seconds\n", $cputime); | |
142 | } | |
143 | ||
144 | ## Restore @ARGV | |
145 | if (@OrgARGV) { @ARGV = @OrgARGV; } | |
146 | ||
147 | $ArchiveOpen = 0; | |
148 | ||
149 | ## Return time | |
150 | $cputime; | |
151 | } | |
152 | ||
153 | ##--------------------------------------------------------------------------- | |
154 | ## Routine to process input. If no errors, routine returns the | |
155 | ## CPU time taken. If an error, returns undef. | |
156 | ## | |
157 | sub process_input { | |
158 | ||
159 | ## Do processing | |
160 | if ($ArchiveOpen) { | |
161 | # archive already open, so doit | |
162 | eval { doit(); }; | |
163 | ||
164 | } else { | |
165 | # open archive first (implictely pass @_ to open_archive) | |
166 | if (&open_archive) { | |
167 | eval { doit(); }; | |
168 | } else { | |
169 | return undef; | |
170 | } | |
171 | } | |
172 | ||
173 | # check for error | |
174 | if ($@) { | |
175 | if ($@ =~ /signal caught/) { | |
176 | $CODE = 0 unless $CODE; | |
177 | } else { | |
178 | $CODE = (int($!) ? int($!) : 255) unless $CODE; | |
179 | } | |
180 | $ERROR = $@; | |
181 | close_archive(); | |
182 | warn "\n", $ERROR; | |
183 | return undef; | |
184 | } | |
185 | ||
186 | ## Cleanup | |
187 | close_archive(); | |
188 | } | |
189 | ||
190 | ############################################################################### | |
191 | ## Private routines | |
192 | ############################################################################### | |
193 | ||
194 | ##--------------------------------------------------------------------------- | |
195 | ## Routine that does the work | |
196 | ## | |
197 | sub doit { | |
198 | ||
199 | ## Check for non-archive modification modes. | |
200 | ||
201 | ## Just converting a single message to HTML | |
202 | if ($SINGLE) { | |
203 | single(); | |
204 | return 1; | |
205 | } | |
206 | ||
207 | ## Text message listing of archive to standard output. | |
208 | if ($SCAN) { | |
209 | scan(); | |
210 | return 1; | |
211 | } | |
212 | ||
213 | ## Annotating messages | |
214 | if ($ANNOTATE) { | |
215 | print STDOUT "Annotating messages in $OUTDIR ...\n" unless $QUIET; | |
216 | ||
217 | if (!defined($NoteText)) { | |
218 | print STDOUT "Please enter note text (terminated with EOF char):\n" | |
219 | unless $QUIET; | |
220 | $NoteText = join("", <$MhaStdin>); | |
221 | } | |
222 | return annotate(@ARGV, $NoteText); | |
223 | } | |
224 | ||
225 | ## Removing messages | |
226 | if ($RMM) { | |
227 | print STDOUT "Removing messages from $OUTDIR ...\n" | |
228 | unless $QUIET; | |
229 | return rmm(@ARGV); | |
230 | } | |
231 | ||
232 | ## HTML message listing to standard output. | |
233 | if ($IDXONLY) { | |
234 | IDXPAGE: { | |
235 | compute_page_total(); | |
236 | if ($IdxPageNum && $MULTIIDX) { | |
237 | if ($IdxPageNum =~ /first/i) { | |
238 | $IdxPageNum = 1; | |
239 | last IDXPAGE; | |
240 | } | |
241 | if ($IdxPageNum =~ /last/i) { | |
242 | $IdxPageNum = $NumOfPages; | |
243 | last IDXPAGE; | |
244 | } | |
245 | $IdxPageNum = int($IdxPageNum); | |
246 | last IDXPAGE if $IdxPageNum; | |
247 | } | |
248 | $MULTIIDX = 0; | |
249 | $IdxPageNum = 1; | |
250 | $NumOfPages = 1; | |
251 | } | |
252 | if ($THREAD) { | |
253 | compute_threads(); | |
254 | write_thread_index($IdxPageNum); | |
255 | } else { | |
256 | write_main_index($IdxPageNum); | |
257 | } | |
258 | return 1; | |
259 | } | |
260 | ||
261 | ## Get here, we are processing mail folders | |
262 | my($index, $fields, $fh, $i); | |
263 | ||
264 | $i = $NumOfMsgs; | |
265 | ##-------------------## | |
266 | ## Read mail folders ## | |
267 | ##-------------------## | |
268 | ## Just editing pages | |
269 | if ($EDITIDX) { | |
270 | print STDOUT "Editing $OUTDIR layout ...\n" unless $QUIET; | |
271 | ||
272 | ## Adding a single message | |
273 | } elsif ($ADDSINGLE) { | |
274 | print STDOUT "Adding message to $OUTDIR\n" unless $QUIET; | |
275 | $handle = $ADD; | |
276 | ||
277 | ## Read mail head | |
278 | ($index, $fields) = read_mail_header($handle); | |
279 | ||
280 | if ($index) { | |
281 | $AddIndex{$index} = 1; | |
282 | $IndexNum{$index} = &getNewMsgNum(); | |
283 | ||
284 | ## Read rest of message | |
285 | $Message{$index} = &read_mail_body( | |
286 | $handle, | |
287 | $index, | |
288 | $fields, | |
289 | $NoMsgPgs); | |
290 | } | |
291 | ||
292 | ## Adding/converting mail{boxes,folders} | |
293 | } else { | |
294 | print STDOUT ($ADD ? "Adding" : "Converting"), " messages to $OUTDIR" | |
295 | unless $QUIET; | |
296 | my($mbox, $mesgfile, @files); | |
297 | ||
298 | MAILFOLDER: foreach $mbox (@ARGV) { | |
299 | ||
300 | ## MH mail folder (a directory) | |
301 | if (-d $mbox) { | |
302 | if (!opendir(MAILDIR, $mbox)) { | |
303 | warn "\nWarning: Unable to open $mbox\n"; | |
304 | next; | |
305 | } | |
306 | $MBOX = 0; $MH = 1; | |
307 | print STDOUT "\nReading $mbox " unless $QUIET; | |
308 | @files = sort { $a <=> $b } grep(/$MHPATTERN/o, | |
309 | readdir(MAILDIR)); | |
310 | closedir(MAILDIR); | |
311 | ||
312 | local($_); | |
313 | MHFILE: foreach (@files) { | |
314 | $mesgfile = "${mbox}${DIRSEP}${_}"; | |
315 | eval { | |
316 | $fh = file_open($mesgfile); | |
317 | }; | |
318 | if ($@) { | |
319 | warn $@, | |
320 | qq/...Skipping "$mesgfile"\n/; | |
321 | next MHFILE; | |
322 | } | |
323 | print STDOUT "." unless $QUIET; | |
324 | ($index, $fields) = read_mail_header($fh); | |
325 | ||
326 | # Process message if valid | |
327 | if ($index) { | |
328 | if ($ADD && !$SLOW) { $AddIndex{$index} = 1; } | |
329 | $IndexNum{$index} = &getNewMsgNum(); | |
330 | $Message{$index} = &read_mail_body( | |
331 | $fh, | |
332 | $index, | |
333 | $fields, | |
334 | $NoMsgPgs); | |
335 | # Check if conserving memory | |
336 | if ($SLOW && $DoArchive) { | |
337 | output_mail($index, 1, 1); | |
338 | if (defined($IndexNum{$index})) { | |
339 | $Update{$IndexNum{$index}} = 1; | |
340 | } | |
341 | } | |
342 | if ($SLOW || !$DoArchive) { | |
343 | delete $MsgHead{$index}; | |
344 | delete $Message{$index}; | |
345 | } | |
346 | } | |
347 | close($fh); | |
348 | } | |
349 | ||
350 | ## UUCP mail box file | |
351 | } else { | |
352 | if ($mbox eq "-") { | |
353 | $fh = $MhaStdin; | |
354 | } else { | |
355 | eval { | |
356 | $fh = file_open($mbox); | |
357 | }; | |
358 | if ($@) { | |
359 | warn $@, | |
360 | qq/...Skipping "$mbox"\n/; | |
361 | next MAILFOLDER; | |
362 | } | |
363 | } | |
364 | ||
365 | $MBOX = 1; $MH = 0; | |
366 | print STDOUT "\nReading $mbox " unless $QUIET; | |
367 | # while (<$fh>) { last if /$FROM/o; } | |
368 | MBOX: while (!eof($fh)) { | |
369 | print STDOUT "." unless $QUIET; | |
370 | ($index, $fields) = read_mail_header($fh); | |
371 | ||
372 | if ($index) { | |
373 | if ($ADD && !$SLOW) { $AddIndex{$index} = 1; } | |
374 | $IndexNum{$index} = &getNewMsgNum(); | |
375 | $Message{$index} = read_mail_body( | |
376 | $fh, | |
377 | $index, | |
378 | $fields, | |
379 | $NoMsgPgs); | |
380 | if ($SLOW && $DoArchive) { | |
381 | output_mail($index, 1, 1); | |
382 | if (defined($IndexNum{$index})) { | |
383 | $Update{$IndexNum{$index}} = 1; | |
384 | } | |
385 | } | |
386 | if ($SLOW || !$DoArchive) { | |
387 | delete $MsgHead{$index}; | |
388 | delete $Message{$index}; | |
389 | } | |
390 | ||
391 | } else { | |
392 | read_mail_body($fh, $index, $fields, 1); | |
393 | } | |
394 | } | |
395 | close($fh); | |
396 | ||
397 | } # END: else UUCP mailbox | |
398 | } # END: foreach $mbox | |
399 | } # END: Else converting mailboxes | |
400 | print "\n" unless $QUIET; | |
401 | ||
402 | ## All done if not creating an archive | |
403 | if (!$DoArchive) { | |
404 | return 1; | |
405 | } | |
406 | ||
407 | ## Check if there are any new messages | |
408 | if (!$EDITIDX && ($i == $NumOfMsgs)) { | |
409 | print STDOUT "No new messages\n" unless $QUIET; | |
410 | return 1; | |
411 | } | |
412 | $NewMsgCnt = $NumOfMsgs - $i; | |
413 | ||
414 | ## Write pages | |
415 | &write_pages(); | |
416 | 1; | |
417 | } | |
418 | ||
419 | ##--------------------------------------------------------------------------- | |
420 | ## write_pages writes out all archive pages and db | |
421 | ## | |
422 | sub write_pages { | |
423 | my($i, $j, $key, $index, $tmp, $tmp2); | |
424 | my(@array2); | |
425 | my($mloc, $tloc); | |
426 | ||
427 | ## Remove old message if hit maximum size or expiration | |
428 | if (($MAXSIZE && ($NumOfMsgs > $MAXSIZE)) || | |
429 | $ExpireTime || | |
430 | $ExpireDateTime) { | |
431 | ||
432 | ## Set @MListOrder and %Index2MLoc for properly marking messages | |
433 | ## to be updated when a related messages are removed. Thread | |
434 | ## data should be around from db. | |
435 | ||
436 | @MListOrder = sort_messages(); | |
437 | @Index2MLoc{@MListOrder} = (0 .. $#MListOrder); | |
438 | ||
439 | # Ignore termination signals | |
440 | &ign_signals(); | |
441 | ||
442 | ## Expiration based upon time | |
443 | foreach $index (sort_messages(0,0,0,0)) { | |
444 | last unless | |
445 | ($MAXSIZE && ($NumOfMsgs > $MAXSIZE)) || | |
446 | (&expired_time(&get_time_from_index($index))); | |
447 | ||
448 | &delmsg($index); | |
449 | ||
450 | # Mark messages that need to be updated | |
451 | if (!$NoMsgPgs) { | |
452 | $mloc = $Index2MLoc{$index}; $tloc = $Index2TLoc{$index}; | |
453 | $Update{$IndexNum{$MListOrder[$mloc-1]}} = 1 | |
454 | if $mloc-1 >= 0; | |
455 | $Update{$IndexNum{$MListOrder[$mloc+1]}} = 1 | |
456 | if $mloc+1 <= $#MListOrder; | |
457 | $Update{$IndexNum{$TListOrder[$tloc-1]}} = 1 | |
458 | if $tloc-1 >= 0; | |
459 | $Update{$IndexNum{$TListOrder[$tloc+1]}} = 1 | |
460 | if $tloc+1 <= $#TListOrder; | |
461 | for ($i=2; $i <= $TSliceNBefore; ++$i) { | |
462 | $Update{$IndexNum{$TListOrder[$tloc-$i]}} = 1 | |
463 | if $tloc-$i >= 0; | |
464 | } | |
465 | for ($i=2; $i <= $TSliceNAfter; ++$i) { | |
466 | $Update{$IndexNum{$TListOrder[$tloc+$i]}} = 1 | |
467 | if $tloc-$i >= $#TListOrder; | |
468 | } | |
469 | foreach (@{$FollowOld{$index}}) { | |
470 | $Update{$IndexNum{$_}} = 1; | |
471 | } | |
472 | } | |
473 | ||
474 | # Mark where index page updates start | |
475 | if ($MULTIIDX) { | |
476 | $tmp = int($Index2MLoc{$index}/$IDXSIZE)+1; | |
477 | $IdxMinPg = $tmp | |
478 | if ($tmp < $IdxMinPg || $IdxMinPg < 0); | |
479 | $tmp = int($Index2TLoc{$index}/$IDXSIZE)+1; | |
480 | $TIdxMinPg = $tmp | |
481 | if ($tmp < $TIdxMinPg || $TIdxMinPg < 0); | |
482 | } | |
483 | } | |
484 | } | |
485 | ||
486 | ## Reset MListOrder | |
487 | @MListOrder = sort_messages(); | |
488 | @Index2MLoc{@MListOrder} = (0 .. $#MListOrder); | |
489 | ||
490 | ## Compute follow up messages | |
491 | compute_follow_ups(\@MListOrder); | |
492 | ||
493 | ## Compute thread information (sets ThreadList, TListOrder, Index2TLoc) | |
494 | compute_threads(); | |
495 | ||
496 | ## Check for which messages to update when adding to archive | |
497 | if ($ADD) { | |
498 | if ($UPDATE_ALL) { | |
499 | foreach $index (@MListOrder) { $Update{$IndexNum{$index}} = 1; } | |
500 | $IdxMinPg = 0; | |
501 | $TIdxMinPg = 0; | |
502 | ||
503 | } else { | |
504 | $i = 0; | |
505 | foreach $index (@MListOrder) { | |
506 | ## Check for New follow-up links | |
507 | if (is_follow_ups_diff($index)) { | |
508 | $Update{$IndexNum{$index}} = 1; | |
509 | } | |
510 | ## Check if new message; must update links in prev/next msgs | |
511 | if ($AddIndex{$index}) { | |
512 | ||
513 | # Mark where main index page updates start | |
514 | if ($MULTIIDX) { | |
515 | $tmp = int($Index2MLoc{$index}/$IDXSIZE)+1; | |
516 | $IdxMinPg = $tmp | |
517 | if ($tmp < $IdxMinPg || $IdxMinPg < 0); | |
518 | } | |
519 | ||
520 | # Mark previous/next messages | |
521 | $Update{$IndexNum{$MListOrder[$i-1]}} = 1 | |
522 | if $i > 0; | |
523 | $Update{$IndexNum{$MListOrder[$i+1]}} = 1 | |
524 | if $i < $#MListOrder; | |
525 | } | |
526 | ## Check for New reference links | |
527 | foreach (@{$Refs{$index}}) { | |
528 | $tmp = $MsgId{$_}; | |
529 | if (defined($IndexNum{$tmp}) && $AddIndex{$tmp}) { | |
530 | $Update{$IndexNum{$index}} = 1; | |
531 | } | |
532 | } | |
533 | $i++; | |
534 | } | |
535 | $i = 0; | |
536 | foreach $index (@TListOrder) { | |
537 | ## Check if new message; must update links in prev/next msgs | |
538 | if ($AddIndex{$index}) { | |
539 | ||
540 | # Mark where thread index page updates start | |
541 | if ($MULTIIDX) { | |
542 | $tmp = int($Index2TLoc{$index}/$IDXSIZE)+1; | |
543 | $TIdxMinPg = $tmp | |
544 | if ($tmp < $TIdxMinPg || $TIdxMinPg < 0); | |
545 | } | |
546 | ||
547 | # Mark previous/next message in thread | |
548 | $Update{$IndexNum{$TListOrder[$i-1]}} = 1 | |
549 | if $i > 0; | |
550 | $Update{$IndexNum{$TListOrder[$i+1]}} = 1 | |
551 | if $i < $#TListOrder; | |
552 | ||
553 | $tloc = $Index2TLoc{$index}; | |
554 | for ($j=2; $j <= $TSliceNBefore; ++$j) { | |
555 | $Update{$IndexNum{$TListOrder[$tloc-$j]}} = 1 | |
556 | if $tloc-$j >= 0; | |
557 | } | |
558 | for ($j=2; $j <= $TSliceNAfter; ++$j) { | |
559 | $Update{$IndexNum{$TListOrder[$tloc+$j]}} = 1 | |
560 | if $tloc-$j >= $#TListOrder; | |
561 | } | |
562 | } | |
563 | $i++; | |
564 | } | |
565 | } | |
566 | } | |
567 | ||
568 | ## Compute total number of pages | |
569 | $i = $NumOfPages; | |
570 | compute_page_total(); | |
571 | ||
572 | ## Update all pages for $LASTPG$ | |
573 | if ($UsingLASTPG && ($i != $NumOfPages)) { | |
574 | $IdxMinPg = 0; | |
575 | $TIdxMinPg = 0; | |
576 | } | |
577 | ||
578 | ##------------## | |
579 | ## Write Data ## | |
580 | ##------------## | |
581 | ign_signals(); # Ignore termination signals | |
582 | print STDOUT "\n" unless $QUIET; | |
583 | ||
584 | ## Write indexes and mail | |
585 | write_mail() unless $NoMsgPgs; | |
586 | write_main_index() if $MAIN; | |
587 | write_thread_index() if $THREAD; | |
588 | ||
589 | ## Write database | |
590 | print STDOUT "Writing database ...\n" unless $QUIET; | |
591 | output_db($DBPathName); | |
592 | ||
593 | ## Write any alternate indexes | |
594 | $IdxMinPg = 0; $TIdxMinPg = 0; | |
595 | my($rc, $rcfile); | |
596 | OTHERIDX: foreach $rc (@OtherIdxs) { | |
597 | $THREAD = 0; | |
598 | ||
599 | ## find other index resource file | |
600 | IDXFIND: { | |
601 | if (-e $rc) { | |
602 | # in current working directory | |
603 | $rcfile = $rc; | |
604 | last IDXFIND; | |
605 | } | |
606 | if (defined $MainRcDir) { | |
607 | # check if located with main resource file | |
608 | $rcfile = join($DIRSEP, $MainRcDir, $rc); | |
609 | last IDXFIND if -e $rcfile; | |
610 | } | |
611 | if (defined $ENV{'HOME'}) { | |
612 | # check if in home directory | |
613 | $rcfile = join($DIRSEP, $ENV{'HOME'}, $rc); | |
614 | last IDXFIND if -e $rcfile; | |
615 | } | |
616 | ||
617 | # check if in archive directory | |
618 | $rcfile = join($DIRSEP, $OUTDIR, $rc); | |
619 | last IDXFIND if -e $rcfile; | |
620 | ||
621 | # look thru @INC to find file | |
622 | local($_); | |
623 | foreach (@INC) { | |
624 | $rcfile = join($DIRSEP, $_, $rc); | |
625 | if (-e $rcfile) { | |
626 | last IDXFIND; | |
627 | } | |
628 | } | |
629 | warn qq/Warning: Unable to find resource file "$rc"\n/; | |
630 | next OTHERIDX; | |
631 | } | |
632 | ||
633 | ## read resource file and print index | |
634 | if (read_fmt_file($rcfile)) { | |
635 | if ($THREAD) { | |
636 | @TListOrder = (); | |
637 | write_thread_index(); | |
638 | } else { | |
639 | @MListOrder = (); | |
640 | write_main_index(); | |
641 | } | |
642 | } | |
643 | } | |
644 | ||
645 | unless ($QUIET) { | |
646 | print STDOUT "$NewMsgCnt new messages\n" if $NewMsgCnt > 0; | |
647 | print STDOUT "$NumOfMsgs total messages\n"; | |
648 | } | |
649 | ||
650 | } ## End: write_pages() | |
651 | ||
652 | ##--------------------------------------------------------------------------- | |
653 | ## Compute follow-ups | |
654 | ## | |
655 | sub compute_follow_ups { | |
656 | my $idxlst = shift; | |
657 | my($index, $tmp, $tmp2); | |
658 | ||
659 | %Follow = (); | |
660 | foreach $index (@$idxlst) { | |
661 | $FolCnt{$index} = 0 unless $FolCnt{$index}; | |
662 | if (defined($Refs{$index}) && scalar(@{$Refs{$index}})) { | |
663 | $tmp2 = $Refs{$index}->[-1]; | |
664 | next unless defined($MsgId{$tmp2}) && | |
665 | defined($IndexNum{$MsgId{$tmp2}}); | |
666 | $tmp = $MsgId{$tmp2}; | |
667 | if ($Follow{$tmp}) { push(@{$Follow{$tmp}}, $index); } | |
668 | else { $Follow{$tmp} = [ $index ]; } | |
669 | ++$FolCnt{$tmp}; | |
670 | } | |
671 | } | |
672 | } | |
673 | ||
674 | ##--------------------------------------------------------------------------- | |
675 | ## Compute total number of pages | |
676 | ## | |
677 | sub compute_page_total { | |
678 | if ($MULTIIDX && $IDXSIZE) { | |
679 | $NumOfPages = int($NumOfMsgs/$IDXSIZE); | |
680 | ++$NumOfPages if ($NumOfMsgs/$IDXSIZE) > $NumOfPages; | |
681 | $NumOfPages = 1 if $NumOfPages == 0; | |
682 | } else { | |
683 | $NumOfPages = 1; | |
684 | } | |
685 | } | |
686 | ||
687 | ##--------------------------------------------------------------------------- | |
688 | ## write_mail outputs converted mail. It takes a reference to an | |
689 | ## array containing indexes of messages to output. | |
690 | ## | |
691 | sub write_mail { | |
692 | my($hack) = (0); | |
693 | print STDOUT "Writing mail " unless $QUIET; | |
694 | ||
695 | if ($SLOW && !$ADD) { | |
696 | $ADD = 1; | |
697 | $hack = 1; | |
698 | } | |
699 | ||
700 | foreach $index (@MListOrder) { | |
701 | print STDOUT "." unless $QUIET; | |
702 | output_mail($index, $AddIndex{$index}, 0); | |
703 | } | |
704 | ||
705 | if ($hack) { | |
706 | $ADD = 0; | |
707 | } | |
708 | ||
709 | print STDOUT "\n" unless $QUIET; | |
710 | } | |
711 | ||
712 | ##--------------------------------------------------------------------------- | |
713 | ## read_mail_header() is responsible for parsing the header of | |
714 | ## a mail message and loading message information into hash | |
715 | ## structures. | |
716 | ## | |
717 | ## ($index, $header_fields_ref) = read_mail_header($filehandle); | |
718 | ## | |
719 | sub read_mail_header { | |
720 | my $handle = shift; | |
721 | my($index, $date, $tmp, $i, $field, $value); | |
722 | my($from, $sub, $msgid, $ctype); | |
723 | local($_); | |
724 | ||
725 | my @refs = (); | |
726 | my @array = (); | |
727 | my($fields, $header) = readmail::MAILread_file_header($handle); | |
728 | ||
729 | ##---------------------------## | |
730 | ## Check for no archive flag ## | |
731 | ##---------------------------## | |
732 | if ( $CheckNoArchive && | |
733 | ((defined($fields->{'restrict'}) && | |
734 | grep { /no-external-archive/i } @{$fields->{'restrict'}}) || | |
735 | (defined($fields->{'x-no-archive'}) && | |
736 | grep { /yes/i } @{$fields->{'x-no-archive'}})) ) { | |
737 | return undef; | |
738 | } | |
739 | ||
740 | ##----------------------------------## | |
741 | ## Check for user-defined exclusion ## | |
742 | ##----------------------------------## | |
743 | if ($MsgExcFilter) { | |
744 | return undef if mhonarc::message_exclude($header); | |
745 | } | |
746 | ||
747 | ##------------## | |
748 | ## Get Msg-ID ## | |
749 | ##------------## | |
750 | $msgid = $fields->{'message-id'}[0] || $fields->{'msg-id'}[0] || | |
751 | $fields->{'content-id'}[0]; | |
752 | if (defined($msgid)) { | |
753 | if ($msgid =~ /<([^>]*)>/) { | |
754 | $msgid = $1; | |
755 | } else { | |
756 | $msgid =~ s/^\s+//; | |
757 | $msgid =~ s/\s+$//; | |
758 | } | |
759 | } else { | |
760 | # create bogus ID if none exists | |
761 | eval { | |
762 | # create message-id using md5 digest of header; | |
763 | # can potentially skip over already archived messages w/o id | |
764 | require Digest::MD5; | |
765 | $msgid = join("", Digest::MD5::md5_hex($header), | |
766 | '@NO-ID-FOUND.mhonarc.org'); | |
767 | }; | |
768 | if ($@) { | |
769 | # unable to require, so create arbitary message-id | |
770 | $msgid = join("", $$,'.',time,'.',$_msgid_cnt++, | |
771 | '@NO-ID-FOUND.mhonarc.org'); | |
772 | } | |
773 | } | |
774 | ||
775 | ## Return if message already exists in archive | |
776 | if ($msgid && defined($MsgId{$msgid})) { | |
777 | return undef; | |
778 | } | |
779 | ||
780 | ##----------## | |
781 | ## Get date ## | |
782 | ##----------## | |
783 | $date = ""; | |
784 | foreach (@_DateFields) { | |
785 | ($field, $i) = @{$_}[0,1]; | |
786 | next unless defined($fields->{$field}) && | |
787 | defined($value = $fields->{$field}[$i]); | |
788 | ||
789 | ## Treat received field specially | |
790 | if ($field eq 'received') { | |
791 | @array = split(/;/, $value); | |
792 | # if ((scalar(@array) <= 1) || (scalar(@array) > 2)) { | |
793 | # warn qq/\nWarning: Received header field looks improper:\n/, | |
794 | # qq/ Received: $value\n/, | |
795 | # qq/ Message-Id: <$msgid>\n/; | |
796 | # } | |
797 | $date = pop @array; | |
798 | ## Any other field should just be a date | |
799 | } else { | |
800 | $date = $value; | |
801 | } | |
802 | $date =~ s/^\s+//; $date =~ s/\s+$//; | |
803 | ||
804 | ## See if time_t can be determined. | |
805 | if (($date =~ /\w/) && (@array = parse_date($date))) { | |
806 | $index = get_time_from_date(@array[1..$#array]); | |
807 | last; | |
808 | } | |
809 | } | |
810 | if (!$index) { | |
811 | warn qq/\nWarning: Could not parse date for message\n/, | |
812 | qq/ Message-Id: <$msgid>\n/; | |
813 | # Use current time | |
814 | $index = time; | |
815 | # Set date string to local date if not defined | |
816 | $date = &time2str("", $index, 1) unless $date =~ /\S/; | |
817 | } | |
818 | ||
819 | ## Return if message too old to add (note, $index just contains time). | |
820 | if (&expired_time($index)) { | |
821 | return undef; | |
822 | } | |
823 | ||
824 | ##-------------## | |
825 | ## Get Subject ## | |
826 | ##-------------## | |
827 | if (defined($fields->{'subject'}) && ($fields->{'subject'}[0] =~ /\S/)) { | |
828 | ($sub = $fields->{'subject'}[0]) =~ s/\s+$//; | |
829 | $sub = subject_strip($sub) if $SubStripCode; | |
830 | } else { | |
831 | $sub = ''; | |
832 | } | |
833 | ||
834 | ##----------## | |
835 | ## Get From ## | |
836 | ##----------## | |
837 | $from = ""; | |
838 | foreach (@FromFields) { | |
839 | next unless defined $fields->{$_}; | |
840 | $from = $fields->{$_}[0]; | |
841 | last; | |
842 | } | |
843 | $from = 'Unknown' unless $from; | |
844 | ||
845 | ##----------------## | |
846 | ## Get References ## | |
847 | ##----------------## | |
848 | if (defined($fields->{'references'})) { | |
849 | $tmp = $fields->{'references'}[0]; | |
850 | while ($tmp =~ s/<([^<>]+)>//) { | |
851 | push(@refs, $1); | |
852 | } | |
853 | } | |
854 | if (defined($fields->{'in-reply-to'})) { | |
855 | my $irtoid; | |
856 | foreach (@{$fields->{'in-reply-to'}}) { | |
857 | $tmp = $_; | |
858 | $irtoid = ""; | |
859 | while ($tmp =~ s/<([^<>]+)>//) { $irtoid = $1 }; | |
860 | push(@refs, $irtoid) if $irtoid; | |
861 | } | |
862 | } | |
863 | @refs = remove_dups(\@refs); # Remove duplicate msg-ids | |
864 | ||
865 | ##------------------## | |
866 | ## Get Content-Type ## | |
867 | ##------------------## | |
868 | if (defined($fields->{'content-type'})) { | |
869 | ($ctype = $fields->{'content-type'}[0]) =~ m%^\s*([\w\-\./]+)%; | |
870 | $ctype = lc ($1 || 'text/plain'); | |
871 | } else { | |
872 | $ctype = 'text/plain'; | |
873 | } | |
874 | ||
875 | ## Insure uniqueness of index | |
876 | $index .= $X . sprintf("%d",$LastMsgNum+1); | |
877 | ||
878 | ## Set mhonarc fields. Note how values are NOT arrays. | |
879 | $fields->{'x-mha-index'} = $index; | |
880 | $fields->{'x-mha-message-id'} = $msgid; | |
881 | $fields->{'x-mha-from'} = $from; | |
882 | $fields->{'x-mha-subject'} = $sub; | |
883 | $fields->{'x-mha-content-type'} = $ctype; | |
884 | ||
885 | ## Invoke callback if defined | |
886 | if (defined($CBMessageHeadRead) && defined(&$CBMessageHeadRead)) { | |
887 | return undef unless &$CBMessageHeadRead($fields, $header); | |
888 | } | |
889 | ||
890 | $From{$index} = $from; | |
891 | $Date{$index} = $date; | |
892 | $Subject{$index} = $sub; | |
893 | $MsgHead{$index} = htmlize_header($fields); | |
894 | $ContentType{$index} = $ctype; | |
895 | if ($msgid) { | |
896 | $MsgId{$msgid} = $index; | |
897 | $NewMsgId{$msgid} = $index; # Track new message-ids | |
898 | $Index2MsgId{$index} = $msgid; | |
899 | } | |
900 | ||
901 | $Refs{$index} = [ @refs ] if (@refs); | |
902 | ||
903 | ($index, $fields); | |
904 | } | |
905 | ||
906 | ##--------------------------------------------------------------------------- | |
907 | ## read_mail_body() reads in the body of a message. The returned | |
908 | ## filtered body is in $ret. | |
909 | ## | |
910 | ## $html = read_mail_body($fh, $index, $fields_hash_ref, | |
911 | ## $skipConversion); | |
912 | ## | |
913 | sub read_mail_body { | |
914 | my($handle, $index, $fields, $skip) = @_; | |
915 | my($ret, $data) = ('', ''); | |
916 | my(@files); | |
917 | local($_); | |
918 | ||
919 | ## Slurp up message body | |
920 | ## UUCP mailbox | |
921 | if ($MBOX) { | |
922 | if ($CONLEN && defined($fields->{"content-length"})) { | |
923 | my($len, $cnt) = ($fields->{"content-length"}[0], 0); | |
924 | if ($len) { | |
925 | while (<$handle>) { | |
926 | $cnt += length($_); # Increment byte count | |
927 | $data .= $_ unless $skip; # Save data | |
928 | last if $cnt >= $len # Last if hit length | |
929 | } | |
930 | } | |
931 | # Slurp up bogus data if required (should I do this?) | |
932 | while (!/$FROM/o && !eof($handle)) { | |
933 | $_ = <$handle>; | |
934 | } | |
935 | ||
936 | } else { # No content-length | |
937 | while (<$handle>) { | |
938 | last if /$FROM/o; | |
939 | $data .= $_ unless $skip; | |
940 | } | |
941 | } | |
942 | ||
943 | ## MH message file | |
944 | } elsif (!$skip) { | |
945 | local $/ = undef; | |
946 | $data = <$handle>; | |
947 | } | |
948 | ||
949 | return '' if $skip; | |
950 | ||
951 | ## Invoke callback if defined | |
952 | if (defined($CBRawMessageBodyRead) && defined(&$CBRawMessageBodyRead)) { | |
953 | &$CBRawMessageBodyRead($fields, \$data); | |
954 | } | |
955 | ||
956 | ## Define "globals" for use by filters | |
957 | ## NOTE: This stuff can be handled better, and will be done | |
958 | ## when/if I get around to rewriting mhonarc in (OO) Perl 5. | |
959 | $MHAindex = $index; | |
960 | $MHAmsgnum = &fmt_msgnum($IndexNum{$index}); | |
961 | $MHAmsgid = $Index2MsgId{$index}; | |
962 | ||
963 | ## Filter data | |
964 | ($ret, @files) = &readmail::MAILread_body($fields, \$data); | |
965 | $ret = '' unless defined $ret; | |
966 | @files = ( ) unless @files; | |
967 | ||
968 | ## Invoke callback if defined | |
969 | if (defined($CBMessageBodyRead) && defined(&$CBMessageBodyRead)) { | |
970 | &$CBMessageBodyRead($fields, \$ret, \@files); | |
971 | } | |
972 | ||
973 | if (!defined($ret) || $ret eq "") { | |
974 | $ret = join('', | |
975 | "<dl>\n", | |
976 | "<dt><strong>Warning</strong></dt>\n", | |
977 | "<dd>Unable to process data: \n", | |
978 | "<tt>", | |
979 | htmlize($fields->{'content-type'}[0] || 'text/plain'), | |
980 | "</tt>\n", | |
981 | "</dd>\n", | |
982 | "</dl>\n" | |
983 | ); | |
984 | } | |
985 | if (@files) { | |
986 | $Derived{$index} = [ @files ]; | |
987 | } | |
988 | $ret; | |
989 | } | |
990 | ||
991 | ##--------------------------------------------------------------------------- | |
992 | ## Output/edit a mail message. | |
993 | ## $index => current index (== $array[$i]) | |
994 | ## $force => flag if mail is written and not editted, regardless | |
995 | ## $nocustom => ignore sections with user customization | |
996 | ## | |
997 | ## This function returns ($msgnum, $filename) if everything went | |
998 | ## okay, but no calls to this routine check the return values. | |
999 | ## | |
1000 | sub output_mail { | |
1001 | my($index, $force, $nocustom) = @_; | |
1002 | my($msgi, $tmp, $tmp2, $template, @array2); | |
1003 | my($msghandle, $msginfh, $drvfh); | |
1004 | ||
1005 | my $msgnum = $IndexNum{$index}; | |
1006 | if (!$SINGLE && !defined($msgnum)) { | |
1007 | # Something bad must have happened to message, so we just | |
1008 | # quietly return. | |
1009 | return; | |
1010 | } | |
1011 | ||
1012 | my $adding = ($ADD && !$force && !$SINGLE); | |
1013 | my $i_p0 = fmt_msgnum($msgnum); | |
1014 | my $filename = msgnum_filename($msgnum); | |
1015 | my $filepathname = join($DIRSEP, $OUTDIR, $filename); | |
1016 | my $tmppathname = join($DIRSEP, $OUTDIR, "msgtmp.$$"); | |
1017 | ||
1018 | if ($adding) { | |
1019 | return ($i_p0, $filename) unless $Update{$msgnum}; | |
1020 | #&file_rename($filepathname, $tmppathname); | |
1021 | eval { | |
1022 | $msginfh = file_open($filepathname); | |
1023 | }; | |
1024 | if ($@) { | |
1025 | # Something is screwed up with archive: We try to delete | |
1026 | # message from database since message file appears to have | |
1027 | # disappeared | |
1028 | warn $@, | |
1029 | qq/...Will attempt to remove message and continue on\n/; | |
1030 | delmsg($index); | |
1031 | ||
1032 | # Nothing else to do, so return. | |
1033 | return; | |
1034 | } | |
1035 | } | |
1036 | if ($SINGLE) { | |
1037 | $msghandle = \*STDOUT; | |
1038 | } else { | |
1039 | $msghandle = file_create($tmppathname, $GzipFiles); | |
1040 | } | |
1041 | ||
1042 | ## Output HTML header | |
1043 | if ($adding) { | |
1044 | while (<$msginfh>) { | |
1045 | last if /<!--X-Body-Begin/; | |
1046 | } | |
1047 | } | |
1048 | if (!$nocustom) { | |
1049 | #&defineIndex2MsgId(); | |
1050 | ||
1051 | $template = ($MSGPGSSMARKUP ne '') ? $MSGPGSSMARKUP : $SSMARKUP; | |
1052 | if ($template ne '') { | |
1053 | $template =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1054 | print $msghandle $template; | |
1055 | } | |
1056 | ||
1057 | # Output comments -- more informative, but can be used for | |
1058 | # error recovering. | |
1059 | print $msghandle | |
1060 | "<!-- ", commentize("MHonArc v$VERSION"), " -->\n", | |
1061 | "<!--X-Subject: ", commentize($Subject{$index}), " -->\n", | |
1062 | "<!--X-From-R13: ", commentize(mrot13($From{$index})), " -->\n", | |
1063 | "<!--X-Date: ", commentize($Date{$index}), " -->\n", | |
1064 | "<!--X-Message-Id: ", commentize($Index2MsgId{$index}), " -->\n", | |
1065 | "<!--X-Content-Type: ", commentize($ContentType{$index}), " -->\n"; | |
1066 | #ContentType | |
1067 | ||
1068 | if (defined($Refs{$index})) { | |
1069 | foreach (@{$Refs{$index}}) { | |
1070 | print $msghandle | |
1071 | "<!--X-Reference: ", commentize($_), " -->\n"; | |
1072 | #Reference-Id | |
1073 | } | |
1074 | } | |
1075 | if (defined($Derived{$index})) { | |
1076 | foreach (@{$Derived{$index}}) { | |
1077 | print $msghandle "<!--X-Derived: ", commentize($_), " -->\n"; | |
1078 | } | |
1079 | } | |
1080 | print $msghandle "<!--X-Head-End-->\n"; | |
1081 | ||
1082 | # Add in user defined markup | |
1083 | ($template = $MSGPGBEG) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1084 | print $msghandle $template; | |
1085 | } | |
1086 | print $msghandle "<!--X-Body-Begin-->\n"; | |
1087 | ||
1088 | ## Output header | |
1089 | if ($adding) { | |
1090 | while (<$msginfh>) { | |
1091 | last if /<!--X-User-Header-End/ || /<!--X-TopPNI--/; | |
1092 | } | |
1093 | } | |
1094 | print $msghandle "<!--X-User-Header-->\n"; | |
1095 | if (!$nocustom) { | |
1096 | ($template = $MSGHEAD) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1097 | print $msghandle $template; | |
1098 | } | |
1099 | print $msghandle "<!--X-User-Header-End-->\n"; | |
1100 | ||
1101 | ## Output Prev/Next/Index links at top | |
1102 | if ($adding) { | |
1103 | while (<$msginfh>) { last if /<!--X-TopPNI-End/; } | |
1104 | } | |
1105 | print $msghandle "<!--X-TopPNI-->\n"; | |
1106 | if (!$nocustom && !$SINGLE) { | |
1107 | ($template = $TOPLINKS) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1108 | print $msghandle $template; | |
1109 | } | |
1110 | print $msghandle "\n<!--X-TopPNI-End-->\n"; | |
1111 | ||
1112 | ## Output message data | |
1113 | if ($adding) { | |
1114 | $tmp2 = ""; | |
1115 | while (<$msginfh>) { | |
1116 | # check if subject header delimited | |
1117 | if (/<!--X-Subject-Header-Begin/) { | |
1118 | $tmp2 =~ s%($AddrExp)%&link_refmsgid($1,1)%geo; | |
1119 | print $msghandle $tmp2; | |
1120 | $tmp2 = ""; | |
1121 | ||
1122 | while (<$msginfh>) { last if /<!--X-Subject-Header-End/; } | |
1123 | print $msghandle "<!--X-Subject-Header-Begin-->\n"; | |
1124 | if (!$nocustom) { | |
1125 | ($template = $SUBJECTHEADER) =~ | |
1126 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1127 | print $msghandle $template; | |
1128 | } | |
1129 | print $msghandle "<!--X-Subject-Header-End-->\n"; | |
1130 | next; | |
1131 | } | |
1132 | # check if head/body separator delimited | |
1133 | if (/<!--X-Head-Body-Sep-Begin/) { | |
1134 | $tmp2 =~ s%($AddrExp)%&link_refmsgid($1,1)%geo; | |
1135 | print $msghandle $tmp2; | |
1136 | $tmp2 = ""; | |
1137 | ||
1138 | while (<$msginfh>) { last if /<!--X-Head-Body-Sep-End/; } | |
1139 | print $msghandle "<!--X-Head-Body-Sep-Begin-->\n"; | |
1140 | if (!$nocustom) { | |
1141 | ($template = $HEADBODYSEP) =~ | |
1142 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1143 | print $msghandle $template; | |
1144 | } | |
1145 | print $msghandle "<!--X-Head-Body-Sep-End-->\n"; | |
1146 | next; | |
1147 | } | |
1148 | ||
1149 | $tmp2 .= $_; | |
1150 | last if /<!--X-MsgBody-End/; | |
1151 | } | |
1152 | $tmp2 =~ s%($AddrExp)%&link_refmsgid($1,1)%geo; | |
1153 | print $msghandle $tmp2; | |
1154 | ||
1155 | } else { | |
1156 | print $msghandle "<!--X-MsgBody-->\n"; | |
1157 | print $msghandle "<!--X-Subject-Header-Begin-->\n"; | |
1158 | ($template = $SUBJECTHEADER) =~ | |
1159 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1160 | print $msghandle $template; | |
1161 | print $msghandle "<!--X-Subject-Header-End-->\n"; | |
1162 | ||
1163 | $MsgHead{$index} =~ s%($AddrExp)%&link_refmsgid($1)%geo; | |
1164 | $Message{$index} =~ s%($AddrExp)%&link_refmsgid($1)%geo; | |
1165 | ||
1166 | print $msghandle "<!--X-Head-of-Message-->\n"; | |
1167 | print $msghandle $MsgHead{$index}; | |
1168 | print $msghandle "<!--X-Head-of-Message-End-->\n"; | |
1169 | print $msghandle "<!--X-Head-Body-Sep-Begin-->\n"; | |
1170 | ($template = $HEADBODYSEP) =~ | |
1171 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1172 | print $msghandle $template; | |
1173 | print $msghandle "<!--X-Head-Body-Sep-End-->\n"; | |
1174 | print $msghandle "<!--X-Body-of-Message-->\n"; | |
1175 | print $msghandle $Message{$index}, "\n"; | |
1176 | print $msghandle "<!--X-Body-of-Message-End-->\n"; | |
1177 | print $msghandle "<!--X-MsgBody-End-->\n"; | |
1178 | } | |
1179 | ||
1180 | ## Output any followup messages | |
1181 | if ($adding) { | |
1182 | while (<$msginfh>) { last if /<!--X-Follow-Ups-End/; } | |
1183 | } | |
1184 | print $msghandle "<!--X-Follow-Ups-->\n"; | |
1185 | ($template = $MSGBODYEND) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1186 | print $msghandle $template; | |
1187 | if (!$nocustom && $DoFolRefs && defined($Follow{$index})) { | |
1188 | if (scalar(@{$Follow{$index}})) { | |
1189 | ($template = $FOLUPBEGIN) =~ | |
1190 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1191 | print $msghandle $template; | |
1192 | foreach (@{$Follow{$index}}) { | |
1193 | ($template = $FOLUPLITXT) =~ | |
1194 | s/$VarExp/&replace_li_var($1,$_)/geo; | |
1195 | print $msghandle $template; | |
1196 | } | |
1197 | ($template = $FOLUPEND) =~ | |
1198 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1199 | print $msghandle $template; | |
1200 | } | |
1201 | } | |
1202 | print $msghandle "<!--X-Follow-Ups-End-->\n"; | |
1203 | ||
1204 | ## Output any references | |
1205 | if ($adding) { | |
1206 | while (<$msginfh>) { last if /<!--X-References-End/; } | |
1207 | } | |
1208 | print $msghandle "<!--X-References-->\n"; | |
1209 | if (!$nocustom && $DoFolRefs && defined($Refs{$index})) { | |
1210 | $tmp2 = 0; # flag for when first ref printed | |
1211 | if (scalar(@{$Refs{$index}})) { | |
1212 | foreach (@{$Refs{$index}}) { | |
1213 | next unless defined($MsgId{$_}); | |
1214 | next unless defined($IndexNum{$MsgId{$_}}); | |
1215 | if (!$tmp2) { | |
1216 | ($template = $REFSBEGIN) =~ | |
1217 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1218 | print $msghandle $template; | |
1219 | $tmp2 = 1; | |
1220 | } | |
1221 | ($template = $REFSLITXT) =~ | |
1222 | s/$VarExp/&replace_li_var($1,$MsgId{$_})/geo; | |
1223 | print $msghandle $template; | |
1224 | } | |
1225 | ||
1226 | if ($tmp2) { | |
1227 | ($template = $REFSEND) =~ | |
1228 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1229 | print $msghandle $template; | |
1230 | } | |
1231 | } | |
1232 | } | |
1233 | print $msghandle "<!--X-References-End-->\n"; | |
1234 | ||
1235 | ## Output verbose links to prev/next message in list | |
1236 | if ($adding) { | |
1237 | while (<$msginfh>) { last if /<!--X-BotPNI-End/; } | |
1238 | } | |
1239 | print $msghandle "<!--X-BotPNI-->\n"; | |
1240 | if (!$nocustom && !$SINGLE) { | |
1241 | ($template = $BOTLINKS) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1242 | print $msghandle $template; | |
1243 | } | |
1244 | print $msghandle "\n<!--X-BotPNI-End-->\n"; | |
1245 | ||
1246 | ## Output footer | |
1247 | if ($adding) { | |
1248 | while (<$msginfh>) { | |
1249 | last if /<!--X-User-Footer-End/; | |
1250 | } | |
1251 | } | |
1252 | print $msghandle "<!--X-User-Footer-->\n"; | |
1253 | if (!$nocustom) { | |
1254 | ($template = $MSGFOOT) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1255 | print $msghandle $template; | |
1256 | } | |
1257 | print $msghandle "<!--X-User-Footer-End-->\n"; | |
1258 | ||
1259 | if (!$nocustom) { | |
1260 | ($template = $MSGPGEND) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1261 | print $msghandle $template; | |
1262 | } | |
1263 | ||
1264 | close($msghandle) if (!$SINGLE); | |
1265 | if ($adding) { | |
1266 | close($msginfh); | |
1267 | #&file_remove($tmppathname); | |
1268 | } | |
1269 | file_rename($tmppathname, $filepathname) unless $SINGLE; | |
1270 | ||
1271 | ## Create user defined files | |
1272 | foreach (keys %UDerivedFile) { | |
1273 | ($tmp = $_) =~ s/$VarExp/&replace_li_var($1,$index)/geo; | |
1274 | $tmp2 = join($DIRSEP, $OUTDIR, $tmp); | |
1275 | if ($drvfh = file_create($tmp2, $GzipFiles)) { | |
1276 | ($template = $UDerivedFile{$_}) =~ | |
1277 | s/$VarExp/&replace_li_var($1,$index)/geo; | |
1278 | print $drvfh $template; | |
1279 | close($drvfh); | |
1280 | if (defined($Derived{$index})) { | |
1281 | push(@{$Derived{$index}}, $tmp); | |
1282 | } else { | |
1283 | $Derived{$index} = [ $tmp ]; | |
1284 | } | |
1285 | } else { | |
1286 | warn "Warning: Unable to create $tmp2\n"; | |
1287 | } | |
1288 | } | |
1289 | if (defined($Derived{$index})) { | |
1290 | $Derived{$index} = [ remove_dups($Derived{$index}) ]; | |
1291 | } | |
1292 | ||
1293 | ## Set modification times -- Use eval incase OS does not support utime. | |
1294 | if ($MODTIME && !$SINGLE) { | |
1295 | eval { | |
1296 | $tmp = get_time_from_index($index); | |
1297 | if (defined($Derived{$index})) { | |
1298 | @array2 = @{$Derived{$index}}; | |
1299 | grep($_ = $OUTDIR . $DIRSEP . $_, @array2); | |
1300 | } else { | |
1301 | @array2 = ( ); | |
1302 | } | |
1303 | unshift(@array2, $filepathname); | |
1304 | file_utime($tmp, $tmp, @array2); | |
1305 | }; | |
1306 | if ($@) { | |
1307 | warn qq/\nWarning: Your platform does not support setting file/, | |
1308 | qq/ modification times\n/; | |
1309 | $MODTIME = 0; | |
1310 | } | |
1311 | } | |
1312 | ||
1313 | ($i_p0, $filename); | |
1314 | } | |
1315 | ||
1316 | ############################################################################# | |
1317 | ## Miscellaneous routines | |
1318 | ############################################################################# | |
1319 | ||
1320 | ##--------------------------------------------------------------------------- | |
1321 | ## delmsg delets a message from the archive. | |
1322 | ## | |
1323 | sub delmsg { | |
1324 | my($key) = @_; | |
1325 | my($pathname); | |
1326 | ||
1327 | #&defineIndex2MsgId(); | |
1328 | my $msgnum = $IndexNum{$key}; return 0 if ($msgnum eq ''); | |
1329 | my $filename = join($DIRSEP, $OUTDIR, &msgnum_filename($msgnum)); | |
1330 | delete $ContentType{$key}; | |
1331 | delete $Date{$key}; | |
1332 | delete $From{$key}; | |
1333 | delete $IndexNum{$key}; | |
1334 | delete $Refs{$key}; | |
1335 | delete $Subject{$key}; | |
1336 | delete $MsgId{$Index2MsgId{$key}}; | |
1337 | file_remove($filename) unless $KeepOnRmm; | |
1338 | foreach $filename (@{$Derived{$key}}) { | |
1339 | $pathname = (OSis_absolute_path($filename)) ? | |
1340 | $filename : join($DIRSEP, $OUTDIR, $filename); | |
1341 | if (-d $pathname) { | |
1342 | dir_remove($pathname) unless $KeepOnRmm; | |
1343 | } else { | |
1344 | file_remove($pathname) unless $KeepOnRmm; | |
1345 | } | |
1346 | } | |
1347 | delete $Derived{$key}; | |
1348 | $NumOfMsgs--; | |
1349 | 1; | |
1350 | } | |
1351 | ||
1352 | ##--------------------------------------------------------------------------- | |
1353 | ## Routine to convert a msgid to an anchor | |
1354 | ## | |
1355 | sub link_refmsgid { | |
1356 | my($refmsgid, $onlynew) = @_; | |
1357 | ||
1358 | if (defined($MsgId{$refmsgid}) && | |
1359 | defined($IndexNum{$MsgId{$refmsgid}}) && | |
1360 | (!$onlynew || $NewMsgId{$refmsgid})) { | |
1361 | my($lreftmpl) = $MSGIDLINK; | |
1362 | $lreftmpl =~ s/$VarExp/&replace_li_var($1,$MsgId{$refmsgid})/geo; | |
1363 | $lreftmpl; | |
1364 | } else { | |
1365 | $refmsgid; | |
1366 | } | |
1367 | } | |
1368 | ||
1369 | ##--------------------------------------------------------------------------- | |
1370 | ## Retrieve next available message number. Should only be used | |
1371 | ## when an archive is locked. | |
1372 | ## | |
1373 | sub getNewMsgNum { | |
1374 | $NumOfMsgs++; $LastMsgNum++; | |
1375 | $LastMsgNum; | |
1376 | } | |
1377 | ||
1378 | ##--------------------------------------------------------------------------- | |
1379 | ## ign_signals() sets mhonarc to ignore termination signals. This | |
1380 | ## routine is called right before an archive is written/edited to | |
1381 | ## help prevent archive corruption. | |
1382 | ## | |
1383 | sub ign_signals { | |
1384 | @SIG{@_term_sigs} = ('IGNORE') x scalar(@_term_sigs); | |
1385 | } | |
1386 | ||
1387 | ##--------------------------------------------------------------------------- | |
1388 | ## set_handler() sets up the signal_catch() routine to be called when | |
1389 | ## termination signals are sent to mhonarc. | |
1390 | ## | |
1391 | sub set_handler { | |
1392 | %_sig_org = ( ); | |
1393 | @_sig_org{@_term_sigs} = @SIG{@_term_sigs}; | |
1394 | @SIG{@_term_sigs} = (\&mhonarc::signal_catch) x scalar(@_term_sigs); | |
1395 | } | |
1396 | ||
1397 | ##--------------------------------------------------------------------------- | |
1398 | ## reset_handler() resets the original signal handlers. | |
1399 | ## | |
1400 | sub reset_handler { | |
1401 | @SIG{@_term_sigs} = @_sig_org{@_term_sigs}; | |
1402 | } | |
1403 | ||
1404 | ##--------------------------------------------------------------------------- | |
1405 | ## signal_catch(): Function for handling signals that would cause | |
1406 | ## termination. | |
1407 | ## | |
1408 | sub signal_catch { | |
1409 | my $signame = shift; | |
1410 | close_archive(1); | |
1411 | &{$_sig_org{$signame}}($signame) if defined(&{$_sig_org{$signame}}); | |
1412 | reset_handler(); | |
1413 | die qq/Processing stopped, signal caught: SIG$signame\n/; | |
1414 | } | |
1415 | ||
1416 | ##--------------------------------------------------------------------------- | |
1417 | ## Create Index2MsgId if not defined | |
1418 | ## | |
1419 | sub defineIndex2MsgId { | |
1420 | if (!defined(%Index2MsgId)) { | |
1421 | foreach (keys %MsgId) { | |
1422 | $Index2MsgId{$MsgId{$_}} = $_; | |
1423 | } | |
1424 | } | |
1425 | } | |
1426 | ||
1427 | ##--------------------------------------------------------------------------- | |
1428 | 1; |