diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
| commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
| tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/examples/mime | |
| parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
| parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
| download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 | |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/examples/mime')
| -rw-r--r-- | tcllib/examples/mime/maildemo.tcl | 78 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/ChangeLog | 10 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/README.html | 817 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/README.txt | 1008 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/README.xml | 720 | ||||
| -rwxr-xr-x | tcllib/examples/mime/mbot/impersonal.tcl | 531 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/mbox.tcl | 465 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/mutl.tcl | 123 | ||||
| -rwxr-xr-x | tcllib/examples/mime/mbot/personal.tcl | 982 | ||||
| -rw-r--r-- | tcllib/examples/mime/mbot/pkgIndex.tcl | 3 |
10 files changed, 4737 insertions, 0 deletions
diff --git a/tcllib/examples/mime/maildemo.tcl b/tcllib/examples/mime/maildemo.tcl new file mode 100644 index 0000000..56fe98b --- /dev/null +++ b/tcllib/examples/mime/maildemo.tcl @@ -0,0 +1,78 @@ +#!/usr/bin/env tclsh +## -*- tcl -*- +# maildemo.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sf.net> +# +# This program illustrates the steps required to compose a MIME message and +# mail it to a recipient using the tcllib mime and smtp packages. +# +# If we can find suitable environment variables we will authenticate with a +# server (if it presents this option) and we will use SSL communications +# if available. +# +# $Id: maildemo.tcl,v 1.3 2010/11/25 17:19:45 andreas_kupries Exp $ + +package require mime +package require smtp + +# The use of SSL by our client can be controlled by a policy procedure. Using +# this we can specify that we REQUIRE SSL or we can make SSL optional. +# This procedure should return 'secure' to require SSL +# +proc policy {demoarg code diagnostic} { + if {$code > 299} { + puts stderr "TLS error: $code $diagnostic" + } + #return secure; # fail if no TLS + return insecure; +} + +# Setup default sender and target +set DEFUSER tcllib-demo@[info host] +set USERNAME $tcl_platform(user) +set PASSWORD "" + +# Try and lift authentication details from the environment. +if {[info exists env(USERNAME)]} { + set USERNAME $env(USERNAME) +} + +# We can get the password from http_proxy_pass - maybe. +if {[info exists env(http_proxy_pass)]} { + set PASSWORD $env(http_proxy_pass) +} + +set defmsg "This is a default tcllib demo mail message." + +# Compose and send a message. Command parameters can override the settings +# discovered above. +# +proc Send [list \ + [list server localhost] \ + [list port 25] \ + [list from $DEFUSER] \ + [list to $DEFUSER] \ + [list msg $defmsg]] { + set tok [mime::initialize -canonical text/plain -string $msg] + set args [list \ + -debug 1 \ + -servers [list $server] \ + -ports [list $port] \ + -usetls 1 \ + -tlspolicy [list policy $tok] \ + -header [list From "$from"] \ + -header [list To "$to"] \ + -header [list Subject "RFC 2554 test"] \ + -header [list Date "[clock format [clock seconds]]"]] + if {[info exists ::USERNAME] && [string length $::USERNAME] > 0} { + lappend args \ + -username $::USERNAME \ + -password $::PASSWORD + } + + eval [linsert $args 0 smtp::sendmessage $tok] + mime::finalize $tok +} + +if {!$tcl_interactive} { + eval [linsert $argv 0 Send] +} diff --git a/tcllib/examples/mime/mbot/ChangeLog b/tcllib/examples/mime/mbot/ChangeLog new file mode 100644 index 0000000..f517447 --- /dev/null +++ b/tcllib/examples/mime/mbot/ChangeLog @@ -0,0 +1,10 @@ +2007-03-23 Andreas Kupries <andreask@activestate.com> + + * pkgIndex.tcl: Added MD hints. + +2004-09-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * impersonal.tcl: Fixed 'expr'essions without braces. + * mbox.tcl: + * mutl.tcl: + * personal.tcl: diff --git a/tcllib/examples/mime/mbot/README.html b/tcllib/examples/mime/mbot/README.html new file mode 100644 index 0000000..ec98b12 --- /dev/null +++ b/tcllib/examples/mime/mbot/README.html @@ -0,0 +1,817 @@ +<html><head><title>The README file: The personal.tcl Mailbot</title> +<meta http-equiv="Expires" content="Wed, 14 Aug 2002 20:43:57 +0000"> +<STYLE type='text/css'> + .title { color: #990000; font-size: 22px; line-height: 22px; font-weight: bold; text-align: right; + font-family: helvetica, arial, sans-serif } + .filename { color: #666666; font-size: 18px; line-height: 28px; font-weight: bold; text-align: right; + font-family: helvetica, arial, sans-serif } + p.copyright { color: #000000; font-size: 10px; + font-family: verdana, charcoal, helvetica, arial, sans-serif } + p { margin-left: 2em; margin-right: 2em; } + li { margin-left: 3em; } + ol { margin-left: 2em; margin-right: 2em; } + ul.text { margin-left: 2em; margin-right: 2em; } + pre { margin-left: 3em; color: #333333 } + ul.toc { color: #000000; line-height: 16px; + font-family: verdana, charcoal, helvetica, arial, sans-serif } + H3 { color: #333333; font-size: 16px; line-height: 16px; font-family: helvetica, arial, sans-serif } + H4 { color: #000000; font-size: 14px; font-family: helvetica, arial, sans-serif } + TD.header { color: #ffffff; font-size: 10px; font-family: arial, helvetica, san-serif; valign: top } + TD.author-text { color: #000000; font-size: 10px; + font-family: verdana, charcoal, helvetica, arial, sans-serif } + TD.author { color: #000000; font-weight: bold; margin-left: 4em; font-size: 10px; font-family: verdana, charcoal, helvetica, arial, sans-serif } + A:link { color: #990000; font-weight: bold; + font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif } + A:visited { color: #333333; font-weight: bold; + font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif } + A:name { color: #333333; font-weight: bold; + font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif } + .link2 { color:#ffffff; font-weight: bold; text-decoration: none; + font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif; + font-size: 9px } + .RFC { color:#666666; font-weight: bold; text-decoration: none; + font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif; + font-size: 9px } + .hotText { color:#ffffff; font-weight: normal; text-decoration: none; + font-family: charcoal, monaco, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif; + font-size: 9px } +</style> +</head> +<body bgcolor="#ffffff" text="#000000" alink="#000000" vlink="#666666" link="#990000"> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<table width="66%" border="0" cellpadding="0" cellspacing="0"><tr><td><table width="100%" border="0" cellpadding="2" cellspacing="1"> +<tr valign="top"><td width="33%" bgcolor="#666666" class="header">The README file</td><td width="33%" bgcolor="#666666" class="header">M. Rose</td></tr> +<tr valign="top"><td width="33%" bgcolor="#666666" class="header"> </td><td width="33%" bgcolor="#666666" class="header">Dover Beach Consulting, Inc.</td></tr> +<tr valign="top"><td width="33%" bgcolor="#666666" class="header"> </td><td width="33%" bgcolor="#666666" class="header">February 2002</td></tr> +</table></td></tr></table> +<div align="right"><font face="monaco, MS Sans Serif" color="#990000" size="+3"><b><br><span class="title">The personal.tcl Mailbot</span></b></font></div> +<font face="verdana, helvetica, arial, sans-serif" size="2"> + +<h3>Abstract</h3> + +<p>The personal.tcl mailbot implements a highly-specialized +filter for personal messages. +It MUST not be used by people who receive mailing list traffic in +their personal mailboxes. +</p><a name="toc"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>Table of Contents</h3> +<ul compact class="toc"> +<b><a href="#anchor1">1.</a> +SYNOPSIS<br></b> +<b><a href="#anchor2">1.1</a> +Requirements<br></b> +<b><a href="#anchor3">1.2</a> +Copyrights<br></b> +<b><a href="#anchor4">2.</a> +PHILOSOPHY<br></b> +<b><a href="#anchor5">2.1</a> +Guest Lists<br></b> +<b><a href="#anchor6">3.</a> +BEHAVIOR<br></b> +<b><a href="#anchor7">3.1</a> +Arguments<br></b> +<b><a href="#actions">3.2</a> +Actions<br></b> +<b><a href="#configFile">3.3</a> +The Configuration File<br></b> +<b><a href="#options">3.3.1</a> +Configuration Options<br></b> +<b><a href="#procs">3.3.2</a> +Configurable Procedures<br></b> +<b><a href="#rfc.references1">§</a> +References<br></b> +<b><a href="#rfc.authors">§</a> +Author's Address<br></b> +<b><a href="#impersonal">A.</a> +Impersonal Mail<br></b> +<b><a href="#impersonal.options">A.1</a> +Configuration Options<br></b> +<b><a href="#options.foldersDirectory">A.1.1</a> +foldersDirectory<br></b> +<b><a href="#options.foldersFile">A.1.2</a> +foldersFile<br></b> +<b><a href="#options.announceMailboxes">A.1.3</a> +announceMailboxes<br></b> +<b><a href="#options.mappingFile">A.1.4</a> +mappingFile<br></b> +<b><a href="#impersonal.procs">A.2</a> +Configurable Procedures<br></b> +<b><a href="#procs.impersonalMail">A.2.1</a> +impersonalMail<br></b> +<b><a href="#procs.processFolder">A.2.2</a> +processFolder<br></b> +<b><a href="#anchor8">B.</a> +An Example configFile<br></b> +<b><a href="#anchor9">C.</a> +Acknowledgements<br></b> +</ul> +<br clear="all"> + +<a name="anchor1"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<a name="rfc.section.1"></a><h3>1. SYNOPSIS</h3> + +<p>Create a <a href="#configFile">configuration file</a> +and add this line to your ".forward" file: +</p></font><pre> + "| LIB/mbot-1.1/personal.tcl -config FILE -user USER" +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>where "LIB" is where the Tcl library lives, +"FILE" is the name of your configuration file, +and "USER" is your username. +</p> +<a name="rfc.section.1.1"></a><h4><a name="anchor2">1.1</a> Requirements</h4> + +<p>This package requires: + +<ul class="text"> +<li><a href="http://core.tcl.tk/tcl/">Tcl version 8.3</a> +or later +</li> +<li><a href="http://core.tcl.tk/tcllib/">tcl lib</a> +</li> +<li><a href="http://sourceforge.net/projects/tclx/">TclX version 8.0</a> +or later +</li> +</ul><p> +</p> +<a name="rfc.section.1.2"></a><h4><a name="anchor3">1.2</a> Copyrights</h4> + +<p>(c) 1999-2002 Marshall T. Rose +</p> +<p>Hold harmless the author, and any lawful use is allowed. +</p> +<a name="anchor4"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<a name="rfc.section.2"></a><h3>2. PHILOSOPHY</h3> + +<p>The mailbot's philosophy is simple: + +<ul class="text"> +<li>The mailbot receives all of your incoming personal mail. +</li> +<li>You ALWAYS copy yourself on every message you send, +so that the mailbot receives all of your outgoing personal mail. +</li> +<li>The mailbot performs six tasks, all optional: + +<ul class="text"> +<li>makes audit copies of your incoming and outgoing mail; +</li> +<li>performs duplicate supression; +</li> +<li>performs originator supression by rejecting messages from people +who aren't your friends or on a guest list; +</li> +<li>performs content supression by rejecting messages that contain +attachments with extensions on your prohibited list; +</li> +<li>sends a textual synopsis to your PDA; and, +</li> +<li>sends a copy to your remote mailbox. +</li> +</ul><p> +</li> +</ul><p> +</p> +<p>Do NOT use the personal.tcl mailbot if you receive mailing list +traffic in your personal mailbox. +When sending mail to a mailing list, +either: + +<ul class="text"> +<li>use a "From" address that the personal.tcl mailbot will process as +"impersonal" mail, +(e.g., "hewes+ietf.general@example.com"); or, +</li> +<li>set the "Reply-To" for the message to the mailing list. +</li> +</ul><p> +Consult <a href="#impersonal">Impersonal Mail</a> for information on how +"impersonal" mail is identified and processed. +</p> +<a name="rfc.section.2.1"></a><h4><a name="anchor5">2.1</a> Guest Lists</h4> + +<p>Guest lists are an effective mechanism for cutting back on +excessive mail. + +<ul class="text"> +<li>when the mailbot receives a message from you, +it adds any recipients it finds to a permanent-guest list; +</li> +<li>when the mailbot receives a message from someone on a guest list, +it adds any recipients it finds to a temporary-guest list; but, +</li> +<li>when the mailbot receives a message from someone not on any guest +list, +they get a rejection notice. +</li> +</ul><p> +Note that in order to promote someone to the permanent-guest list, +you must send them a message (with a copy to yourself). +In most cases, +simply replying to the original message accomplishes this. +Of course, +if you don't want to promote someone to the permanent-guest list, +simply remove that address (or your address) from the list of +recipients in your reply. +</p> +<p>Here are the fine points: + +<ul class="text"> +<li>rejection notices contain a passphrase that may be used at most +once to bypass the guest list mechanism +(notices also contain the original message to minimize type-in +by the uninvited); +</li> +<li>a flip-flop is used to avoid mail loops; and, +</li> +<li>messages originated by an administrative address (e.g., +"Postmaster") bypass the guest list mechanism +(unless the message refers to a previously-rejected message, +in which case it is supressed). +</li> +</ul><p> +</p> +<p>The rejection notice should be written carefully to minimize an +extreme negative reaction on the part of the uninvited. +Of course, +by allowing a passphrase, +this provides something of a CQ test for the uninvited -- +if someone can't pass the test... +</p> +<a name="anchor6"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<a name="rfc.section.3"></a><h3>3. BEHAVIOR</h3> + +<a name="rfc.section.3.1"></a><h4><a name="anchor7">3.1</a> Arguments</h4> + +<p>The mailbot supports the following command line arguments: + +<blockquote class="text"><dl> +<dt> -config configFile:</dt> +<dd> +specifies the name of the configuration file to use; +</dd> +<dt> -debug boolean:</dt> +<dd> +enables debug output; +</dd> +<dt> -file messageFile:</dt> +<dd> +specifies the name of the file containing the message; +</dd> +<dt> -originator orginatorAddress:</dt> +<dd> +specifies the email-address of the originator of the message; and, +</dd> +<dt> -user userName:</dt> +<dd> +specifies the user-identity of the recipient. +</dd> +</dl></blockquote><p> +Note that if "-user" is given, +then the working directory is set to userName's home directory before +configFile is sourced, +and the umask is set defensively. +</p> +<p>The default values are: +</p></font><pre> + personal.tcl -config .personal-config.tcl \ + -debug 0 \ + -file - \ + -originator "derived from message" +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Given the default values, +only "-user" need be specified. +The reason is that if a message is being delivered to multiple local +recipients, +and if any of the ".forward" files are identical in content, +then sendmail may not deliver the message to all of the local +recipients. +</p> +<p>A few other (sendmail related) tips: + +<ul class="text"> +<li>If sendmail is configured with smrsh, +you'll need to symlink personal.tcl into the +/usr/libexec/sm.bin/ directory. +</li> +<li>Make sure that tclsh8.0 is in the path specified on the third-line +of personal.tcl. +</li> +<li>You should chmod your ".forward" file to 0600. +</li> +</ul><p> +</p> +<a name="rfc.section.3.2"></a><h4><a name="actions">3.2</a> Actions</h4> + +<p>The mailbot begins by parsing its arguments, +sourcing configFile, +and then examining the incoming message: + +<ol class="text"> +<li>If <a href="#options.auditInFile">auditInFile</a> is set, +a copy of the message is +<a href="#procs.saveMessage">saved</a> there. +</li> +<li>If the message contains a previously-encountered "Message-ID", +processing terminates. +</li> +<li>If the message's originator can not be determined, +a copy of the message is +<a href="#procs.saveMessage">saved</a> in the +<a href="#options.defaultMaildrop">defaultMaildrop</a> and +processing terminates. +</li> +<li>The originator's email-address is examined: + +<ol class="text"> +<li>If the originator appears to be an +<a href="#procs.adminP">automated administrative process</a>, +and if a previously rejected email-address is found in the message, +processing terminates. +</li> +<li>Otherwise, +if the originator isn't <a href="#procs.ownerP">the user</a>, +or <a href="#procs.friendP">a friend</a>, +or a permanent-access guest, +or a temporary-access guest, +and if <a href="#options.noticeFile">noticeFile</a> is set, +then the message is rejected. +</li> +<li>Otherwise, +each recipient email-address in the message's header is added to a guest +list. +(If the originator is <a href="#procs.ownerP">the user</a>, +the permanent-guest list is used instead of the temporary-guest +list.) +</li> +</ol><p> +</li> +<li>If the originator is the <a href="#procs.ownerP">the user</a>, +then: + +<ol class="text"> +<li>If <a href="#options.auditOutFile">auditOutFile</a> is set, +<a href="#procs.saveMessage">saved</a> there. +</li> +<li>Regardless, processing terminates. +</li> +</ol><p> +</li> +<li>If <a href="#options.pdaMailboxes">pdaMailboxes</a> is set, +and if any plaintext is contained in the message, +then the plaintext is sent to those email-addresses. +</li> +<li>If <a href="#options.remoteMailboxes">remoteMailboxes</a> is set, +and if the message is successful resent to those email-addresses, +then processing terminates. +</li> +<li>A copy of the message is +<a href="#procs.saveMessage">saved</a> in the +<a href="#options.defaultMaildrop">defaultMaildrop</a> and +processing terminates. +</li> +</ol><p> +</p> +<a name="rfc.section.3.3"></a><h4><a name="configFile">3.3</a> The Configuration File</h4> + +<p>There are two kinds of information that may be defined in configFile: +<a href="#options">configuration options</a> and +<a href="#procs">configurable procedures</a>. +</p> +<p>Here's a simple example of a configFile for a user named +"example": +</p></font><pre> + set options(dataDirectory) .personal + set options(defaultMaildrop) /var/mail/example + set options(logFile) [file join .personal personal.log] + set options(noticeFile) [file join .personal notice.txt] +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<a name="rfc.section.3.3.1"></a><h4><a name="options">3.3.1</a> Configuration Options</h4> + +<p>configFile must define +<a href="#options.dataDirectory">dataDirectory</a> +and +<a href="#options.defaultMaildrop">defaultMaildrop</a>. +All other configuration options are optional. +</p> +<a name="rfc.section.3.3.1.1"></a><h4><a name="options.dataDirectory">3.3.1.1</a> dataDirectory</h4> + +<p>The directory where the mailbot keeps its databases. +The subdirectories are: + +<blockquote class="text"><dl> +<dt> badaddrs:</dt> +<dd>the directory of rejected email-addresses +</dd> +<dt> inaddrs:</dt> +<dd>the directory of originator email-addresses +</dd> +<dt> msgids:</dt> +<dd>the directory of Message-IDs +</dd> +<dt> outaddrs:</dt> +<dd>the permanent-guest list +</dd> +<dt> phrases:</dt> +<dd>the directory of at-most-once passphrases +</dd> +<dt> tmpaddrs:</dt> +<dd>the temporary-guest list +</dd> +</dl></blockquote><p> +If you want to remove someone from a guest list, +simply go to that directory and delete the corresponding file. +</p> +<a name="rfc.section.3.3.1.2"></a><h4><a name="options.defaultMaildrop">3.3.1.2</a> defaultMaildrop</h4> + +<p>The filename where messages are +<a href="#procs.saveMessage">saved</a> for later viewing by +your user agent. +</p> +<a name="rfc.section.3.3.1.3"></a><h4><a name="options.auditInFile">3.3.1.3</a> auditInFile</h4> + +<p>The filename where messages are +<a href="#procs.saveMessage">saved</a> for audit purposes. +</p> +<a name="rfc.section.3.3.1.4"></a><h4><a name="options.auditOutFile">3.3.1.4</a> auditOutFile</h4> + +<p>The filename where your outgoing messages are +<a href="#procs.saveMessage">saved</a> for audit purposes. +</p> +<a name="rfc.section.3.3.1.5"></a><h4><a name="options.dropNames">3.3.1.5</a> dropNames</h4> + +<p>A list of filename extensions for attachments that automatically +cause the message to be rejected. +</p> +<a name="rfc.section.3.3.1.6"></a><h4><a name="options.friendlyDomains">3.3.1.6</a> friendlyDomains</h4> + +<p>A list used by <a href="#procs.friendP">friendP</a> giving +the domain names where your friends live. +</p> +<a name="rfc.section.3.3.1.7"></a><h4><a name="options.friendlyfire">3.3.1.7</a> friendlyfire</h4> + +<p>If present and true, +then someone sending a message both to you and someone you've +previously sent mail to, +is considered a friend. +</p> +<a name="rfc.section.3.3.1.8"></a><h4><a name="options.logFile">3.3.1.8</a> logFile</h4> + +<p>The filename where the mailbot +<a href="#procs.tclLog">logs</a> its actions. +</p> +<a name="rfc.section.3.3.1.9"></a><h4><a name="options.myMailbox">3.3.1.9</a> myMailbox</h4> + +<p>Your preferred email-address with commentary text, e.g., +</p></font><pre> + Arlington Hewes <hewes@example.com> +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<a name="rfc.section.3.3.1.10"></a><h4><a name="options.noticeFile">3.3.1.10</a> noticeFile</h4> + +<p>The filename containing the textual notice sent when a message is +rejected. +Note that all occurrances of "%passPhrase%" within this file are +replaced with an at-most-once passphrase allowing the originator to +bypass the mailbot's filtering. +Similarly, +any occurrences of "%subject%" are replaced by the "Subject" of the +incoming message. +</p> +<a name="rfc.section.3.3.1.11"></a><h4><a name="options.pdaMailboxes">3.3.1.11</a> pdaMailboxes</h4> + +<p>The email-addresses where a textual synopsis of the incoming message is +sent. +</p> +<a name="rfc.section.3.3.1.12"></a><h4><a name="options.remoteMailboxes">3.3.1.12</a> remoteMailboxes</h4> + +<p>The email-addresses where a copy of the incoming message is resent. +</p> +<a name="rfc.section.3.3.2"></a><h4><a name="procs">3.3.2</a> Configurable Procedures</h4> + +<p>All of these procedures are defined in personal.tcl. +You may override any of them in configFile. +</p> +<a name="rfc.section.3.3.2.1"></a><h4><a name="procs.adminP">3.3.2.1</a> adminP</h4> +</font><pre> + proc adminP {local domain} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Returns "1" if the email-address is an automated administrative +process. +</p> +<a name="rfc.section.3.3.2.2"></a><h4><a name="procs.friendP">3.3.2.2</a> friendP</h4> +</font><pre> + proc friendP {local domain} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Returns "1" if the email-address is from a +<a href="#options.friendlyDomains">friendly domain</a> or +sub-domain. +</p> +<a name="rfc.section.3.3.2.3"></a><h4><a name="procs.ownerP">3.3.2.3</a> ownerP</h4> +</font><pre> + proc ownerP {local domain} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Returns "1" if the email-address refers to the user +(as determined by looking at +<a href="#options.myMailbox">myMailbox</a>, +<a href="#options.pdaMailboxes">pdaMailboxes</a>, and +<a href="#options.remoteMailboxes">remoteMailboxes</a>. +</p> +<a name="rfc.section.3.3.2.4"></a><h4><a name="procs.saveMessage">3.3.2.4</a> saveMessage</h4> +</font><pre> + proc saveMessage {inF {outF ""}} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Saves a copy of the message contained in the file inF. +If the destination file, +outF, +isn't specified, +it defaults to the +<a href="#options.defaultMaildrop">defaultMaildrop</a>. +</p> +<a name="rfc.section.3.3.2.5"></a><h4><a name="procs.findPhrase">3.3.2.5</a> findPhrase</h4> +</font><pre> + proc findPhrase {subject} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Returns "1" if a previously-allocated passphrase is present in the +subject. +If so, +the passphrase is forgotten. +</p> +<a name="rfc.section.3.3.2.6"></a><h4><a name="procs.makePhrase">3.3.2.6</a> makePhrase</h4> +</font><pre> + proc makePhrase {} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Returns an at-most-once passphrase for use with a rejection notice. +</p> +<a name="rfc.section.3.3.2.7"></a><h4><a name="procs.pruneDir">3.3.2.7</a> pruneDir</h4> +</font><pre> + proc pruneDir {dir type} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Removes old entries from one of the mailbot's +<a href="#options.dataDirectory">databases</a>. +The second parameter is one of "addr", "msgid", or "phrase". +</p> +<a name="rfc.section.3.3.2.8"></a><h4><a name="procs.tclLog">3.3.2.8</a> tclLog</h4> +</font><pre> + proc tclLog {message} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Writes a message to the <a href="#options.logFile">logFile</a>. +</p> +<a name="rfc.references1"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>References</h3> +<table width="99%" border="0"> +</table> + +<a name="rfc.authors"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<h3>Author's Address</h3> +<table width="99%" border="0" cellpadding="0" cellspacing="0"> +<tr><td class="author-text"> </td> +<td class="author-text">Marshall T. Rose</td></tr> +<tr><td class="author-text"> </td> +<td class="author-text">Dover Beach Consulting, Inc.</td></tr> +<tr><td class="author-text"> </td> +<td class="author-text">POB 255268</td></tr> +<tr><td class="author-text"> </td> +<td class="author-text">Sacramento, CA 95865-5268</td></tr> +<tr><td class="author-text"> </td> +<td class="author-text">US</td></tr> +<tr><td class="author" align="right">Phone: </td> +<td class="author-text">+1 916 483 8878</td></tr> +<tr><td class="author" align="right">Fax: </td> +<td class="author-text">+1 916 483 8848</td></tr> +<tr><td class="author" align="right">EMail: </td> +<td class="author-text"><a href="mailto:mrose@dbc.mtview.ca.us">mrose@dbc.mtview.ca.us</a></td></tr> +</table> + +<a name="impersonal"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<a name="rfc.section.A"></a><h3>Appendix A. Impersonal Mail</h3> + +<p>If <a href="#procs.impersonalMail">impersonalMail</a> +returns a non-empty string +then the message is processed differently than the algorithm given in +<a href="#actions">Actions</a>. +Specifically: + +<ol class="text"> +<li>If the message contains a previously-encountered "Message-ID", +processing terminates. +</li> +<li>If the message's originator can not be determined, +processing terminates. +</li> +<li>The value returned by +<a href="#procs.impersonalMail">impersonalMail</a> +is the folder's name and is broken into one or more components +seperated by dots ("."). +If there aren't at least two components, +or if any of the components are empty +(e.g., the folder is named "sys..announce"), +then the message is bounced. +</li> +<li>If <a href="#options.mappingFile">mappingFile</a> exists, +that file is examined to see if an entry is present for the folder. +If so, +the message is processed according to the value present, +one of: + +<blockquote class="text"><dl> +<dt> "ignore":</dt> +<dd>the message is silently ignored; +</dd> +<dt> "bounce":</dt> +<dd>the message is noisily bounced; or, +</dd> +<dt> otherwise:</dt> +<dd>the message is resent to the address. +</dd> +</dl></blockquote><p> +Regardless, +if an entry was present for the folder, +then processing terminates. +</li> +<li>The message is <a href="#procs.saveMessage">saved</a> +in a file whose name is constructed by replacing each dot (".") in the +folder name with a directory seperator +(e.g., if the folder is named "sys.announce", +then the file is called "announce" underneath the directory "sys" +underneath the directory identified by +<a href="#options.foldersDirectory">foldersDirectory</a>. +</li> +<li>Finally, +the file identified by <a href="#options.foldersFile">foldersFile</a> +is updated as necessary. +</li> +</ol><p> +</p> +<a name="rfc.section.A.1"></a><h4><a name="impersonal.options">A.1</a> Configuration Options</h4> + +<p>If "impersonal" mail is received, +then <a href="#options.foldersFile">foldersFile</a> and +<a href="#options.foldersDirectory">foldersDirectory</a> +must exist. +</p> +<a name="rfc.section.A.1.1"></a><h4><a name="options.foldersDirectory">A.1.1</a> foldersDirectory</h4> + +<p>The directory where the mailbot keeps private folders. +</p> +<a name="rfc.section.A.1.2"></a><h4><a name="options.foldersFile">A.1.2</a> foldersFile</h4> + +<p>This file contains one line for each private folder. +</p> +<a name="rfc.section.A.1.3"></a><h4><a name="options.announceMailboxes">A.1.3</a> announceMailboxes</h4> + +<p>The email-addresses where an announcement is sent when a new +private folder is created. +</p> +<a name="rfc.section.A.1.4"></a><h4><a name="options.mappingFile">A.1.4</a> mappingFile</h4> + +<p>The file consulted by the mailbot to determine how to process +"impersonal" messages. +Each line of the file consists of a folder name and value, +seperated by a colon (":"). +There are three reserved values: "bounce", "ignore", and "store". +</p> +<a name="rfc.section.A.2"></a><h4><a name="impersonal.procs">A.2</a> Configurable Procedures</h4> + +<p>All of these procedures are defined in personal.tcl. +You may override any of them in configFile. +</p> +<a name="rfc.section.A.2.1"></a><h4><a name="procs.impersonalMail">A.2.1</a> impersonalMail</h4> +</font><pre> + proc impersonalMail {} +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>If the message is deemed "impersonal", +return the name of a corresponding private folder; +otherwise, +return the empty-string. +</p> +<p>Many mail systems have a mechanism of passing additional +information when performing final delivery using a program. +With modern versions of sendmail, +for example, +if mail is sent to a local user named "user+detail", +then, +in the absense of an alias for either "user+detail" or "user+*", +then the message is delivered to "user". +The trick is to get sendmail to pass the "detail" part to the mailbot. +</p> +<p>At present, +sendmail passes this information only if procmail is your local +mailer. +Here's how I do it: +</p></font><pre> + *** _alias.c Tue Dec 29 10:42:25 1998 + --- alias.c Sat Sep 18 21:51:35 1999 + *************** + *** 813,818 **** + --- 813,821 ---- + define('z', user->q_home, e); + define('u', user->q_user, e); + define('h', user->q_host, e); + + + + setuserenv("SUFFIX", user->q_host); + + + if (ForwardPath == NULL) + ForwardPath = newstr("\201z/.forward"); +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>This makes available an environment variable called +"SUFFIX" which has the "details" part. +The drawback in this approach is that this information is lost if the +message is re-queued for delivery +(what's really needed is an addition to the .forward syntax to allow +macros such as $h to be passed). +</p> +<p>The corresponding impersonalMail procedure is defined as: +</p></font><pre> + proc impersonalMail {} { + global env + + return $env(SUFFIX) + } +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<a name="rfc.section.A.2.2"></a><h4><a name="procs.processFolder">A.2.2</a> processFolder</h4> +</font><pre> + proc processFolder {folderName mimeT} { return $string } +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>If an entry for the folder exists in the +<a href="#options.mappingFile">mappingFile</a>, +and if the value for that entry is "process", +then this procedure is invoked to return a string indicating what +action to take +(cf., <a href="#impersonal">Impersonal Mail</a>). +</p> +<a name="anchor8"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<a name="rfc.section.B"></a><h3>Appendix B. An Example configFile</h3> + +<p>Here is the ".forward" file for the user "hewes": +</p></font><pre> + "|/usr/pkg/lib/mbot-1.1/personal.tcl + -config .personal/config.tcl -user hewes" +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>(Of course, it's all on one line.) +</p> +<p>Here is the user's ".personal/config.tcl" file: +</p></font><pre> + array set options [list \ + dataDirectory .personal \ + defaultMaildrop /var/mail/hewes \ + auditInFile [file join .personal INCOMING] \ + auditOutFile [file join .personal OUTGOING] \ + friendlyDomains [list tcp.int example.com] \ + logFile [file join .personal personal.log] \ + myMailbox "Arlington Hewes <hewes@example.com>" \ + pdaMailboxes hewes.pager@example.com \ + noticeFile [file join .personal notice.txt] \ + foldersDirectory [file join .personal folders] \ + foldersFile [file join .personal .mailboxlist] \ + announceMailboxes hewes+sys.announce@example.com \ + mappingFile [file join .personal mapping] \ + friendlyFire 1 \ + dropNames [list *.bat *.exe *.src *.pif *.wav *.vbs] \ + ] + + proc impersonalMail {} { + global env + + return $env(SUFFIX) + } +</pre><font face="verdana, helvetica, arial, sans-serif" size="2"> + +<p>Note that because +<a href="#options.remoteMailboxes">remoteMailboxes</a> isn't +defined, +personal messages are ultimately stored in the user's +<a href="#options.defaultMaildrop">defaultMaildrop</a>. +</p> +<a name="anchor9"><br><hr size="1" shade="0"></a> +<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b> TOC </b></font></a><br></td></tr></table> +<a name="rfc.section.C"></a><h3>Appendix C. Acknowledgements</h3> + +<p>The original version of this mailbot was written by the author in 1994, +implemented using the safe-tcl package +(Borenstein and Rose, circa 1993). +</p></font></body></html> diff --git a/tcllib/examples/mime/mbot/README.txt b/tcllib/examples/mime/mbot/README.txt new file mode 100644 index 0000000..509d502 --- /dev/null +++ b/tcllib/examples/mime/mbot/README.txt @@ -0,0 +1,1008 @@ + + +The README file M. Rose + Dover Beach Consulting, Inc. + February 2002 + + + The personal.tcl Mailbot + + +Abstract + + The personal.tcl mailbot implements a highly-specialized filter for + personal messages. It MUST not be used by people who receive mailing + list traffic in their personal mailboxes. + +Table of Contents + + 1. SYNOPSIS . . . . . . . . . . . . . . . . . . . . . . . . . . 2 + 1.1 Requirements . . . . . . . . . . . . . . . . . . . . . . . . 2 + 1.2 Copyrights . . . . . . . . . . . . . . . . . . . . . . . . . 2 + 2. PHILOSOPHY . . . . . . . . . . . . . . . . . . . . . . . . . 3 + 2.1 Guest Lists . . . . . . . . . . . . . . . . . . . . . . . . 4 + 3. BEHAVIOR . . . . . . . . . . . . . . . . . . . . . . . . . . 5 + 3.1 Arguments . . . . . . . . . . . . . . . . . . . . . . . . . 5 + 3.2 Actions . . . . . . . . . . . . . . . . . . . . . . . . . . 6 + 3.3 The Configuration File . . . . . . . . . . . . . . . . . . . 7 + 3.3.1 Configuration Options . . . . . . . . . . . . . . . . . . . 7 + 3.3.2 Configurable Procedures . . . . . . . . . . . . . . . . . . 10 + References . . . . . . . . . . . . . . . . . . . . . . . . . 12 + Author's Address . . . . . . . . . . . . . . . . . . . . . . 12 + A. Impersonal Mail . . . . . . . . . . . . . . . . . . . . . . 13 + A.1 Configuration Options . . . . . . . . . . . . . . . . . . . 14 + A.1.1 foldersDirectory . . . . . . . . . . . . . . . . . . . . . . 14 + A.1.2 foldersFile . . . . . . . . . . . . . . . . . . . . . . . . 14 + A.1.3 announceMailboxes . . . . . . . . . . . . . . . . . . . . . 14 + A.1.4 mappingFile . . . . . . . . . . . . . . . . . . . . . . . . 14 + A.2 Configurable Procedures . . . . . . . . . . . . . . . . . . 15 + A.2.1 impersonalMail . . . . . . . . . . . . . . . . . . . . . . . 15 + A.2.2 processFolder . . . . . . . . . . . . . . . . . . . . . . . 16 + B. An Example configFile . . . . . . . . . . . . . . . . . . . 17 + C. Acknowledgements . . . . . . . . . . . . . . . . . . . . . . 18 + + + + + + + + + + + + +Rose [Page 1] + +README The personal.tcl Mailbot February 2002 + + +1. SYNOPSIS + + Create a configuration file (Section 3.3) and add this line to your + ".forward" file: + + "| LIB/mbot-1.1/personal.tcl -config FILE -user USER" + + where "LIB" is where the Tcl library lives, "FILE" is the name of + your configuration file, and "USER" is your username. + +1.1 Requirements + + This package requires: + + o Tcl version 8.3 [1] or later + + o tcl lib [2] + + o TclX version 8.0 [3] or later + + +1.2 Copyrights + + (c) 1999-2002 Marshall T. Rose + + Hold harmless the author, and any lawful use is allowed. + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 2] + +README The personal.tcl Mailbot February 2002 + + +2. PHILOSOPHY + + The mailbot's philosophy is simple: + + o The mailbot receives all of your incoming personal mail. + + o You ALWAYS copy yourself on every message you send, so that the + mailbot receives all of your outgoing personal mail. + + o The mailbot performs six tasks, all optional: + + * makes audit copies of your incoming and outgoing mail; + + * performs duplicate supression; + + * performs originator supression by rejecting messages from + people who aren't your friends or on a guest list; + + * performs content supression by rejecting messages that contain + attachments with extensions on your prohibited list; + + * sends a textual synopsis to your PDA; and, + + * sends a copy to your remote mailbox. + + Do NOT use the personal.tcl mailbot if you receive mailing list + traffic in your personal mailbox. When sending mail to a mailing + list, either: + + o use a "From" address that the personal.tcl mailbot will process as + "impersonal" mail, (e.g., "hewes+ietf.general@example.com"); or, + + o set the "Reply-To" for the message to the mailing list. + + Consult Appendix A for information on how "impersonal" mail is + identified and processed. + + + + + + + + + + + + + + + +Rose [Page 3] + +README The personal.tcl Mailbot February 2002 + + +2.1 Guest Lists + + Guest lists are an effective mechanism for cutting back on excessive + mail. + + o when the mailbot receives a message from you, it adds any + recipients it finds to a permanent-guest list; + + o when the mailbot receives a message from someone on a guest list, + it adds any recipients it finds to a temporary-guest list; but, + + o when the mailbot receives a message from someone not on any guest + list, they get a rejection notice. + + Note that in order to promote someone to the permanent-guest list, + you must send them a message (with a copy to yourself). In most + cases, simply replying to the original message accomplishes this. Of + course, if you don't want to promote someone to the permanent-guest + list, simply remove that address (or your address) from the list of + recipients in your reply. + + Here are the fine points: + + o rejection notices contain a passphrase that may be used at most + once to bypass the guest list mechanism (notices also contain the + original message to minimize type-in by the uninvited); + + o a flip-flop is used to avoid mail loops; and, + + o messages originated by an administrative address (e.g., + "Postmaster") bypass the guest list mechanism (unless the message + refers to a previously-rejected message, in which case it is + supressed). + + The rejection notice should be written carefully to minimize an + extreme negative reaction on the part of the uninvited. Of course, + by allowing a passphrase, this provides something of a CQ test for + the uninvited -- if someone can't pass the test... + + + + + + + + + + + + + +Rose [Page 4] + +README The personal.tcl Mailbot February 2002 + + +3. BEHAVIOR + +3.1 Arguments + + The mailbot supports the following command line arguments: + + -config configFile: specifies the name of the configuration file + to use; + + -debug boolean: enables debug output; + + -file messageFile: specifies the name of the file containing the + message; + + -originator orginatorAddress: specifies the email-address of the + originator of the message; and, + + -user userName: specifies the user-identity of the recipient. + + Note that if "-user" is given, then the working directory is set to + userName's home directory before configFile is sourced, and the umask + is set defensively. + + The default values are: + + personal.tcl -config .personal-config.tcl \ + -debug 0 \ + -file - \ + -originator "derived from message" + + Given the default values, only "-user" need be specified. The reason + is that if a message is being delivered to multiple local recipients, + and if any of the ".forward" files are identical in content, then + sendmail may not deliver the message to all of the local recipients. + + A few other (sendmail related) tips: + + o If sendmail is configured with smrsh, you'll need to symlink + personal.tcl into the /usr/libexec/sm.bin/ directory. + + o Make sure that tclsh8.0 is in the path specified on the third-line + of personal.tcl. + + o You should chmod your ".forward" file to 0600. + + + + + + + +Rose [Page 5] + +README The personal.tcl Mailbot February 2002 + + +3.2 Actions + + The mailbot begins by parsing its arguments, sourcing configFile, and + then examining the incoming message: + + 1. If auditInFile (Section 3.3.1.3) is set, a copy of the message is + saved (Section 3.3.2.4) there. + + 2. If the message contains a previously-encountered "Message-ID", + processing terminates. + + 3. If the message's originator can not be determined, a copy of the + message is saved (Section 3.3.2.4) in the defaultMaildrop + (Section 3.3.1.2) and processing terminates. + + 4. The originator's email-address is examined: + + 1. If the originator appears to be an automated administrative + process (Section 3.3.2.1), and if a previously rejected + email-address is found in the message, processing terminates. + + 2. Otherwise, if the originator isn't the user (Section + 3.3.2.3), or a friend (Section 3.3.2.2), or a permanent- + access guest, or a temporary-access guest, and if noticeFile + (Section 3.3.1.10) is set, then the message is rejected. + + 3. Otherwise, each recipient email-address in the message's + header is added to a guest list. (If the originator is the + user (Section 3.3.2.3), the permanent-guest list is used + instead of the temporary-guest list.) + + 5. If the originator is the the user (Section 3.3.2.3), then: + + 1. If auditOutFile (Section 3.3.1.4) is set, saved (Section + 3.3.2.4) there. + + 2. Regardless, processing terminates. + + 6. If pdaMailboxes (Section 3.3.1.11) is set, and if any plaintext + is contained in the message, then the plaintext is sent to those + email-addresses. + + 7. If remoteMailboxes (Section 3.3.1.12) is set, and if the message + is successful resent to those email-addresses, then processing + terminates. + + 8. A copy of the message is saved (Section 3.3.2.4) in the + defaultMaildrop (Section 3.3.1.2) and processing terminates. + + + +Rose [Page 6] + +README The personal.tcl Mailbot February 2002 + + +3.3 The Configuration File + + There are two kinds of information that may be defined in configFile: + configuration options (Section 3.3.1) and configurable procedures + (Section 3.3.2). + + Here's a simple example of a configFile for a user named "example": + + set options(dataDirectory) .personal + set options(defaultMaildrop) /var/mail/example + set options(logFile) [file join .personal personal.log] + set options(noticeFile) [file join .personal notice.txt] + + +3.3.1 Configuration Options + + configFile must define dataDirectory (Section 3.3.1.1) and + defaultMaildrop (Section 3.3.1.2). All other configuration options + are optional. + +3.3.1.1 dataDirectory + + The directory where the mailbot keeps its databases. The + subdirectories are: + + badaddrs: the directory of rejected email-addresses + + inaddrs: the directory of originator email-addresses + + msgids: the directory of Message-IDs + + outaddrs: the permanent-guest list + + phrases: the directory of at-most-once passphrases + + tmpaddrs: the temporary-guest list + + If you want to remove someone from a guest list, simply go to that + directory and delete the corresponding file. + +3.3.1.2 defaultMaildrop + + The filename where messages are saved (Section 3.3.2.4) for later + viewing by your user agent. + +3.3.1.3 auditInFile + + The filename where messages are saved (Section 3.3.2.4) for audit + + + +Rose [Page 7] + +README The personal.tcl Mailbot February 2002 + + + purposes. + +3.3.1.4 auditOutFile + + The filename where your outgoing messages are saved (Section 3.3.2.4) + for audit purposes. + +3.3.1.5 dropNames + + A list of filename extensions for attachments that automatically + cause the message to be rejected. + +3.3.1.6 friendlyDomains + + A list used by friendP (Section 3.3.2.2) giving the domain names + where your friends live. + +3.3.1.7 friendlyfire + + If present and true, then someone sending a message both to you and + someone you've previously sent mail to, is considered a friend. + +3.3.1.8 logFile + + The filename where the mailbot logs (Section 3.3.2.8) its actions. + +3.3.1.9 myMailbox + + Your preferred email-address with commentary text, e.g., + + Arlington Hewes <hewes@example.com> + + +3.3.1.10 noticeFile + + The filename containing the textual notice sent when a message is + rejected. Note that all occurrances of "%passPhrase%" within this + file are replaced with an at-most-once passphrase allowing the + originator to bypass the mailbot's filtering. Similarly, any + occurrences of "%subject%" are replaced by the "Subject" of the + incoming message. + +3.3.1.11 pdaMailboxes + + The email-addresses where a textual synopsis of the incoming message + is sent. + + + + + +Rose [Page 8] + +README The personal.tcl Mailbot February 2002 + + +3.3.1.12 remoteMailboxes + + The email-addresses where a copy of the incoming message is resent. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 9] + +README The personal.tcl Mailbot February 2002 + + +3.3.2 Configurable Procedures + + All of these procedures are defined in personal.tcl. You may + override any of them in configFile. + +3.3.2.1 adminP + + proc adminP {local domain} + + Returns "1" if the email-address is an automated administrative + process. + +3.3.2.2 friendP + + proc friendP {local domain} + + Returns "1" if the email-address is from a friendly domain (Section + 3.3.1.6) or sub-domain. + +3.3.2.3 ownerP + + proc ownerP {local domain} + + Returns "1" if the email-address refers to the user (as determined by + looking at myMailbox (Section 3.3.1.9), pdaMailboxes (Section + 3.3.1.11), and remoteMailboxes (Section 3.3.1.12). + +3.3.2.4 saveMessage + + proc saveMessage {inF {outF ""}} + + Saves a copy of the message contained in the file inF. If the + destination file, outF, isn't specified, it defaults to the + defaultMaildrop (Section 3.3.1.2). + +3.3.2.5 findPhrase + + proc findPhrase {subject} + + Returns "1" if a previously-allocated passphrase is present in the + subject. If so, the passphrase is forgotten. + +3.3.2.6 makePhrase + + proc makePhrase {} + + Returns an at-most-once passphrase for use with a rejection notice. + + + + +Rose [Page 10] + +README The personal.tcl Mailbot February 2002 + + +3.3.2.7 pruneDir + + proc pruneDir {dir type} + + Removes old entries from one of the mailbot's databases (Section + 3.3.1.1). The second parameter is one of "addr", "msgid", or + "phrase". + +3.3.2.8 tclLog + + proc tclLog {message} + + Writes a message to the logFile (Section 3.3.1.8). + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 11] + +README The personal.tcl Mailbot February 2002 + + +References + + [1] <http://core.tcl.tk/tcl/> + + [2] <http://core.tcl.tk/tcllib/> + + [3] <http://sourceforge.net/projects/tclx/> + + +Author's Address + + Marshall T. Rose + Dover Beach Consulting, Inc. + POB 255268 + Sacramento, CA 95865-5268 + US + + Phone: +1 916 483 8878 + Fax: +1 916 483 8848 + EMail: mrose@dbc.mtview.ca.us + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 12] + +README The personal.tcl Mailbot February 2002 + + +Appendix A. Impersonal Mail + + If impersonalMail (Appendix A.2.1) returns a non-empty string then + the message is processed differently than the algorithm given in + Section 3.2. Specifically: + + 1. If the message contains a previously-encountered "Message-ID", + processing terminates. + + 2. If the message's originator can not be determined, processing + terminates. + + 3. The value returned by impersonalMail (Appendix A.2.1) is the + folder's name and is broken into one or more components seperated + by dots ("."). If there aren't at least two components, or if + any of the components are empty (e.g., the folder is named + "sys..announce"), then the message is bounced. + + 4. If mappingFile (Appendix A.1.4) exists, that file is examined to + see if an entry is present for the folder. If so, the message is + processed according to the value present, one of: + + "ignore": the message is silently ignored; + + "bounce": the message is noisily bounced; or, + + otherwise: the message is resent to the address. + + Regardless, if an entry was present for the folder, then + processing terminates. + + 5. The message is saved (Section 3.3.2.4) in a file whose name is + constructed by replacing each dot (".") in the folder name with a + directory seperator (e.g., if the folder is named "sys.announce", + then the file is called "announce" underneath the directory "sys" + underneath the directory identified by foldersDirectory (Appendix + A.1.1). + + 6. Finally, the file identified by foldersFile (Appendix A.1.2) is + updated as necessary. + + + + + + + + + + + +Rose [Page 13] + +README The personal.tcl Mailbot February 2002 + + +A.1 Configuration Options + + If "impersonal" mail is received, then foldersFile (Appendix A.1.2) + and foldersDirectory (Appendix A.1.1) must exist. + +A.1.1 foldersDirectory + + The directory where the mailbot keeps private folders. + +A.1.2 foldersFile + + This file contains one line for each private folder. + +A.1.3 announceMailboxes + + The email-addresses where an announcement is sent when a new private + folder is created. + +A.1.4 mappingFile + + The file consulted by the mailbot to determine how to process + "impersonal" messages. Each line of the file consists of a folder + name and value, seperated by a colon (":"). There are three reserved + values: "bounce", "ignore", and "store". + + + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 14] + +README The personal.tcl Mailbot February 2002 + + +A.2 Configurable Procedures + + All of these procedures are defined in personal.tcl. You may + override any of them in configFile. + +A.2.1 impersonalMail + + proc impersonalMail {} + + If the message is deemed "impersonal", return the name of a + corresponding private folder; otherwise, return the empty-string. + + Many mail systems have a mechanism of passing additional information + when performing final delivery using a program. With modern versions + of sendmail, for example, if mail is sent to a local user named + "user+detail", then, in the absense of an alias for either + "user+detail" or "user+*", then the message is delivered to "user". + The trick is to get sendmail to pass the "detail" part to the + mailbot. + + At present, sendmail passes this information only if procmail is your + local mailer. Here's how I do it: + + *** _alias.c Tue Dec 29 10:42:25 1998 + --- alias.c Sat Sep 18 21:51:35 1999 + *************** + *** 813,818 **** + --- 813,821 ---- + define('z', user->q_home, e); + define('u', user->q_user, e); + define('h', user->q_host, e); + + + + setuserenv("SUFFIX", user->q_host); + + + if (ForwardPath == NULL) + ForwardPath = newstr("\201z/.forward"); + + This makes available an environment variable called "SUFFIX" which + has the "details" part. The drawback in this approach is that this + information is lost if the message is re-queued for delivery (what's + really needed is an addition to the .forward syntax to allow macros + such as $h to be passed). + + + + + + + + + +Rose [Page 15] + +README The personal.tcl Mailbot February 2002 + + + The corresponding impersonalMail procedure is defined as: + + proc impersonalMail {} { + global env + + return $env(SUFFIX) + } + + +A.2.2 processFolder + + proc processFolder {folderName mimeT} { return $string } + + If an entry for the folder exists in the mappingFile (Appendix + A.1.4), and if the value for that entry is "process", then this + procedure is invoked to return a string indicating what action to + take (cf., Appendix A). + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 16] + +README The personal.tcl Mailbot February 2002 + + +Appendix B. An Example configFile + + Here is the ".forward" file for the user "hewes": + + "|/usr/pkg/lib/mbot-1.1/personal.tcl + -config .personal/config.tcl -user hewes" + + (Of course, it's all on one line.) + + Here is the user's ".personal/config.tcl" file: + + array set options [list \ + dataDirectory .personal \ + defaultMaildrop /var/mail/hewes \ + auditInFile [file join .personal INCOMING] \ + auditOutFile [file join .personal OUTGOING] \ + friendlyDomains [list tcp.int example.com] \ + logFile [file join .personal personal.log] \ + myMailbox "Arlington Hewes <hewes@example.com>" \ + pdaMailboxes hewes.pager@example.com \ + noticeFile [file join .personal notice.txt] \ + foldersDirectory [file join .personal folders] \ + foldersFile [file join .personal .mailboxlist] \ + announceMailboxes hewes+sys.announce@example.com \ + mappingFile [file join .personal mapping] \ + friendlyFire 1 \ + dropNames [list *.bat *.exe *.src *.pif *.wav *.vbs] \ + ] + + proc impersonalMail {} { + global env + + return $env(SUFFIX) + } + + Note that because remoteMailboxes (Section 3.3.1.12) isn't defined, + personal messages are ultimately stored in the user's defaultMaildrop + (Section 3.3.1.2). + + + + + + + + + + + + + +Rose [Page 17] + +README The personal.tcl Mailbot February 2002 + + +Appendix C. Acknowledgements + + The original version of this mailbot was written by the author in + 1994, implemented using the safe-tcl package (Borenstein and Rose, + circa 1993). + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Rose [Page 18] + diff --git a/tcllib/examples/mime/mbot/README.xml b/tcllib/examples/mime/mbot/README.xml new file mode 100644 index 0000000..8d23d9b --- /dev/null +++ b/tcllib/examples/mime/mbot/README.xml @@ -0,0 +1,720 @@ +<?xml version="1.0"?> +<!DOCTYPE rfc SYSTEM "rfc2629.dtd"> + +<?rfc compact="no"?> +<?rfc toc="yes"?> +<?rfc private="The README file"?> +<?rfc header="README"?> + +<rfc> +<front> +<title>The personal.tcl Mailbot</title> + +<author initials="M.T." surname="Rose" fullname="Marshall T. Rose"> +<organization>Dover Beach Consulting, Inc.</organization> +<address> +<postal> +<street>POB 255268</street> +<city>Sacramento</city> <region>CA</region> <code>95865-5268</code> +<country>US</country> +</postal> +<phone>+1 916 483 8878</phone> +<facsimile>+1 916 483 8848</facsimile> +<email>mrose@dbc.mtview.ca.us</email> +</address> +</author> + +<date month="February" year="2002" /> + +<abstract><t>The personal.tcl mailbot implements a highly-specialized +filter for personal messages. +It MUST not be used by people who receive mailing list traffic in +their personal mailboxes.</t></abstract> +</front> + +<middle> +<section title="SYNOPSIS"> +<figure> +<preamble>Create a <xref target="configFile">configuration file</xref> +and add this line to your ".forward" file:</preamble> +<artwork><![CDATA[ + "| LIB/mbot-1.1/personal.tcl -config FILE -user USER" +]]></artwork> +<postamble>where "LIB" is where the Tcl library lives, +"FILE" is the name of your configuration file, +and "USER" is your username.</postamble> +</figure> + +<section title="Requirements"> +<t>This package requires: +<list style="symbols"> +<t><eref target="http://core.tcl.tk/tcl/">Tcl version 8.3</eref> +or later</t> + +<t><eref target="http://core.tcl.tk/tcllib/">tcl lib</eref></t> + +<t><eref target="http://sourceforge.net/projects/tclx/">TclX version 8.0</eref> +or later</t> +</list></t> +</section> + +<section title="Copyrights"> +<t>(c) 1999-2002 Marshall T. Rose</t> + +<t>Hold harmless the author, and any lawful use is allowed.</t> +</section> +</section> + +<section title="PHILOSOPHY"> +<t>The mailbot's philosophy is simple: +<list style="symbols"> +<t>The mailbot receives all of your incoming personal mail.</t> + +<t>You ALWAYS copy yourself on every message you send, +so that the mailbot receives all of your outgoing personal mail.</t> + +<t>The mailbot performs six tasks, all optional: +<list> +<t>makes audit copies of your incoming and outgoing mail;</t> + +<t>performs duplicate supression;</t> + +<t>performs originator supression by rejecting messages from people +who aren't your friends or on a guest list;</t> + +<t>performs content supression by rejecting messages that contain +attachments with extensions on your prohibited list;</t> + +<t>sends a textual synopsis to your PDA; and,</t> + +<t>sends a copy to your remote mailbox.</t> +</list></t> +</list></t> + +<t>Do NOT use the personal.tcl mailbot if you receive mailing list +traffic in your personal mailbox. +When sending mail to a mailing list, +either: +<list style="symbols"> +<t>use a "From" address that the personal.tcl mailbot will process as +"impersonal" mail, +(e.g., "hewes+ietf.general@example.com"); or,</t> + +<t>set the "Reply-To" for the message to the mailing list.</t> +</list> +Consult <xref target="impersonal" /> for information on how +"impersonal" mail is identified and processed.</t> + +<vspace blankLines="10000" /> + +<section title="Guest Lists"> +<t>Guest lists are an effective mechanism for cutting back on +excessive mail. +<list style="symbols"> +<t>when the mailbot receives a message from you, +it adds any recipients it finds to a permanent-guest list;</t> + +<t>when the mailbot receives a message from someone on a guest list, +it adds any recipients it finds to a temporary-guest list; but,</t> + +<t>when the mailbot receives a message from someone not on any guest +list, +they get a rejection notice.</t> +</list> +Note that in order to promote someone to the permanent-guest list, +you must send them a message (with a copy to yourself). +In most cases, +simply replying to the original message accomplishes this. +Of course, +if you don't want to promote someone to the permanent-guest list, +simply remove that address (or your address) from the list of +recipients in your reply.</t> + +<t>Here are the fine points: +<list style="symbols"> +<t>rejection notices contain a passphrase that may be used at most +once to bypass the guest list mechanism +(notices also contain the original message to minimize type-in +by the uninvited);</t> + +<t>a flip-flop is used to avoid mail loops; and,</t> + +<t>messages originated by an administrative address (e.g., +"Postmaster") bypass the guest list mechanism +(unless the message refers to a previously-rejected message, +in which case it is supressed).</t> +</list></t> + +<t>The rejection notice should be written carefully to minimize an +extreme negative reaction on the part of the uninvited. +Of course, +by allowing a passphrase, +this provides something of a CQ test for the uninvited -- +if someone can't pass the test...</t> +</section> +</section> + +<section title="BEHAVIOR"> +<section title="Arguments"> +<t>The mailbot supports the following command line arguments: +<list style="hanging"> +<t hangText=" -config configFile:"> +specifies the name of the configuration file to use;</t> + +<t hangText=" -debug boolean:"> +enables debug output;</t> + +<t hangText=" -file messageFile:"> +specifies the name of the file containing the message;</t> + +<t hangText=" -originator orginatorAddress:"> +specifies the email-address of the originator of the message; and,</t> + +<t hangText=" -user userName:"> +specifies the user-identity of the recipient.</t> +</list> +Note that if "-user" is given, +then the working directory is set to userName's home directory before +configFile is sourced, +and the umask is set defensively.</t> + +<figure> +<preamble>The default values are:</preamble> +<artwork><![CDATA[ + personal.tcl -config .personal-config.tcl \ + -debug 0 \ + -file - \ + -originator "derived from message" +]]></artwork> +<postamble>Given the default values, +only "-user" need be specified. +The reason is that if a message is being delivered to multiple local +recipients, +and if any of the ".forward" files are identical in content, +then sendmail may not deliver the message to all of the local +recipients.</postamble> +</figure> + +<t>A few other (sendmail related) tips: +<list style="symbols"> +<t>If sendmail is configured with smrsh, +you'll need to symlink personal.tcl into the +/usr/libexec/sm.bin/ directory.</t> + +<t>Make sure that tclsh8.0 is in the path specified on the third-line +of personal.tcl.</t> + +<t>You should chmod your ".forward" file to 0600.</t> +</list></t> +</section> + +<vspace blankLines="10000" /> + +<section anchor="actions" title="Actions"> +<t>The mailbot begins by parsing its arguments, +sourcing configFile, +and then examining the incoming message: +<list style="numbers"> +<t>If <xref target="options.auditInFile">auditInFile</xref> is set, +a copy of the message is +<xref target="procs.saveMessage">saved</xref> there.</t> + +<t>If the message contains a previously-encountered "Message-ID", +processing terminates.</t> + +<t>If the message's originator can not be determined, +a copy of the message is +<xref target="procs.saveMessage">saved</xref> in the +<xref target="options.defaultMaildrop">defaultMaildrop</xref> and +processing terminates.</t> + +<t>The originator's email-address is examined: +<list> +<t>If the originator appears to be an +<xref target="procs.adminP">automated administrative process</xref>, +and if a previously rejected email-address is found in the message, +processing terminates.</t> + +<t>Otherwise, +if the originator isn't <xref target="procs.ownerP">the user</xref>, +or <xref target="procs.friendP">a friend</xref>, +or a permanent-access guest, +or a temporary-access guest, +and if <xref target="options.noticeFile">noticeFile</xref> is set, +then the message is rejected.</t> + +<t>Otherwise, +each recipient email-address in the message's header is added to a guest +list. +(If the originator is <xref target="procs.ownerP">the user</xref>, +the permanent-guest list is used instead of the temporary-guest +list.)</t> +</list></t> + +<t>If the originator is the <xref target="procs.ownerP">the user</xref>, +then: +<list> +<t>If <xref target="options.auditOutFile">auditOutFile</xref> is set, +<xref target="procs.saveMessage">saved</xref> there.</t> + +<t>Regardless, processing terminates.</t> +</list></t> + +<t>If <xref target="options.pdaMailboxes">pdaMailboxes</xref> is set, +and if any plaintext is contained in the message, +then the plaintext is sent to those email-addresses.</t> + +<t>If <xref target="options.remoteMailboxes">remoteMailboxes</xref> is set, +and if the message is successful resent to those email-addresses, +then processing terminates.</t> + +<t>A copy of the message is +<xref target="procs.saveMessage">saved</xref> in the +<xref target="options.defaultMaildrop">defaultMaildrop</xref> and +processing terminates.</t> +</list></t> +</section> + +<section anchor="configFile" title="The Configuration File"> +<t>There are two kinds of information that may be defined in configFile: +<xref target="options">configuration options</xref> and +<xref target="procs">configurable procedures</xref>.</t> + +<figure> +<preamble>Here's a simple example of a configFile for a user named +"example":</preamble> +<artwork><![CDATA[ + set options(dataDirectory) .personal + set options(defaultMaildrop) /var/mail/example + set options(logFile) [file join .personal personal.log] + set options(noticeFile) [file join .personal notice.txt] +]]></artwork> +</figure> + +<section anchor="options" title="Configuration Options"> +<t>configFile must define +<xref target="options.dataDirectory">dataDirectory</xref> +and +<xref target="options.defaultMaildrop">defaultMaildrop</xref>. +All other configuration options are optional.</t> + +<section anchor="options.dataDirectory" title="dataDirectory"> +<t>The directory where the mailbot keeps its databases. +The subdirectories are: +<list style="hanging"> +<t hangText=" badaddrs:">the directory of rejected email-addresses</t> + +<t hangText=" inaddrs:">the directory of originator email-addresses</t> + +<t hangText=" msgids:">the directory of Message-IDs</t> + +<t hangText=" outaddrs:">the permanent-guest list</t> + +<t hangText=" phrases:">the directory of at-most-once passphrases</t> + +<t hangText=" tmpaddrs:">the temporary-guest list</t> +</list> +If you want to remove someone from a guest list, +simply go to that directory and delete the corresponding file.</t> +</section> + +<section anchor="options.defaultMaildrop" title="defaultMaildrop"> +<t>The filename where messages are +<xref target="procs.saveMessage">saved</xref> for later viewing by +your user agent.</t> +</section> + +<section anchor="options.auditInFile" title="auditInFile"> +<t>The filename where messages are +<xref target="procs.saveMessage">saved</xref> for audit purposes.</t> +</section> + +<section anchor="options.auditOutFile" title="auditOutFile"> +<t>The filename where your outgoing messages are +<xref target="procs.saveMessage">saved</xref> for audit purposes.</t> +</section> + +<section anchor="options.dropNames" title="dropNames"> +<t>A list of filename extensions for attachments that automatically +cause the message to be rejected.</t> +</section> + +<section anchor="options.friendlyDomains" title="friendlyDomains"> +<t>A list used by <xref target="procs.friendP">friendP</xref> giving +the domain names where your friends live.</t> +</section> + +<section anchor="options.friendlyfire" title="friendlyfire"> +<t>If present and true, +then someone sending a message both to you and someone you've +previously sent mail to, +is considered a friend.</t> +</section> + +<section anchor="options.logFile" title="logFile"> +<t>The filename where the mailbot +<xref target="procs.tclLog">logs</xref> its actions.</t> +</section> + +<section anchor="options.myMailbox" title="myMailbox"> +<figure> +<preamble>Your preferred email-address with commentary text, e.g.,</preamble> +<artwork><![CDATA[ + Arlington Hewes <hewes@example.com> +]]></artwork> +</figure> +</section> + +<section anchor="options.noticeFile" title="noticeFile"> +<t>The filename containing the textual notice sent when a message is +rejected. +Note that all occurrances of "%passPhrase%" within this file are +replaced with an at-most-once passphrase allowing the originator to +bypass the mailbot's filtering. +Similarly, +any occurrences of "%subject%" are replaced by the "Subject" of the +incoming message.</t> +</section> + +<section anchor="options.pdaMailboxes" title="pdaMailboxes"> +<t>The email-addresses where a textual synopsis of the incoming message is +sent.</t> +</section> + +<section anchor="options.remoteMailboxes" title="remoteMailboxes"> +<t>The email-addresses where a copy of the incoming message is resent.</t> +</section> +</section> + +<vspace blankLines="10000" /> + +<section anchor="procs" title="Configurable Procedures"> +<t>All of these procedures are defined in personal.tcl. +You may override any of them in configFile.</t> + +<section anchor="procs.adminP" title="adminP"> +<figure> +<artwork><![CDATA[ + proc adminP {local domain} +]]></artwork> +</figure> + +<t>Returns "1" if the email-address is an automated administrative +process.</t> +</section> + +<section anchor="procs.friendP" title="friendP"> +<figure> +<artwork><![CDATA[ + proc friendP {local domain} +]]></artwork> +</figure> + +<t>Returns "1" if the email-address is from a +<xref target="options.friendlyDomains">friendly domain</xref> or +sub-domain.</t> +</section> + +<section anchor="procs.ownerP" title="ownerP"> +<figure> +<artwork><![CDATA[ + proc ownerP {local domain} +]]></artwork> +</figure> + +<t>Returns "1" if the email-address refers to the user +(as determined by looking at +<xref target="options.myMailbox">myMailbox</xref>, +<xref target="options.pdaMailboxes">pdaMailboxes</xref>, and +<xref target="options.remoteMailboxes">remoteMailboxes</xref>.</t> +</section> + +<section anchor="procs.saveMessage" title="saveMessage"> +<figure> +<artwork><![CDATA[ + proc saveMessage {inF {outF ""}} +]]></artwork> +</figure> + +<t>Saves a copy of the message contained in the file inF. +If the destination file, +outF, +isn't specified, +it defaults to the +<xref target="options.defaultMaildrop">defaultMaildrop</xref>.</t> +</section> + +<section anchor="procs.findPhrase" title="findPhrase"> +<figure> +<artwork><![CDATA[ + proc findPhrase {subject} +]]></artwork> +</figure> + +<t>Returns "1" if a previously-allocated passphrase is present in the +subject. +If so, +the passphrase is forgotten.</t> +</section> + +<section anchor="procs.makePhrase" title="makePhrase"> +<figure> +<artwork><![CDATA[ + proc makePhrase {} +]]></artwork> +</figure> + +<t>Returns an at-most-once passphrase for use with a rejection notice.</t> +</section> + +<section anchor="procs.pruneDir" title="pruneDir"> +<figure> +<artwork><![CDATA[ + proc pruneDir {dir type} +]]></artwork> +</figure> + +<t>Removes old entries from one of the mailbot's +<xref target="options.dataDirectory">databases</xref>. +The second parameter is one of "addr", "msgid", or "phrase".</t> +</section> + +<section anchor="procs.tclLog" title="tclLog"> +<figure> +<artwork><![CDATA[ + proc tclLog {message} +]]></artwork> +</figure> + +<t>Writes a message to the <xref target="options.logFile">logFile</xref>.</t> +</section> +</section> +</section> + +</section> + +</middle> + +<back> +<references /> + +<section anchor="impersonal" title="Impersonal Mail"> +<t>If <xref target="procs.impersonalMail">impersonalMail</xref> +returns a non-empty string +then the message is processed differently than the algorithm given in +<xref target="actions" />. +Specifically: +<list style="numbers"> +<t>If the message contains a previously-encountered "Message-ID", +processing terminates.</t> + +<t>If the message's originator can not be determined, +processing terminates.</t> + +<t>The value returned by +<xref target="procs.impersonalMail">impersonalMail</xref> +is the folder's name and is broken into one or more components +seperated by dots ("."). +If there aren't at least two components, +or if any of the components are empty +(e.g., the folder is named "sys..announce"), +then the message is bounced.</t> + +<t>If <xref target="options.mappingFile">mappingFile</xref> exists, +that file is examined to see if an entry is present for the folder. +If so, +the message is processed according to the value present, +one of: +<list style="hanging"> +<t hangText=' "ignore":'>the message is silently ignored;</t> + +<t hangText=' "bounce":'>the message is noisily bounced; or,</t> + +<t hangText=" otherwise:">the message is resent to the address.</t> +</list> +Regardless, +if an entry was present for the folder, +then processing terminates.</t> + +<t>The message is <xref target="procs.saveMessage">saved</xref> +in a file whose name is constructed by replacing each dot (".") in the +folder name with a directory seperator +(e.g., if the folder is named "sys.announce", +then the file is called "announce" underneath the directory "sys" +underneath the directory identified by +<xref target="options.foldersDirectory">foldersDirectory</xref>.</t> + +<t>Finally, +the file identified by <xref target="options.foldersFile">foldersFile</xref> +is updated as necessary.</t> +</list></t> + +<vspace blankLines="10000" /> + +<section anchor="impersonal.options" title="Configuration Options"> +<t>If "impersonal" mail is received, +then <xref target="options.foldersFile">foldersFile</xref> and +<xref target="options.foldersDirectory">foldersDirectory</xref> +must exist.</t> + +<section anchor="options.foldersDirectory" title="foldersDirectory"> +<t>The directory where the mailbot keeps private folders.</t> +</section> + +<section anchor="options.foldersFile" title="foldersFile"> +<t>This file contains one line for each private folder.</t> +</section> + +<section anchor="options.announceMailboxes" title="announceMailboxes"> +<t>The email-addresses where an announcement is sent when a new +private folder is created.</t> +</section> + +<section anchor="options.mappingFile" title="mappingFile"> +<t>The file consulted by the mailbot to determine how to process +"impersonal" messages. +Each line of the file consists of a folder name and value, +seperated by a colon (":"). +There are three reserved values: "bounce", "ignore", and "store".</t> +</section> +</section> + +<vspace blankLines="10000" /> + +<section anchor="impersonal.procs" title="Configurable Procedures"> +<t>All of these procedures are defined in personal.tcl. +You may override any of them in configFile.</t> + +<section anchor="procs.impersonalMail" title="impersonalMail"> +<figure> +<artwork><![CDATA[ + proc impersonalMail {} +]]></artwork> +</figure> + +<t>If the message is deemed "impersonal", +return the name of a corresponding private folder; +otherwise, +return the empty-string.</t> + +<t>Many mail systems have a mechanism of passing additional +information when performing final delivery using a program. +With modern versions of sendmail, +for example, +if mail is sent to a local user named "user+detail", +then, +in the absense of an alias for either "user+detail" or "user+*", +then the message is delivered to "user". +The trick is to get sendmail to pass the "detail" part to the mailbot.</t> + +<figure> +<preamble>At present, +sendmail passes this information only if procmail is your local +mailer. +Here's how I do it:</preamble> +<artwork><![CDATA[ + *** _alias.c Tue Dec 29 10:42:25 1998 + --- alias.c Sat Sep 18 21:51:35 1999 + *************** + *** 813,818 **** + --- 813,821 ---- + define('z', user->q_home, e); + define('u', user->q_user, e); + define('h', user->q_host, e); + + + + setuserenv("SUFFIX", user->q_host); + + + if (ForwardPath == NULL) + ForwardPath = newstr("\201z/.forward"); +]]></artwork> +<postamble>This makes available an environment variable called +"SUFFIX" which has the "details" part. +The drawback in this approach is that this information is lost if the +message is re-queued for delivery +(what's really needed is an addition to the .forward syntax to allow +macros such as $h to be passed).</postamble> +</figure> + +<figure> +<preamble>The corresponding impersonalMail procedure is defined as:</preamble> +<artwork><![CDATA[ + proc impersonalMail {} { + global env + + return $env(SUFFIX) + } +]]></artwork> +</figure> +</section> + +<section anchor="procs.processFolder" title="processFolder"> +<figure> +<artwork><![CDATA[ + proc processFolder {folderName mimeT} { return $string } +]]></artwork> +</figure> + +<t>If an entry for the folder exists in the +<xref target="options.mappingFile">mappingFile</xref>, +and if the value for that entry is "process", +then this procedure is invoked to return a string indicating what +action to take +(cf., <xref target="impersonal" />).</t> +</section> +</section> +</section> + +<section title="An Example configFile"> +<figure> +<preamble>Here is the ".forward" file for the user "hewes":</preamble> +<artwork><![CDATA[ + "|/usr/pkg/lib/mbot-1.1/personal.tcl + -config .personal/config.tcl -user hewes" +]]></artwork> +<postamble>(Of course, it's all on one line.)</postamble> +</figure> + +<figure> +<preamble>Here is the user's ".personal/config.tcl" file:</preamble> +<artwork><![CDATA[ + array set options [list \ + dataDirectory .personal \ + defaultMaildrop /var/mail/hewes \ + auditInFile [file join .personal INCOMING] \ + auditOutFile [file join .personal OUTGOING] \ + friendlyDomains [list tcp.int example.com] \ + logFile [file join .personal personal.log] \ + myMailbox "Arlington Hewes <hewes@example.com>" \ + pdaMailboxes hewes.pager@example.com \ + noticeFile [file join .personal notice.txt] \ + foldersDirectory [file join .personal folders] \ + foldersFile [file join .personal .mailboxlist] \ + announceMailboxes hewes+sys.announce@example.com \ + mappingFile [file join .personal mapping] \ + friendlyFire 1 \ + dropNames [list *.bat *.exe *.src *.pif *.wav *.vbs] \ + ] + + proc impersonalMail {} { + global env + + return $env(SUFFIX) + } +]]></artwork> +<postamble>Note that because +<xref target="options.remoteMailboxes">remoteMailboxes</xref> isn't +defined, +personal messages are ultimately stored in the user's +<xref target="options.defaultMaildrop">defaultMaildrop</xref>.</postamble> +</figure> +</section> + +<section title="Acknowledgements"> +<t>The original version of this mailbot was written by the author in 1994, +implemented using the safe-tcl package +(Borenstein and Rose, circa 1993).</t> +</section> + +</back> + +</rfc> diff --git a/tcllib/examples/mime/mbot/impersonal.tcl b/tcllib/examples/mime/mbot/impersonal.tcl new file mode 100755 index 0000000..209baa6 --- /dev/null +++ b/tcllib/examples/mime/mbot/impersonal.tcl @@ -0,0 +1,531 @@ +#!/usr/bin/env tclsh +## +# impersonal.tcl - export impersonal mail via the web +# +# (c) 1999 Marshall T. Rose +# Hold harmless the author, and any lawful use is allowed. +# + +package require Tcl 8.3 +global options + + +# begin of routines that may be redefined in configFile + +proc tclLog {message} { + global options + + if {([info exists options(debugP)]) && ($options(debugP) > 0)} { + puts stderr $message + } + + if {([string first "DEBUG " $message] == 0) \ + || ([catch { set fd [open $options(logFile) \ + { WRONLY CREAT APPEND }] }])} { + return + } + + regsub -all "\n" $message " " message + + catch { puts -nonewline $fd \ + [format "%s %-8.8s %06d %s\n" \ + [clock format [clock seconds] -format "%m/%d %T"] \ + personal [expr {[pid]%65535}] $message] } + + catch { close $fd } +} + +# end of routines that may be redefined in configFile + + +proc firstext {mime} { + array set props [mime::getproperty $mime] + + if {[info exists props(parts)]} { + foreach part $props(parts) { + if {[string compare [firstext $part] ""]} { + return $part + } + } + } else { + switch -- $props(content) { + text/plain + - + text/html { + return $mime + } + } + } +} + +proc sanitize {text} { + regsub -all "&" $text {\&} text + regsub -all "<" $text {\<} text + + return $text +} + +proc cleanup {{message ""} {code 500}} { + global errorCode errorInfo + + set ecode $errorCode + set einfo $errorInfo + + if {[string compare $message ""]} { + tclLog $message + + catch { + puts stdout "HTTP/1.0 $code Server Error +Content-Type: text/html +Status: 500 Server Error + +<html><head><title>Service Problem</title></head> +<body><h1>Service Problem</h1> +<b>Reason:</b> [sanitize $message]" + + if {$code == 505} { + puts stdout "<br> +<b>Stack:</b> +<pre>[sanitize $einfo]</pre> +<hr></hr>" + } + + puts stdout "</body></html>" + } + } + + flush stdout + + exit 0 +} + + + +if {[catch { + + set program impersonal + + package require mbox 1.0 + package require mutl 1.0 + package require smtp 1.1 + package require Tclx 8.0 + + +# move stdin, close stdin/stderr + + dup [set null [open /dev/null { RDWR }]] stderr + set stdin [dup stdin] + dup $null stdin + close $null + + fconfigure $stdin -translation crlf + fconfigure stdout -translation crlf + + +# parse arguments and initialize environment + + set program [file tail [file rootname $argv0]] + + set configFile .${program}-config.tcl + + set debugP 0 + + set userName "" + + for {set argx 0} {$argx < $argc} {incr argx} { + set option [lindex $argv $argx] + if {[incr argx] >= $argc} { + cleanup "missing argument to $option" + } + set value [lindex $argv $argx] + + switch -- $option { + -config { + set configFile $value + } + + -debug { + set options(debugP) [set debugP [smtp::boolean $value]] + } + + -user { + set userName $value + } + + default { + cleanup "unknown option $option" + } + } + } + + if {[string compare $userName ""]} { + if {[catch { id convert user $userName }]} { + cleanup "userName doesn't exist: $userName" + } + if {([catch { file isdirectory ~$userName } result]) \ + || (!$result)} { + cleanup "userName doesn't have a home directory: $userName" + } + + umask 0077 + cd ~$userName + } + + if {![file exists $configFile]} { + cleanup "configFile file doesn't exist: $configFile" + } + source $configFile + + set options(debugP) $debugP + + foreach {k v} [array get options] { + if {![string compare $v ""]} { + unset options($k) + } + } + + foreach k [list dataDirectory foldersFile foldersDirectory] { + if {![info exists options($k)]} { + cleanup "configFile didn't define $k: $configFile" + } + } + + if {![file isdirectory $options(dataDirectory)]} { + file mkdir $options(dataDirectory) + } + + +# crack the request + + set request "" + set eol "" + while {1} { + if {[catch { gets $stdin line } result]} { + cleanup "lost connection" + } + if {$result < 0} { + break + } + + set gotP 0 + foreach c [split $line ""] { + if {($c == " ") || ($c == "\t") || [ctype print $c]} { + if {!$gotP} { + append request $eol + set gotP 1 + } + append request $c + } + } + if {!$gotP} { + break + } + + set eol "\n" + } + set request [string tolower $request] + + set getP 0 + foreach param [split $request "\n"] { + if {[string first "get " $param] == 0} { + set getP 1 + if {[catch { lindex [split $param " "] 1 } page]} { + cleanup "server supports only HTTP/1.0" 501 + } + } + } + if {!$getP} { + cleanup "server supports only GET" 405 + } + + if {[string first /news? $page] != 0} { + cleanup "page $page unavailable" 504 + } + foreach param [split [string range $page 6 end] &] { + if {[set x [string first = $param]] <= 0} { + cleanup "page $request unavailable" 504 + } + set key [string range $param 0 [expr {$x-1}]] + set arg($key) [string range $param [expr {$x+1}] end] + } + + set expires [mime::parsedatetime -now proper] + + +# /news?index=newsgroups OR /news?index=recent + + if {![catch { set arg(index) } index]} { + switch -- $index { + newsgroups { + set lastN 0 + } + + recent { + set lastN -1 + } + + default { + cleanup "page $request unavailable" 504 + } + } + catch { set lastN $arg(lastn) } + + if {[catch { open $options(foldersFile) { RDONLY } } fd]} { + cleanup $fd 505 + } + + set folders "" + set suffix [lindex [set prefix [file split \ + $options(foldersDirectory)]] \ + end] + set prefix [eval [list file join] [lreplace $prefix end end]] + + for {set lineNo 1} {[gets $fd line] >= 0} {incr lineNo} { + if {[string first $suffix $line] != 0} { + continue + } + set file [file join $prefix $line] + + if {[catch { file stat $file stat } result]} { + tclLog $result + + continue + } + if {![string compare $stat(type) file]} { + lappend folders [list [eval [list file join] \ + [lrange [file split $line] \ + 1 end]] \ + $stat(mtime)] + } + } + + catch {close $fd } + + switch -- $index { + recent { + set folders [lsort -integer -decreasing -index 1 $folders] + } + + default { + set folders [lsort -dictionary -increasing -index 0 $folders] + } + } + + puts stdout "HTTP/1.0 200 +Content-Type: text/html +Pragma: no-cache +Expires: $expires + +<html><head><title>newsgroups</title></head><body> +<table cellborder=0 cellpadding=0 cellspacing=0>" + + foreach entry $folders { + set folder [lindex $entry 0] + set t [fmtclock [set mtime [lindex $entry 1]] "%m/%d %H:%M"] + + puts stdout "<tr><td><a href=\"news?folder=$folder&lastN=$lastN&mtime=$mtime\">$t</a></td><td width=5></td><td><b>$folder</b></td></tr>" + } + + puts stdout "</table> +</body></html>" + + cleanup + } + + +# /news?folder="whatever" + + if {[catch { set arg(folder) } folder]} { + cleanup "page $request unavailable" 504 + } + + foreach p [file split $folder] { + if {(![string compare $p ""]) || ([string first . $p] >= 0)} { + cleanup "page $request unavailable" 504 + } + } + + set file [file join $options(foldersDirectory) $folder] + if {([catch { file type $file } type]) \ + || ([string compare $type file])} { + cleanup "page $request unavailable" 504 + } + if {[catch { mbox::initialize -file $file } mbox]} { + cleanup $mbox 505 + } + + +# /news?folder="whatever"&lastN="N" + + if {![catch { set arg(lastn) } lastN]} { + array set props [mbox::getproperty $mbox] + + if {$lastN < 0} { + set diff [expr {-($lastN*86400)}] + + set last 0 + for {set msgNo $props(last)} {$msgNo > 0} {incr msgNo -1} { + if {[catch { mbox::getmsgtoken $mbox $msgNo } mime]} { + tclLog $mime + + continue + } + + if {[catch { lindex [mime::getheader $mime Date] 0 } value]} { + set value "" + } + if {![catch { mime::parsedatetime $value rclock } rclock]} { + if {$rclock < $diff} { + if {$last == 0} { + set last $msgNo + } + set first $msgNo + } + if {$last == 0} { + break + } + } + } + if {$last > 0} { + set last $props(last) + } + } elseif {[set first \ + [expr {[set last $props(last)]-($lastN+1)}]] <= 0} { + set first 1 + } + + puts stdout "HTTP/1.0 200 +Content-Type: text/html +Pragma: no-cache +Expires: $expires + +<html><head><title>$folder</title></head><body>" + + if {$last == 0} { + puts stdout "<b>Empty.</b> +</body></html>" + + cleanup + } + + puts stdout "<table cellborder=0 cellpadding=0 cellspacing=0>" + for {set msgNo $last} {$msgNo >= $first} {incr msgNo -1} { + if {[catch { mbox::getmsgtoken $mbox $msgNo } mime]} { + tclLog $mime + + continue + } + + set date "" + catch { + set value [lindex [mime::getheader $mime Date] 0] + append date [format %02d \ + [mime::parsedatetime $value mon]] / \ + [format %02d [mime::parsedatetime $value mday]] " " \ + [format %02d [mime::parsedatetime $value hour]] : \ + [format %02d [mime::parsedatetime $value min]] + } + if {![string compare $date ""]} { + set date "unknown date" + } + + set from "" + catch { + set from [mutl::firstaddress [mime::getheader $mime From]] + + catch { unset aprops } + + array set aprops [lindex [mime::parseaddress $from] 0] + set from "<a href='mailto:$aprops(local)@$aprops(domain)'>$aprops(friendly)</a>" + } + + set subject "" + catch { + set subject [lindex [mime::getheader $mime Subject] 0] + } + + puts stdout "<tr><td><a href=\"news?folder=$folder&msgNo=$msgNo\">$date</a></td><td width=5></td><td><b>$from</b></td><td width=5></td><td>$subject</td></tr>" + } + puts stdout "</table> +</body></html>" + + cleanup + } + + +# /news?folder="whatever"&msgNo="N" + + if {![catch { set arg(msgno) } msgNo]} { + if {[catch { mbox::getmsgtoken $mbox $msgNo } mime]} { + cleanup $mime 505 + } + + if {![string compare [set part [firstext $mime]] ""]} { + set part $mime + } + switch -- [set content [mime::getproperty $part content]] { + text/plain { + regsub -all "\n\n" [mime::getbody $part] "<p>" body + + set result "<html><head><title>$folder $msgNo</title></head> +<body>$body</body></html>" + + } + + text/html { + set result [mime::getbody $part] + } + + default { + set result "<html><head><title>$folder $msgNo</title></head> +<body> +Message is $content. +</body></html>" + } + } + + puts stdout "HTTP/1.0 200 +Content-Type: text/html + +$result" + + cleanup + } + + + cleanup "page $request unavailable" 504 + + +} result]} { + global errorCode errorInfo + + set ecode $errorCode + set einfo $errorInfo + + if {(![catch { info body tclLog } result2]) \ + && ([string compare [string trim $result2] \ + {catch {puts stderr $string}}])} { + catch { tclLog $result } + } + + if {![string first "POSIX EPIPE" $ecode]} { + exit 0 + } + + catch { + smtp::sendmessage \ + [mime::initialize \ + -canonical text/plain \ + -param {charset us-ascii} \ + -string "$result\n\nerrorCode: $ecode\n\n$einfo"] \ + -originator "" \ + -header [list From [id user]@[info hostname]] \ + -header [list To operator@[info hostname]] \ + -header [list Subject "[info hostname] fatal $program"] + } + + cleanup $result +} + + +exit 75 diff --git a/tcllib/examples/mime/mbot/mbox.tcl b/tcllib/examples/mime/mbot/mbox.tcl new file mode 100644 index 0000000..01956a0 --- /dev/null +++ b/tcllib/examples/mime/mbot/mbox.tcl @@ -0,0 +1,465 @@ +# mbox.tcl - mailbox package +# +# (c) 1999 Marshall T. Rose +# Hold harmless the author, and any lawful use is allowed. +# + +# +# TODO: +# +# mbox::initialize +# add -pop server option +# add -imap server option +# along with -username, -password, and -passback +# +# mbox::getmsgproperty +# add support for deleted messages +# +# mbox::deletemsg token msgNo +# marks a message for deletion +# +# mbox::synchronize token ?-commit boolean? +# commits or rollllbacks changes + + +package provide mbox 1.0 + +package require mime 1.1 + + +# +# state variables: +# +# msgs: serialized array of messages, containing array of: +# msgNo, mime +# count: number of messages +# first: number of initial message +# last: number of final message +# value: either "file", or "directory" +# +# file: file containing mailbox +# fd: corresponding file descriptor +# fileA: serialized array of messages, containing array of: +# msgNo, offset, size +# +# directory: directory containing mailbox +# dirA: serialized array of messages, containing array of: +# msgNo, size +# + +namespace eval mbox { + variable mbox + array set mbox { uid 0 } + + namespace export initialize finalize getproperty \ + getmsgtoken getmsgproperty +} + + +proc mbox::initialize {args} { + global errorCode errorInfo + + variable mbox + + set token [namespace current]::[incr mbox(uid)] + + variable $token + upvar 0 $token state + + if {[set code [catch { eval [list mbox::initializeaux $token] $args } \ + result]]} { + set ecode $errorCode + set einfo $errorInfo + + catch { mbox::finalize $token -subordinates dynamic } + + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + + return $token +} + + +proc mbox::initializeaux {token args} { + variable $token + upvar 0 $token state + + set state(msgs) "" + set state(count) 0 + set state(first) 0 + set state(last) 0 + + set argc [llength $args] + for {set argx 0} {$argx < $argc} {incr argx} { + set option [lindex $args $argx] + if {[incr argx] >= $argc} { + error "missing argument to $option" + } + set value [lindex $args $argx] + + switch -- $option { + -directory { + set state(directory) $value + } + + -file { + set state(file) $value + } + + default { + error "unknown option $option" + } + } + } + + set valueN 0 + foreach value [list directory file] { + if {[info exists state($value)]} { + set state(value) $value + incr valueN + } + } + if {$valueN != 1} { + error "specify exactly one of -directory, or -file" + } + + return [mbox::initialize_$state(value) $token] +} + + +proc mbox::initialize_file {token} { + variable $token + upvar 0 $token state + + fconfigure [set state(fd) [open $state(file) { RDONLY }]] \ + -translation binary + + array set fileA "" + set msgNo 0 + + if {[gets $state(fd) line] < 0} { + return $token + } + switch -regexp -- $line { + "^From " { + set format Mailx + set preB "From " + + set phase "" + } + + "\01\01\01\01" { + set format MMDF + set preB "\01\01\01\01" + set postB "\01\01\01\01" + + if {([gets $state(fd) line] >= 0) \ + && ([string first "From MAILER-DAEMON " $line] == 0)} { + set phase skip + } else { + set phase pre + } + } + + default { + error "unrecognized mailbox format" + } + } + seek $state(fd) 0 start + + while {[gets $state(fd) line] >= 0} { + switch -- $format/$phase { + Mailx/ { + if {[string first $preB $line] == 0} { + if {$msgNo > 0} { + set fileA($msgNo) [list msgNo $msgNo offset $offset \ + size $size] + } + + incr msgNo + set offset [tell $state(fd)] + set size 0 + } else { + incr size [expr {[string length $line]+1}] + } + } + + MMDF/pre { + if {![string compare $preB $line]} { + incr msgNo + set offset [tell $state(fd)] + set size 0 + + set phase post + } else { + error "invalid mailbox" + } + } + + MMDF/post { + if {![string compare $postB $line]} { + set fileA($msgNo) [list msgNo $msgNo offset $offset \ + size $size] + + set phase pre + } else { + incr size [expr {[string length $line]+1}] + } + } + + MMDF/skip { + if {![string compare $preB $line]} { + set phase skip2 + } + } + + MMDF/skip2 { + if {![string compare $postB $line]} { + set phase pre + } + } + } + } + + switch -- $format/$phase { + Mailx/ { + if {$msgNo > 0} { + set fileA($msgNo) [list msgNo $msgNo offset $offset \ + size $size] + } + } + + MMDF/post + - + MMDF/skip2 { + error "incomplete mailbox" + } + } + + set state(fileA) [array get fileA] + if {[set state(last) [set state(count) $msgNo]] > 0} { + set state(first) 1 + } + + return $token +} + + +proc mbox::initialize_directory {token} { + variable $token + upvar 0 $token state + + array set dirA "" + + set first 0 + set last 0 + foreach file [glob -nocomplain [file join $state(directory) *]] { + if {(![regexp {^[1-9][0-9]*$} [set msgNo [file tail $file]]]) \ + || ([catch { file size $file } size])} { + continue + } + + if {($first == 0) || ($msgNo < $first)} { + set first $msgNo + } + if {$last < $msgNo} { + set last $msgNo + } + + set dirA($msgNo) [list msgNo $msgNo size $size] + incr state(count) + } + + set state(dirA) [array get dirA] + if {[set state(last) $last] > 0} { + set state(first) $first + } + + return $token +} + +proc mbox::finalize {token args} { + variable $token + upvar 0 $token state + + array set options [list -subordinates dynamic] + array set options $args + + switch -- $options(-subordinates) { + all + - + dynamic { + array set msgs $state(msgs) + + for {set msgNo $state(first)} \ + {$msgNo <= $state(last)} \ + {incr msgNo} { + if {![catch { array set msg $msgs($msgNo) }]} { + eval [list mime::finalize $msg(mime)] $args + } + } + } + + none { + } + + default { + error "unknown value for -subordinates $options(-subordinates)" + } + } + + if {[info exists state(fd)]} { + catch { close $state(fd) } + } + + foreach name [array names state] { + unset state($name) + } + unset $token +} + + +proc mbox::getproperty {token {property ""}} { + variable $token + upvar 0 $token state + + switch -- $property { + "" { + return [list count $state(count) \ + first $state(first) \ + last $state(last) \ + messages [mbox::getmessages $token]] + } + + -names { + return [list count first last messages] + } + + count + - + first + - + last { + return $state($property) + } + + messages { + return [mbox::getmessages $token] + } + + default { + error "unknown property $property" + } + } +} + + +proc mbox::getmessages {token} { + variable $token + upvar 0 $token state + + switch -- $state(value) { + directory { + array set msgs $state(dirA) + } + + file { + array set msgs $state(fileA) + } + } + + return [lsort -integer [array names msgs]] +} + + +proc mbox::getmsgtoken {token msgNo} { + variable $token + upvar 0 $token state + + if {($msgNo < $state(first)) || ($msgNo > $state(last))} { + error "message number out of range: $state(first)..$state(last)" + } + + array set msgs $state(msgs) + if {![catch { array set msg $msgs($msgNo) }]} { + return $msg(mime) + } + + switch -- $state(value) { + directory { + set mime [mime::initialize \ + -file [file join $state(directory) $msgNo]] + } + + file { + array set fileA $state(fileA) + array set msg $fileA($msgNo) + set mime [mime::initialize -file $state(file) -root $token \ + -offset $msg(offset) -count $msg(size)] + } + } + + set msgs($msgNo) [list msgNo $msgNo mime $mime] + set state(msgs) [array get msgs] + + return $mime +} + + +proc mbox::getmsgproperty {token msgNo {property ""}} { + variable $token + upvar 0 $token state + + if {($msgNo < $state(first)) || ($msgNo > $state(last))} { + error "message number out of range: $state(first)..$state(last)" + } + + switch -- $state(value) { + directory { + array set dirA $state(dirA) + if {[catch { array set msg $dirA($msgNo) }]} { + error "message $msgNo doesn't exist" + } + } + + file { + array set fileA $state(fileA) + array set msg $fileA($msgNo) + } + } + + set props [list flags size uidl] + + switch -- $property { + "" { + array set properties "" + + foreach prop $props { + if {[info exists msg($prop)]} { + set properties($prop) $msg($prop) + } + } + + return [array get properties] + } + + -names { + set names "" + foreach prop $props { + if {[info exists msg($prop)]} { + lappend names $prop + } + } + + return $names + } + + default { + if {[lsearch -exact $props $property] < 0} { + error "unknown property $property" + } + + return $msg($property) + } + } +} diff --git a/tcllib/examples/mime/mbot/mutl.tcl b/tcllib/examples/mime/mbot/mutl.tcl new file mode 100644 index 0000000..c918126 --- /dev/null +++ b/tcllib/examples/mime/mbot/mutl.tcl @@ -0,0 +1,123 @@ +# mutl.tcl - messaging utilities +# +# (c) 1999 Marshall T. Rose +# Hold harmless the author, and any lawful use is allowed. +# + + +package provide mutl 1.0 + + +namespace eval mutl { + namespace export exclfile tmpfile \ + firstaddress gathertext getheader +} + + +proc mutl::exclfile {fileN {stayP 0}} { + global errorCode errorInfo + + for {set i 0} {$i < 10} {incr i} { + if {![catch { set xd [open $fileN { RDWR CREAT EXCL }] } result]} { + if {(![set code [catch { puts $xd [expr {[pid]%65535}] + flush $xd } result]]) \ + && (!$stayP)} { + if {![set code [catch { close $xd } result]]} { + set xd "" + } + } + + if {$code} { + set ecode $errorCode + set einfo $errorInfo + + catch { close $xd } + + file delete -- $fileN + + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + + return $xd + } + set ecode $errorCode + set einfo $errorInfo + + if {(([llength $ecode] != 3) \ + || ([string compare [lindex $ecode 0] POSIX]) \ + || ([string compare [lindex $ecode 1] EEXIST]))} { + return -code 1 -errorinfo $einfo -errorcode $ecode $result + } + + after 1000 + } + + error "unable to exclusively open $fileN" +} + +proc mutl::tmpfile {prefix {tmpD ""}} { + global env + global errorCode errorInfo + + if {(![string compare $tmpD ""]) && ([catch { set tmpD $env(TMP) }])} { + set tmpD /tmp + } + set file [file join $tmpD $prefix] + + append file [expr {[pid]%65535}] + + for {set i 0} {$i < 10} {incr i} { + if {![set code [catch { set fd [open $file$i \ + { WRONLY CREAT EXCL }] } \ + result]]} { + return [list file $file$i fd $fd] + } + set ecode $errorCode + set einfo $errorInfo + + if {(([llength $ecode] != 3) \ + || ([string compare [lindex $ecode 0] POSIX]) \ + || ([string compare [lindex $ecode 1] EEXIST]))} { + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + } + + error "unable to create temporary file" +} + +proc mutl::firstaddress {values} { + foreach value $values { + foreach addr [mime::parseaddress $value] { + catch { unset aprops } + array set aprops $addr + + if {[string compare $aprops(proper) ""]} { + return $aprops(proper) + } + } + } +} + +proc mutl::gathertext {token} { + array set props [mime::getproperty $token] + + set text "" + + if {[info exists props(parts)]} { + foreach part $props(parts) { + append text [mutl::gathertext $part] + } + } elseif {![string compare $props(content) text/plain]} { + set text [mime::getbody $token] + } + + return $text +} + +proc mutl::getheader {token key} { + if {[catch { mime::getheader $token $key } result]} { + set result "" + } + + return $result +} diff --git a/tcllib/examples/mime/mbot/personal.tcl b/tcllib/examples/mime/mbot/personal.tcl new file mode 100755 index 0000000..bf16a0b --- /dev/null +++ b/tcllib/examples/mime/mbot/personal.tcl @@ -0,0 +1,982 @@ +#!/usr/bin/env tclsh +## -*- tcl -*- +# personal.tcl - process personal mail +# +# (c) 1999 Marshall T. Rose +# Hold harmless the author, and any lawful use is allowed. +# +# The original version was written in 1994! +# + +package require Tcl 8.3 + +global options + + +# begin of routines that may be redefined in configFile + +proc impersonalMail {originator} {} + +proc adminP {local domain} { + set local [string tolower $local] + + foreach lhs [list administrator \ + archive-server \ + daemon \ + failrepter \ + faxmaster \ + gateway \ + listmaster \ + listproc \ + lotus_mail_exchange \ + m400 \ + *mailer* \ + *maiser* \ + mmdf \ + mrgate \ + mx-mailer-daemon \ + numbers-info-forw \ + postman* \ + *postmast* \ + pp \ + smtp \ + sysadmin \ + ucx_smtp \ + uucp] { + if {[string match $lhs $local]} { + return 1 + } + } + + return 0 +} + +proc friendP {local domain} { + global options + + if {![info exists options(friendlyDomains)]} { + return 0 + } + + set domain [string tolower $domain] + + foreach rhs $options(friendlyDomains) { + if {(![string compare $rhs $domain]) \ + || ([string match *.$rhs $domain])} { + return 1 + } + } + + return 0 +} + +proc ownerP {local domain} { + global options + + foreach mailbox {myMailbox pdaMailboxes remoteMailboxes} { + if {![info exists options($mailbox)]} { + continue + } + + foreach addr [mime::parseaddress $options($mailbox)] { + catch { unset aprops } + + array set aprops $addr + if {![string compare [string tolower $local@$domain] \ + [string tolower $aprops(local)@$aprops(domain)]]} { + return 1 + } + } + } + + return 0 +} + +# the algorithm below is for systems that use the MMDF/MH convention + +proc saveMessage {inF {outF ""}} { + global errorCode errorInfo + global options + + set inC [open $inF { RDONLY }] + + if {![string compare $outF ""]} { + set outF $options(defaultMaildrop) + } + mutl::exclfile [set lockF $outF.lock] + + set code [catch { set outC [open $outF { WRONLY CREAT APPEND }] } result] + set ecode $errorCode + set einfo $errorInfo + + if {!$code} { + set code [catch { + puts $outC [set boundary "\001\001\001\001"] + puts $outC "Delivery-Date: [mime::parsedatetime -now proper]" + + while {[gets $inC line] >= 0} { + if {[string compare $boundary $line]} { + puts $outC $line + } else { + puts $outC "\002\001\001\001" + } + } + + puts $outC $boundary + } result] + set ecode $errorCode + set einfo $errorInfo + + if {[catch { close $outC } result2]} { + tclLog $result2 + } + } + + file delete -- $lockF + + if {[catch { close $inC } result2]} { + tclLog $result2 + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +proc findPhrase {subject} { + global options + + set subject [string toupper $subject] + + foreach file [glob -nocomplain [file join $options(dataDirectory) \ + phrases *]] { + if {[catch { otp_words -mode encode \ + [base64 -mode decode -- \ + [join [split [file tail $file] _] /]] } \ + phrase]} { + tclLog "$file: $phrase" + } elseif {[string first $phrase $subject] >= 0} { + if {[catch { file delete -- $file } result]} { + tclLog $result + } + + return 1 + } + } + + return 0 +} + +proc makePhrase {} { + global options + + if {![file isdirectory \ + [set phraseD [file join $options(dataDirectory) phrases]]]} { + file mkdir $phraseD + } else { + pruneDir $phraseD phrase + } + + set key [mime::uniqueID] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [otp_md5 -- $key] + } + + set phraseF [file join $phraseD \ + [join [split [string trim \ + [base64 -mode encode -- $key]] /] _]] + if {[catch { close [open $phraseF { WRONLY CREAT TRUNC }] } result]} { + tclLog $result + } + + return [otp_words -mode encode -- $key] +} + +proc pruneDir {dir type} { + switch -- $type { + addr { + set days 14 + } + + msgid { + set days 28 + } + + phrase { + set days 7 + } + } + + set then [expr {[clock seconds]-($days*86400)}] + + foreach file [glob -nocomplain [file join $dir *]] { + if {(![catch { file mtime $file } result]) \ + && ($result < $then) \ + && ([catch { file delete -- $file } result])} { + tclLog $result + } + } +} + +proc tclLog {message} { + global options + + if {([info exists options(debugP)]) && ($options(debugP) > 0)} { + puts stderr $message + } + + if {([string first "DEBUG " $message] == 0) \ + || ([catch { set fd [open $options(logFile) \ + { WRONLY CREAT APPEND }] }])} { + return + } + + regsub -all "\n" $message " " message + + catch { puts -nonewline $fd \ + [format "%s %-8.8s %06d %s\n" \ + [clock format [clock seconds] -format "%m/%d %T"] \ + personal [expr {[pid]%65535}] $message] } + + catch { close $fd } +} + +# end of routines that may be redefined in configFile + + +global deleteFiles + +set deleteFiles {} + +proc cleanup {{message ""} {status 75}} { + global deleteFiles + + foreach file $deleteFiles { + if {[catch { file delete -- $file } result]} { + tclLog $result + } + } + + if {[string compare $message ""]} { + tclLog $message + exit $status + } + + exit 0 +} + +proc dofolder {folder inF} { + global options + + catch { unset aprops } + + array set aprops [lindex [mime::parseaddress $folder] 0] + set folder [join [split $aprops(local) /] _] + + if {[set folderN [llength [set folderL [split $folder .]]]] <= 1} { + cleanup "invalid folder: $folder" + } + + foreach f $folderL { + if {![string compare $f ""]} { + cleanup "invalid folder: $folder" 67 + } + } + + if {![file isdirectory \ + [set articleD [eval [list file join \ + $options(foldersDirectory)] \ + [lrange $folderL 0 \ + [expr {$folderN-2}]]]]]} { + file mkdir $articleD + } + if {![file exists [set articleF [file join $articleD \ + [lindex $folderL \ + [expr {$folderN-1}]]]]]} { + set newP 1 + } else { + set newP 0 + } + + set fd [open $options(foldersFile) { RDWR CREAT }] + set fl "\n[read $fd]" + + set dir [lindex [file split $options(foldersDirectory)] end] + if {[string first "\n$dir\n" $fl] < 0} { + puts $fd $dir + } + foreach f $folderL { + set dir [file join $dir $f] + if {[string first "\n$dir\n" $fl] < 0} { + puts $fd $dir + } + } + + close $fd + + if {[catch { saveMessage $inF $articleF } result]} { + cleanup "unable to save message in $articleF: $result" + } + + if {($newP) && ([info exists options(announceMailboxes)])} { + if {[catch { smtp::sendmessage \ + [mime::initialize \ + -canonical text/plain \ + -param {charset us-ascii} \ + -string ""] \ + -atleastone true \ + -originator "" \ + -header [list From $options(myMailbox)] \ + -header [list To $options(announceMailboxes)] \ + -header [list Subject "new folder $folder"] } \ + result]} { + tclLog $result + } + } +} + +proc alladdrs {mime keys} { + set result {} + + foreach key $keys { + foreach value [mutl::getheader $mime $key] { + foreach addr [mime::parseaddress $value] { + lappend result $addr + } + } + } + + return $result +} + +proc anyfriend {outD addrs} { + global options + + if {!$options(friendlyFire)} { + return "" + } + + foreach addr $addrs { + catch { unset aprops } + + array set aprops $addr + if {[catch { string tolower $aprops(local)@$aprops(domain) } \ + recipient]} { + continue + } + + if {[ownerP $aprops(local) $aprops(domain)]} { + tclLog "DEBUG: skipping $recipient" + continue + } + + set outF [file join $outD [join [split $recipient /] _]] + if {[file exists $outF]} { + return $recipient + } + + tclLog "DEBUG: unknown recipient $recipient" + } + + return "" +} + + +if {[catch { + + set program personal + + package require mutl 1.0 + package require smtp 1.1 + package require Tclx 8.0 + + +# parse arguments and initialize environment + + set program [file tail [file rootname $argv0]] + + set configFile .${program}-config.tcl + + set debugP 0 + + set messageFile - + + set originatorAddress "" + + set userName "" + + for {set argx 0} {$argx < $argc} {incr argx} { + set option [lindex $argv $argx] + if {[incr argx] >= $argc} { + cleanup "missing argument to $option" + } + set value [lindex $argv $argx] + + switch -- $option { + -config { + set configFile $value + } + + -debug { + set options(debugP) [set debugP [smtp::boolean $value]] + } + + -file { + set messageFile $value + } + + -originator { + set originatorAddress $value + } + + -user { + set userName $value + } + + default { + cleanup "unknown option $option" + } + } + } + + if {![string compare $messageFile -]} { + array set tmp [mutl::tmpfile personal] + + lappend deleteFiles [set messageFile $tmp(file)] + + catch { file attributes $messageFile -permissions 0600 } + + if {[gets stdin line] <= 0} { + cleanup "empty message" + } + if {[string first "From " $line] == 0} { + if {![string compare $originatorAddress ""]} { + set line [string range $line 5 end] + if {[set x [string first " " $line]] > 0} { + set originatorAddress [string range $line 0 [expr {$x-1}]] + } + } + } else { + puts $tmp(fd) $line + } + fcopy stdin $tmp(fd) + close $tmp(fd) + } + + if {[string compare $userName ""]} { + if {[catch { id convert user $userName }]} { + cleanup "userName doesn't exist: $userName" + } + if {([catch { file isdirectory ~$userName } result]) \ + || (!$result)} { + cleanup "userName doesn't have a home directory: $userName" + } + + umask 0077 + cd ~$userName + } + + if {![file exists $configFile]} { + cleanup "configFile file doesn't exist: $configFile" + } + source $configFile + + set options(debugP) $debugP + + foreach {k v} [array get options] { + if {![string compare $v ""]} { + unset options($k) + } + } + + foreach k [list dataDirectory defaultMaildrop] { + if {![info exists options($k)]} { + cleanup "configFile didn't define $k: $configFile" + } + } + + if {![file isdirectory $options(dataDirectory)]} { + file mkdir $options(dataDirectory) + } + + if {![info exists options(myMailbox)]} { + set options(myMailbox) [id user] + } + + if {![info exists options(friendlyFire)]} { + set options(friendlyFire) 0 + } + + +# crack the message + + if {[catch { set mime [mime::initialize -file $messageFile] } result]} { +# global errorCode errorInfo +# +# set ecode $errorCode +# set einfo $errorInfo +# +# if {![catch { +# smtp::sendmessage \ +# [mime::initialize \ +# -canonical multipart/mixed \ +# -parts [list [mime::initialize \ +# -canonical text/plain \ +# -param {charset us-ascii} \ +# -string "$result\n\nerrorCode: $ecode\n\n$einfo"] \ +# [mime::initialize \ +# -canonical application/octet-stream \ +# -file $messageFile]]] \ +# -originator "" \ +# -header [list From $options(myMailbox)] \ +# -header [list To $options(myMailbox)] \ +# -header [list Subject "[info hostname] alert $program"] +# }]} { +# set result "" +# } + + if {[info exists options(auditInFile)]} { + saveMessage $messageFile $options(auditInFile) + tclLog "invalid, but saved: $result" + cleanup + } + + cleanup "re-queued: $result" + } + + set origProper "" + foreach key {From Sender Return-Path} { + if {[string compare \ + [set origProper [mutl::firstaddress \ + [mutl::getheader $mime $key]]] \ + ""]} { + break + } + } + if {![string compare $origProper ""]} { + set origProper [mutl::firstaddress [list $originatorAddress]] + } + + catch { unset aprops } + + array set aprops [list local "" domain ""] + array set aprops [lindex [mime::parseaddress $origProper] 0] + set origLocal $aprops(local) + set origDomain $aprops(domain) + + regsub -all " *" \ + [set subject [string trim \ + [lindex [mutl::getheader $mime Subject] 0]]] \ + " " subject + + + if {[catch { set folderTarget [impersonalMail $origLocal@$origDomain] }]} { + set folderTarget "" + } + if {[set impersonalP [string compare $folderTarget ""]]} { + if {![info exists options(foldersDirectory)]} { + cleanup "configFile didn't define folderTarget: $configFile" + } + } elseif {[info exists options(auditInFile)]} { +# keep an audit copy of personal mail + + saveMessage $messageFile $options(auditInFile) + } + + +# perform duplicate supression + + set messageID [lindex [concat [mutl::getheader $mime Resent-Message-ID] \ + [mutl::getheader $mime Message-ID]] 0] + if {[string compare $messageID ""]} { + if {![file isdirectory \ + [set idD [file join $options(dataDirectory) msgids]]]} { + file mkdir $idD + } else { + pruneDir $idD msgid + } + + if {[set len [string length $messageID]] > 2} { + set messageID [string range $messageID 1 [expr {$len-2}]] + } + if {$impersonalP} { + set prefix X- + + catch { unset aprops } + + array set aprops [lindex [mime::parseaddress $folderTarget] 0] + set prefix \ + X-[lindex [split [join [split $aprops(local) /] _] .] 0]- + } else { + set prefix "" + } + + set idF [file join $idD $prefix[join [split $messageID /] _]] + if {[file exists $idF]} { + tclLog "duplicate ID: $origProper $messageID ($subject)" + + cleanup + } + + if {[catch { close [open $idF { WRONLY CREAT TRUNC }] } result]} { + tclLog $result + } + } + + +# record information about the originator + + if {![string compare \ + [set origAddress \ + [string tolower $origLocal@$origDomain]] \ + @]} { + tclLog "no originator" + + if {!$impersonalP} { + saveMessage $messageFile + } + + cleanup + } + + tclLog "DEBUG processing: $origProper <$messageID> ($subject)" + + if {![file isdirectory \ + [set inD [file join $options(dataDirectory) inaddrs]]]} { + file mkdir $inD + } + + set inF [file join $inD [join [split $origAddress /] _]] + if {[catch { set fd [open $inF { WRONLY CREAT TRUNC }] } result]} { + tclLog $result + } else { + catch { puts $fd $origProper } + if {[catch { close $fd } result]} { + tclLog $result + } + } + + +# store impersonal mail in private folder area + + if {$impersonalP} { + if {![string compare $messageID ""]} { + cleanup "no Message-ID" + } + + if {![file isdirectory $options(foldersDirectory)]} { + file mkdir $foldersDirectory + } + + array set mapping {} + + if {![catch { set fd [open $options(mappingFile) { RDONLY }] }]} { + while {[gets $fd line] >= 0} { + if {([llength [set map [split $line :]]] == 2) \ + && ([string length \ + [set k [string trim [lindex $map 0]]]] \ + > 0) \ + && ([string length \ + [set v [string trim [lindex $map 1]]]] \ + > 0)} { + set mapping($k) $v + } + } + + if {[catch { close $fd } result]} { + tclLog $result + } + } + + if {![info exists mapping($folderTarget)]} { + set mapping($folderTarget) store + } + if {![string compare $mapping($folderTarget) process]} { + catch { set mapping($folderTarget) \ + [processFolder $folderTarget $mime] } + } + switch -- $mapping($folderTarget) { + store { + dofolder $folderTarget $messageFile + } + + ignore { + tclLog "ignoring message for $folderTarget" + } + + bounce { + cleanup "rejecting message for $folderTarget" 67 + } + + default { + if {[catch { smtp::sendmessage $mime \ + -atleastone true \ + -originator "" \ + -recipients $mapping($folderTarget) } \ + result]} { + tclLog $result + } + } + } + + cleanup + } + + +# perform originator supression and guest list maintenance + + if {[string compare \ + [set resentProper \ + [mutl::firstaddress \ + [mutl::getheader $mime Resent-From]]] \ + ""]} { + catch { unset aprops } + + array set aprops [lindex [mime::parseaddress $resentProper] 0] + set resentLocal $aprops(local) + set resentDomain $aprops(domain) + + if {[string compare \ + [set resentAddress \ + [string tolower $resentLocal@$resentDomain]] \ + @]} { + foreach p {Proper Local Domain Address} { + set orig$p [set resent$p] + } + } + } + + foreach p {out tmp bad} { + if {![file isdirectory [set ${p}D [file join $options(dataDirectory) \ + ${p}addrs]]]} { + file mkdir [set ${p}D] + } + + set ${p}F [file join [set ${p}D] [join [split $origAddress /] _]] + } + + pruneDir $tmpD addr + + +# deal with Klez-inspired nonsense + if {([info exists options(dropNames)]) && ([catch { + foreach part [mime::getproperty $mime parts] { + catch { unset params } + array set params [mime::getproperty $part params] + if {[info exists params(name)]} { + foreach name $options(dropNames) { + if {[string match $name $params(name)]} { + tclLog "rejecting: $origProper <$messageID> ($subject) $params(name)" + cleanup + } + } + } + } + } result])} { + tclLog "Klez-check: $result" + } + + set friend "" + if {[adminP $origLocal $origDomain]} { + tclLog "DEBUG admin check: $origProper <$messageID> ($subject)" + +# if DSNs were the rule, it would make sense to parse it... no such luck + + set fd [open $messageFile { RDONLY }] + set text [read $fd] + if {[catch { close $fd } result]} { + tclLog $result + } + + foreach file [glob -nocomplain [file join $badD *]] { + set addr [file tail $file] + if {([string match *$addr* $text]) \ + || (([set x [string first @ $addr]] > 0) \ + && ([string match \ + *[string range $addr 0 [expr {$x-1}]]* \ + $text]))} { + tclLog "failure notice: $origProper ($addr)" + + cleanup + } + } + + tclLog "DEBUG admin continue: $origProper <$messageID> ($subject)" + } elseif {(![ownerP $origLocal $origDomain]) \ + && (![friendP $origLocal $origDomain]) \ + && (![file exists $outF]) \ + && (![file exists $tmpF]) \ + && (![string compare ""\ + [set friend [anyfriend $outD \ + [alladdrs $mime {To cc}]]]]) \ + && (![findPhrase $subject]) \ + && ([info exists options(noticeFile)])} { + if {[file exists $badF]} { + catch { file delete -- $badF } + } elseif {[catch { + set fd [open $options(noticeFile) { RDONLY }] + set text [read $fd] + if {[catch { close $fd } result]} { + tclLog $result + } + + regsub -all %passPhrase% $text [makePhrase] text + for {set rsubject $subject} \ + {[regexp -nocase ^re: $rsubject]} \ + {set rsubject [string trimleft \ + [string range $rsubject 3 end]]} { + } + regsub -all %subject% $text $rsubject text + + smtp::sendmessage \ + [mime::initialize \ + -canonical multipart/mixed \ + -parts [list [mime::initialize \ + -canonical text/plain \ + -param {charset us-ascii} \ + -string $text] \ + [mime::initialize \ + -canonical message/rfc822 \ + -parts [list $mime]]]] \ + -originator "" \ + -header [list From $options(myMailbox)] \ + -header [list To $origProper] \ + -header [list Subject "Re: $rsubject"] + + set fd [open $badF { WRONLY CREAT TRUNC }] + } result]} { + tclLog $result + } else { + catch { puts $fd $origProper } + if {[catch { close $fd } result]} { + tclLog $result + } + } + tclLog "rejecting: $origProper <$messageID> ($subject)" + + cleanup + } elseif {[string compare $friend ""]} { + tclLog "accepting: $origProper because of $friend" + } else { + if {[ownerP $origLocal $origDomain]} { + set addrD $outD + } else { + set addrD $tmpD + } + + foreach addr [alladdrs $mime \ + {From To cc Resent-From Resent-To Resent-cc}] { + catch { unset aprops } + + array set aprops $addr + set addrLocal $aprops(local) + set addrDomain $aprops(domain) + + if {[string compare \ + [set addrAddress \ + [string tolower $addrLocal@$addrDomain]] @]} { + set addrF [file join $addrD [join [split $addrAddress /] _]] + + if {[file exists $addrF]} { + continue + } + + if {[catch { set fd [open $addrF { WRONLY CREAT TRUNC }] } \ + result]} { + tclLog $result + } else { + catch { puts $fd $aprops(proper) } + if {[catch { close $fd } result]} { + tclLog $result + } + } + } + } + } + + +# perform final actions, if we're the originator + + if {[ownerP $origLocal $origDomain]} { + if {[info exists options(auditOutFile)]} { + saveMessage $messageFile $options(auditOutFile) + } + + cleanup + } + + +# send a copy to the pda + + if {([info exists options(pdaMailboxes)]) \ + && ([string compare [set text [mutl::gathertext $mime]] ""])} { + if {[info exists options(pdaMailsize)]} { + set text [string range $text 0 [expr {$options(pdaMailsize)-1}]] + } + set pda [mime::initialize \ + -canonical text/plain \ + -param {charset us-ascii} \ + -string $text] + + foreach key {From To cc Subject Date Reply-To} { + foreach value [mutl::getheader $mime $key] { + mime::setheader $pda $key $value -mode append + } + } + + if {[catch { smtp::sendmessage $pda \ + -atleastone true \ + -originator "" \ + -recipients $options(pdaMailboxes) } result]} { + tclLog $result + } + } + + +# send a copy to the remote mailbox + + if {[info exists options(remoteMailboxes)]} { + if {[catch { smtp::sendmessage $mime \ + -atleastone true \ + -originator "" \ + -recipients $options(remoteMailboxes) } result]} { + tclLog $result + } else { + cleanup + } + } + + saveMessage $messageFile + + + cleanup + + +} result]} { + global errorCode errorInfo + + set ecode $errorCode + set einfo $errorInfo + + if {(![catch { info body tclLog } result2]) \ + && ([string compare [string trim $result2] \ + {catch {puts stderr $string}}])} { + catch { tclLog $result } + } + + catch { + smtp::sendmessage \ + [mime::initialize \ + -canonical text/plain \ + -param {charset us-ascii} \ + -string "$result\n\nerrorCode: $ecode\n\n$einfo"] \ + -originator "" \ + -header [list From [id user]@[info hostname]] \ + -header [list To operator@[info hostname]] \ + -header [list Subject "[info hostname] fatal $program"] + } + + cleanup $result +} + + +exit 75 diff --git a/tcllib/examples/mime/mbot/pkgIndex.tcl b/tcllib/examples/mime/mbot/pkgIndex.tcl new file mode 100644 index 0000000..29acd62 --- /dev/null +++ b/tcllib/examples/mime/mbot/pkgIndex.tcl @@ -0,0 +1,3 @@ +# @mdgen EXCLUDE: impersonal.tcl +package ifneeded mutl 1.0 [list source [file join $dir mutl.tcl]] +package ifneeded mbox 1.0 [list source [file join $dir mbox.tcl]] |