1#! /bin/sh 2# -*- tcl -*- \ 3exec tclsh "$0" ${1+"$@"} 4 5# personal.tcl - process personal mail 6# 7# (c) 1999 Marshall T. Rose 8# Hold harmless the author, and any lawful use is allowed. 9# 10# The original version was written in 1994! 11# 12 13package require Tcl 8.3 14 15global options 16 17 18# begin of routines that may be redefined in configFile 19 20proc impersonalMail {originator} {} 21 22proc adminP {local domain} { 23 set local [string tolower $local] 24 25 foreach lhs [list administrator \ 26 archive-server \ 27 daemon \ 28 failrepter \ 29 faxmaster \ 30 gateway \ 31 listmaster \ 32 listproc \ 33 lotus_mail_exchange \ 34 m400 \ 35 *mailer* \ 36 *maiser* \ 37 mmdf \ 38 mrgate \ 39 mx-mailer-daemon \ 40 numbers-info-forw \ 41 postman* \ 42 *postmast* \ 43 pp \ 44 smtp \ 45 sysadmin \ 46 ucx_smtp \ 47 uucp] { 48 if {[string match $lhs $local]} { 49 return 1 50 } 51 } 52 53 return 0 54} 55 56proc friendP {local domain} { 57 global options 58 59 if {![info exists options(friendlyDomains)]} { 60 return 0 61 } 62 63 set domain [string tolower $domain] 64 65 foreach rhs $options(friendlyDomains) { 66 if {(![string compare $rhs $domain]) \ 67 || ([string match *.$rhs $domain])} { 68 return 1 69 } 70 } 71 72 return 0 73} 74 75proc ownerP {local domain} { 76 global options 77 78 foreach mailbox {myMailbox pdaMailboxes remoteMailboxes} { 79 if {![info exists options($mailbox)]} { 80 continue 81 } 82 83 foreach addr [mime::parseaddress $options($mailbox)] { 84 catch { unset aprops } 85 86 array set aprops $addr 87 if {![string compare [string tolower $local@$domain] \ 88 [string tolower $aprops(local)@$aprops(domain)]]} { 89 return 1 90 } 91 } 92 } 93 94 return 0 95} 96 97# the algorithm below is for systems that use the MMDF/MH convention 98 99proc saveMessage {inF {outF ""}} { 100 global errorCode errorInfo 101 global options 102 103 set inC [open $inF { RDONLY }] 104 105 if {![string compare $outF ""]} { 106 set outF $options(defaultMaildrop) 107 } 108 mutl::exclfile [set lockF $outF.lock] 109 110 set code [catch { set outC [open $outF { WRONLY CREAT APPEND }] } result] 111 set ecode $errorCode 112 set einfo $errorInfo 113 114 if {!$code} { 115 set code [catch { 116 puts $outC [set boundary "\001\001\001\001"] 117 puts $outC "Delivery-Date: [mime::parsedatetime -now proper]" 118 119 while {[gets $inC line] >= 0} { 120 if {[string compare $boundary $line]} { 121 puts $outC $line 122 } else { 123 puts $outC "\002\001\001\001" 124 } 125 } 126 127 puts $outC $boundary 128 } result] 129 set ecode $errorCode 130 set einfo $errorInfo 131 132 if {[catch { close $outC } result2]} { 133 tclLog $result2 134 } 135 } 136 137 file delete -- $lockF 138 139 if {[catch { close $inC } result2]} { 140 tclLog $result2 141 } 142 143 return -code $code -errorinfo $einfo -errorcode $ecode $result 144} 145 146proc findPhrase {subject} { 147 global options 148 149 set subject [string toupper $subject] 150 151 foreach file [glob -nocomplain [file join $options(dataDirectory) \ 152 phrases *]] { 153 if {[catch { otp_words -mode encode \ 154 [base64 -mode decode -- \ 155 [join [split [file tail $file] _] /]] } \ 156 phrase]} { 157 tclLog "$file: $phrase" 158 } elseif {[string first $phrase $subject] >= 0} { 159 if {[catch { file delete -- $file } result]} { 160 tclLog $result 161 } 162 163 return 1 164 } 165 } 166 167 return 0 168} 169 170proc makePhrase {} { 171 global options 172 173 if {![file isdirectory \ 174 [set phraseD [file join $options(dataDirectory) phrases]]]} { 175 file mkdir $phraseD 176 } else { 177 pruneDir $phraseD phrase 178 } 179 180 set key [mime::uniqueID] 181 set seqno 8 182 while {[incr seqno -1] >= 0} { 183 set key [otp_md5 -- $key] 184 } 185 186 set phraseF [file join $phraseD \ 187 [join [split [string trim \ 188 [base64 -mode encode -- $key]] /] _]] 189 if {[catch { close [open $phraseF { WRONLY CREAT TRUNC }] } result]} { 190 tclLog $result 191 } 192 193 return [otp_words -mode encode -- $key] 194} 195 196proc pruneDir {dir type} { 197 switch -- $type { 198 addr { 199 set days 14 200 } 201 202 msgid { 203 set days 28 204 } 205 206 phrase { 207 set days 7 208 } 209 } 210 211 set then [expr {[clock seconds]-($days*86400)}] 212 213 foreach file [glob -nocomplain [file join $dir *]] { 214 if {(![catch { file mtime $file } result]) \ 215 && ($result < $then) \ 216 && ([catch { file delete -- $file } result])} { 217 tclLog $result 218 } 219 } 220} 221 222proc tclLog {message} { 223 global options 224 225 if {([info exists options(debugP)]) && ($options(debugP) > 0)} { 226 puts stderr $message 227 } 228 229 if {([string first "DEBUG " $message] == 0) \ 230 || ([catch { set fd [open $options(logFile) \ 231 { WRONLY CREAT APPEND }] }])} { 232 return 233 } 234 235 regsub -all "\n" $message " " message 236 237 catch { puts -nonewline $fd \ 238 [format "%s %-8.8s %06d %s\n" \ 239 [clock format [clock seconds] -format "%m/%d %T"] \ 240 personal [expr {[pid]%65535}] $message] } 241 242 catch { close $fd } 243} 244 245# end of routines that may be redefined in configFile 246 247 248global deleteFiles 249 250set deleteFiles {} 251 252proc cleanup {{message ""} {status 75}} { 253 global deleteFiles 254 255 foreach file $deleteFiles { 256 if {[catch { file delete -- $file } result]} { 257 tclLog $result 258 } 259 } 260 261 if {[string compare $message ""]} { 262 tclLog $message 263 exit $status 264 } 265 266 exit 0 267} 268 269proc dofolder {folder inF} { 270 global options 271 272 catch { unset aprops } 273 274 array set aprops [lindex [mime::parseaddress $folder] 0] 275 set folder [join [split $aprops(local) /] _] 276 277 if {[set folderN [llength [set folderL [split $folder .]]]] <= 1} { 278 cleanup "invalid folder: $folder" 279 } 280 281 foreach f $folderL { 282 if {![string compare $f ""]} { 283 cleanup "invalid folder: $folder" 67 284 } 285 } 286 287 if {![file isdirectory \ 288 [set articleD [eval [list file join \ 289 $options(foldersDirectory)] \ 290 [lrange $folderL 0 \ 291 [expr {$folderN-2}]]]]]} { 292 file mkdir $articleD 293 } 294 if {![file exists [set articleF [file join $articleD \ 295 [lindex $folderL \ 296 [expr {$folderN-1}]]]]]} { 297 set newP 1 298 } else { 299 set newP 0 300 } 301 302 set fd [open $options(foldersFile) { RDWR CREAT }] 303 set fl "\n[read $fd]" 304 305 set dir [lindex [file split $options(foldersDirectory)] end] 306 if {[string first "\n$dir\n" $fl] < 0} { 307 puts $fd $dir 308 } 309 foreach f $folderL { 310 set dir [file join $dir $f] 311 if {[string first "\n$dir\n" $fl] < 0} { 312 puts $fd $dir 313 } 314 } 315 316 close $fd 317 318 if {[catch { saveMessage $inF $articleF } result]} { 319 cleanup "unable to save message in $articleF: $result" 320 } 321 322 if {($newP) && ([info exists options(announceMailboxes)])} { 323 if {[catch { smtp::sendmessage \ 324 [mime::initialize \ 325 -canonical text/plain \ 326 -param {charset us-ascii} \ 327 -string ""] \ 328 -atleastone true \ 329 -originator "" \ 330 -header [list From $options(myMailbox)] \ 331 -header [list To $options(announceMailboxes)] \ 332 -header [list Subject "new folder $folder"] } \ 333 result]} { 334 tclLog $result 335 } 336 } 337} 338 339proc alladdrs {mime keys} { 340 set result {} 341 342 foreach key $keys { 343 foreach value [mutl::getheader $mime $key] { 344 foreach addr [mime::parseaddress $value] { 345 lappend result $addr 346 } 347 } 348 } 349 350 return $result 351} 352 353proc anyfriend {outD addrs} { 354 global options 355 356 if {!$options(friendlyFire)} { 357 return "" 358 } 359 360 foreach addr $addrs { 361 catch { unset aprops } 362 363 array set aprops $addr 364 if {[catch { string tolower $aprops(local)@$aprops(domain) } \ 365 recipient]} { 366 continue 367 } 368 369 if {[ownerP $aprops(local) $aprops(domain)]} { 370 tclLog "DEBUG: skipping $recipient" 371 continue 372 } 373 374 set outF [file join $outD [join [split $recipient /] _]] 375 if {[file exists $outF]} { 376 return $recipient 377 } 378 379 tclLog "DEBUG: unknown recipient $recipient" 380 } 381 382 return "" 383} 384 385 386if {[catch { 387 388 set program personal 389 390 package require mutl 1.0 391 package require smtp 1.1 392 package require Tclx 8.0 393 394 395# parse arguments and initialize environment 396 397 set program [file tail [file rootname $argv0]] 398 399 set configFile .${program}-config.tcl 400 401 set debugP 0 402 403 set messageFile - 404 405 set originatorAddress "" 406 407 set userName "" 408 409 for {set argx 0} {$argx < $argc} {incr argx} { 410 set option [lindex $argv $argx] 411 if {[incr argx] >= $argc} { 412 cleanup "missing argument to $option" 413 } 414 set value [lindex $argv $argx] 415 416 switch -- $option { 417 -config { 418 set configFile $value 419 } 420 421 -debug { 422 set options(debugP) [set debugP [smtp::boolean $value]] 423 } 424 425 -file { 426 set messageFile $value 427 } 428 429 -originator { 430 set originatorAddress $value 431 } 432 433 -user { 434 set userName $value 435 } 436 437 default { 438 cleanup "unknown option $option" 439 } 440 } 441 } 442 443 if {![string compare $messageFile -]} { 444 array set tmp [mutl::tmpfile personal] 445 446 lappend deleteFiles [set messageFile $tmp(file)] 447 448 catch { file attributes $messageFile -permissions 0600 } 449 450 if {[gets stdin line] <= 0} { 451 cleanup "empty message" 452 } 453 if {[string first "From " $line] == 0} { 454 if {![string compare $originatorAddress ""]} { 455 set line [string range $line 5 end] 456 if {[set x [string first " " $line]] > 0} { 457 set originatorAddress [string range $line 0 [expr {$x-1}]] 458 } 459 } 460 } else { 461 puts $tmp(fd) $line 462 } 463 fcopy stdin $tmp(fd) 464 close $tmp(fd) 465 } 466 467 if {[string compare $userName ""]} { 468 if {[catch { id convert user $userName }]} { 469 cleanup "userName doesn't exist: $userName" 470 } 471 if {([catch { file isdirectory ~$userName } result]) \ 472 || (!$result)} { 473 cleanup "userName doesn't have a home directory: $userName" 474 } 475 476 umask 0077 477 cd ~$userName 478 } 479 480 if {![file exists $configFile]} { 481 cleanup "configFile file doesn't exist: $configFile" 482 } 483 source $configFile 484 485 set options(debugP) $debugP 486 487 foreach {k v} [array get options] { 488 if {![string compare $v ""]} { 489 unset options($k) 490 } 491 } 492 493 foreach k [list dataDirectory defaultMaildrop] { 494 if {![info exists options($k)]} { 495 cleanup "configFile didn't define $k: $configFile" 496 } 497 } 498 499 if {![file isdirectory $options(dataDirectory)]} { 500 file mkdir $options(dataDirectory) 501 } 502 503 if {![info exists options(myMailbox)]} { 504 set options(myMailbox) [id user] 505 } 506 507 if {![info exists options(friendlyFire)]} { 508 set options(friendlyFire) 0 509 } 510 511 512# crack the message 513 514 if {[catch { set mime [mime::initialize -file $messageFile] } result]} { 515# global errorCode errorInfo 516# 517# set ecode $errorCode 518# set einfo $errorInfo 519# 520# if {![catch { 521# smtp::sendmessage \ 522# [mime::initialize \ 523# -canonical multipart/mixed \ 524# -parts [list [mime::initialize \ 525# -canonical text/plain \ 526# -param {charset us-ascii} \ 527# -string "$result\n\nerrorCode: $ecode\n\n$einfo"] \ 528# [mime::initialize \ 529# -canonical application/octet-stream \ 530# -file $messageFile]]] \ 531# -originator "" \ 532# -header [list From $options(myMailbox)] \ 533# -header [list To $options(myMailbox)] \ 534# -header [list Subject "[info hostname] alert $program"] 535# }]} { 536# set result "" 537# } 538 539 if {[info exists options(auditInFile)]} { 540 saveMessage $messageFile $options(auditInFile) 541 tclLog "invalid, but saved: $result" 542 cleanup 543 } 544 545 cleanup "re-queued: $result" 546 } 547 548 set origProper "" 549 foreach key {From Sender Return-Path} { 550 if {[string compare \ 551 [set origProper [mutl::firstaddress \ 552 [mutl::getheader $mime $key]]] \ 553 ""]} { 554 break 555 } 556 } 557 if {![string compare $origProper ""]} { 558 set origProper [mutl::firstaddress [list $originatorAddress]] 559 } 560 561 catch { unset aprops } 562 563 array set aprops [list local "" domain ""] 564 array set aprops [lindex [mime::parseaddress $origProper] 0] 565 set origLocal $aprops(local) 566 set origDomain $aprops(domain) 567 568 regsub -all " *" \ 569 [set subject [string trim \ 570 [lindex [mutl::getheader $mime Subject] 0]]] \ 571 " " subject 572 573 574 if {[catch { set folderTarget [impersonalMail $origLocal@$origDomain] }]} { 575 set folderTarget "" 576 } 577 if {[set impersonalP [string compare $folderTarget ""]]} { 578 if {![info exists options(foldersDirectory)]} { 579 cleanup "configFile didn't define folderTarget: $configFile" 580 } 581 } elseif {[info exists options(auditInFile)]} { 582# keep an audit copy of personal mail 583 584 saveMessage $messageFile $options(auditInFile) 585 } 586 587 588# perform duplicate supression 589 590 set messageID [lindex [concat [mutl::getheader $mime Resent-Message-ID] \ 591 [mutl::getheader $mime Message-ID]] 0] 592 if {[string compare $messageID ""]} { 593 if {![file isdirectory \ 594 [set idD [file join $options(dataDirectory) msgids]]]} { 595 file mkdir $idD 596 } else { 597 pruneDir $idD msgid 598 } 599 600 if {[set len [string length $messageID]] > 2} { 601 set messageID [string range $messageID 1 [expr {$len-2}]] 602 } 603 if {$impersonalP} { 604 set prefix X- 605 606 catch { unset aprops } 607 608 array set aprops [lindex [mime::parseaddress $folderTarget] 0] 609 set prefix \ 610 X-[lindex [split [join [split $aprops(local) /] _] .] 0]- 611 } else { 612 set prefix "" 613 } 614 615 set idF [file join $idD $prefix[join [split $messageID /] _]] 616 if {[file exists $idF]} { 617 tclLog "duplicate ID: $origProper $messageID ($subject)" 618 619 cleanup 620 } 621 622 if {[catch { close [open $idF { WRONLY CREAT TRUNC }] } result]} { 623 tclLog $result 624 } 625 } 626 627 628# record information about the originator 629 630 if {![string compare \ 631 [set origAddress \ 632 [string tolower $origLocal@$origDomain]] \ 633 @]} { 634 tclLog "no originator" 635 636 if {!$impersonalP} { 637 saveMessage $messageFile 638 } 639 640 cleanup 641 } 642 643 tclLog "DEBUG processing: $origProper <$messageID> ($subject)" 644 645 if {![file isdirectory \ 646 [set inD [file join $options(dataDirectory) inaddrs]]]} { 647 file mkdir $inD 648 } 649 650 set inF [file join $inD [join [split $origAddress /] _]] 651 if {[catch { set fd [open $inF { WRONLY CREAT TRUNC }] } result]} { 652 tclLog $result 653 } else { 654 catch { puts $fd $origProper } 655 if {[catch { close $fd } result]} { 656 tclLog $result 657 } 658 } 659 660 661# store impersonal mail in private folder area 662 663 if {$impersonalP} { 664 if {![string compare $messageID ""]} { 665 cleanup "no Message-ID" 666 } 667 668 if {![file isdirectory $options(foldersDirectory)]} { 669 file mkdir $foldersDirectory 670 } 671 672 array set mapping {} 673 674 if {![catch { set fd [open $options(mappingFile) { RDONLY }] }]} { 675 while {[gets $fd line] >= 0} { 676 if {([llength [set map [split $line :]]] == 2) \ 677 && ([string length \ 678 [set k [string trim [lindex $map 0]]]] \ 679 > 0) \ 680 && ([string length \ 681 [set v [string trim [lindex $map 1]]]] \ 682 > 0)} { 683 set mapping($k) $v 684 } 685 } 686 687 if {[catch { close $fd } result]} { 688 tclLog $result 689 } 690 } 691 692 if {![info exists mapping($folderTarget)]} { 693 set mapping($folderTarget) store 694 } 695 if {![string compare $mapping($folderTarget) process]} { 696 catch { set mapping($folderTarget) \ 697 [processFolder $folderTarget $mime] } 698 } 699 switch -- $mapping($folderTarget) { 700 store { 701 dofolder $folderTarget $messageFile 702 } 703 704 ignore { 705 tclLog "ignoring message for $folderTarget" 706 } 707 708 bounce { 709 cleanup "rejecting message for $folderTarget" 67 710 } 711 712 default { 713 if {[catch { smtp::sendmessage $mime \ 714 -atleastone true \ 715 -originator "" \ 716 -recipients $mapping($folderTarget) } \ 717 result]} { 718 tclLog $result 719 } 720 } 721 } 722 723 cleanup 724 } 725 726 727# perform originator supression and guest list maintenance 728 729 if {[string compare \ 730 [set resentProper \ 731 [mutl::firstaddress \ 732 [mutl::getheader $mime Resent-From]]] \ 733 ""]} { 734 catch { unset aprops } 735 736 array set aprops [lindex [mime::parseaddress $resentProper] 0] 737 set resentLocal $aprops(local) 738 set resentDomain $aprops(domain) 739 740 if {[string compare \ 741 [set resentAddress \ 742 [string tolower $resentLocal@$resentDomain]] \ 743 @]} { 744 foreach p {Proper Local Domain Address} { 745 set orig$p [set resent$p] 746 } 747 } 748 } 749 750 foreach p {out tmp bad} { 751 if {![file isdirectory [set ${p}D [file join $options(dataDirectory) \ 752 ${p}addrs]]]} { 753 file mkdir [set ${p}D] 754 } 755 756 set ${p}F [file join [set ${p}D] [join [split $origAddress /] _]] 757 } 758 759 pruneDir $tmpD addr 760 761 762# deal with Klez-inspired nonsense 763 if {([info exists options(dropNames)]) && ([catch { 764 foreach part [mime::getproperty $mime parts] { 765 catch { unset params } 766 array set params [mime::getproperty $part params] 767 if {[info exists params(name)]} { 768 foreach name $options(dropNames) { 769 if {[string match $name $params(name)]} { 770 tclLog "rejecting: $origProper <$messageID> ($subject) $params(name)" 771 cleanup 772 } 773 } 774 } 775 } 776 } result])} { 777 tclLog "Klez-check: $result" 778 } 779 780 set friend "" 781 if {[adminP $origLocal $origDomain]} { 782 tclLog "DEBUG admin check: $origProper <$messageID> ($subject)" 783 784# if DSNs were the rule, it would make sense to parse it... no such luck 785 786 set fd [open $messageFile { RDONLY }] 787 set text [read $fd] 788 if {[catch { close $fd } result]} { 789 tclLog $result 790 } 791 792 foreach file [glob -nocomplain [file join $badD *]] { 793 set addr [file tail $file] 794 if {([string match *$addr* $text]) \ 795 || (([set x [string first @ $addr]] > 0) \ 796 && ([string match \ 797 *[string range $addr 0 [expr {$x-1}]]* \ 798 $text]))} { 799 tclLog "failure notice: $origProper ($addr)" 800 801 cleanup 802 } 803 } 804 805 tclLog "DEBUG admin continue: $origProper <$messageID> ($subject)" 806 } elseif {(![ownerP $origLocal $origDomain]) \ 807 && (![friendP $origLocal $origDomain]) \ 808 && (![file exists $outF]) \ 809 && (![file exists $tmpF]) \ 810 && (![string compare ""\ 811 [set friend [anyfriend $outD \ 812 [alladdrs $mime {To cc}]]]]) \ 813 && (![findPhrase $subject]) \ 814 && ([info exists options(noticeFile)])} { 815 if {[file exists $badF]} { 816 catch { file delete -- $badF } 817 } elseif {[catch { 818 set fd [open $options(noticeFile) { RDONLY }] 819 set text [read $fd] 820 if {[catch { close $fd } result]} { 821 tclLog $result 822 } 823 824 regsub -all %passPhrase% $text [makePhrase] text 825 for {set rsubject $subject} \ 826 {[regexp -nocase ^re: $rsubject]} \ 827 {set rsubject [string trimleft \ 828 [string range $rsubject 3 end]]} { 829 } 830 regsub -all %subject% $text $rsubject text 831 832 smtp::sendmessage \ 833 [mime::initialize \ 834 -canonical multipart/mixed \ 835 -parts [list [mime::initialize \ 836 -canonical text/plain \ 837 -param {charset us-ascii} \ 838 -string $text] \ 839 [mime::initialize \ 840 -canonical message/rfc822 \ 841 -parts [list $mime]]]] \ 842 -originator "" \ 843 -header [list From $options(myMailbox)] \ 844 -header [list To $origProper] \ 845 -header [list Subject "Re: $rsubject"] 846 847 set fd [open $badF { WRONLY CREAT TRUNC }] 848 } result]} { 849 tclLog $result 850 } else { 851 catch { puts $fd $origProper } 852 if {[catch { close $fd } result]} { 853 tclLog $result 854 } 855 } 856 tclLog "rejecting: $origProper <$messageID> ($subject)" 857 858 cleanup 859 } elseif {[string compare $friend ""]} { 860 tclLog "accepting: $origProper because of $friend" 861 } else { 862 if {[ownerP $origLocal $origDomain]} { 863 set addrD $outD 864 } else { 865 set addrD $tmpD 866 } 867 868 foreach addr [alladdrs $mime \ 869 {From To cc Resent-From Resent-To Resent-cc}] { 870 catch { unset aprops } 871 872 array set aprops $addr 873 set addrLocal $aprops(local) 874 set addrDomain $aprops(domain) 875 876 if {[string compare \ 877 [set addrAddress \ 878 [string tolower $addrLocal@$addrDomain]] @]} { 879 set addrF [file join $addrD [join [split $addrAddress /] _]] 880 881 if {[file exists $addrF]} { 882 continue 883 } 884 885 if {[catch { set fd [open $addrF { WRONLY CREAT TRUNC }] } \ 886 result]} { 887 tclLog $result 888 } else { 889 catch { puts $fd $aprops(proper) } 890 if {[catch { close $fd } result]} { 891 tclLog $result 892 } 893 } 894 } 895 } 896 } 897 898 899# perform final actions, if we're the originator 900 901 if {[ownerP $origLocal $origDomain]} { 902 if {[info exists options(auditOutFile)]} { 903 saveMessage $messageFile $options(auditOutFile) 904 } 905 906 cleanup 907 } 908 909 910# send a copy to the pda 911 912 if {([info exists options(pdaMailboxes)]) \ 913 && ([string compare [set text [mutl::gathertext $mime]] ""])} { 914 if {[info exists options(pdaMailsize)]} { 915 set text [string range $text 0 [expr {$options(pdaMailsize)-1}]] 916 } 917 set pda [mime::initialize \ 918 -canonical text/plain \ 919 -param {charset us-ascii} \ 920 -string $text] 921 922 foreach key {From To cc Subject Date Reply-To} { 923 foreach value [mutl::getheader $mime $key] { 924 mime::setheader $pda $key $value -mode append 925 } 926 } 927 928 if {[catch { smtp::sendmessage $pda \ 929 -atleastone true \ 930 -originator "" \ 931 -recipients $options(pdaMailboxes) } result]} { 932 tclLog $result 933 } 934 } 935 936 937# send a copy to the remote mailbox 938 939 if {[info exists options(remoteMailboxes)]} { 940 if {[catch { smtp::sendmessage $mime \ 941 -atleastone true \ 942 -originator "" \ 943 -recipients $options(remoteMailboxes) } result]} { 944 tclLog $result 945 } else { 946 cleanup 947 } 948 } 949 950 saveMessage $messageFile 951 952 953 cleanup 954 955 956} result]} { 957 global errorCode errorInfo 958 959 set ecode $errorCode 960 set einfo $errorInfo 961 962 if {(![catch { info body tclLog } result2]) \ 963 && ([string compare [string trim $result2] \ 964 {catch {puts stderr $string}}])} { 965 catch { tclLog $result } 966 } 967 968 catch { 969 smtp::sendmessage \ 970 [mime::initialize \ 971 -canonical text/plain \ 972 -param {charset us-ascii} \ 973 -string "$result\n\nerrorCode: $ecode\n\n$einfo"] \ 974 -originator "" \ 975 -header [list From [id user]@[info hostname]] \ 976 -header [list To operator@[info hostname]] \ 977 -header [list Subject "[info hostname] fatal $program"] 978 } 979 980 cleanup $result 981} 982 983 984exit 75 985