Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / mhamain.pl
CommitLineData
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
28package mhonarc;
29
30require 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.
39EndOfInfo
40
41$CODE = 0;
42$ERROR = "";
43@OrgARGV = ();
44$ArchiveOpen = 0;
45
46$_msgid_cnt = 0;
47
48my %_sig_org = ();
49my @_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##
63sub 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##
84sub 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##
126sub 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##
157sub 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##
197sub 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##
422sub 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##
655sub 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##
677sub 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##
691sub 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##
719sub 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##
913sub 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##
1000sub 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##
1323sub 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##
1355sub 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##
1373sub 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##
1383sub 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##
1391sub 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##
1400sub 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##
1408sub 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##
1419sub defineIndex2MsgId {
1420 if (!defined(%Index2MsgId)) {
1421 foreach (keys %MsgId) {
1422 $Index2MsgId{$MsgId{$_}} = $_;
1423 }
1424 }
1425}
1426
1427##---------------------------------------------------------------------------
14281;