/****************************************************************/
/*                 Filter for use with Weasel                   */
/*                                                              */
/*   This filter alters the headers in an e-mail to compensate  */
/*   for some cases that PMMail version 1.96a does not handle   */
/*   correctly.  (Sorry, I don't yet know whether this also     */
/*   applies to later versions of PMMail.)  In this version of  */
/*   the filter, we make two changes to the Content-Type        */
/*   header line:                                               */
/*     1. If the character set is specified as iso-8859-15,     */
/*        we change it to iso-8859-1.  That is, the Latin-9     */
/*        character set, which PMMail can't handle, is changed  */
/*        to Latin-1.  Although we don't go as far as changing  */
/*        the characters themselves, the result is readable     */
/*        because those two character sets are almost identical */
/*        anyway -- only a small number of characters are       */
/*        affected.                                             */
/*     2. If the parameter 'format=flowed' is found, it is      */
/*        deleted.  We don't want that parameter (which is      */
/*        supposed to control line wrap, but which is such an   */
/*        unsatisfactory solution that few mail programs use    */
/*        it) because its presence makes PMMail handle          */
/*        non-ASCII characters incorrectly.                     */
/*     3. For all other header lines, each occurrence of        */
/*        =?iso-8859-15 has the '15' changed to '1'             */
/*     4. If there is a missing semicolon at the end of a       */
/*        multipart Content-Type line, and we have not yet      */
/*        encountered the boundary code,  we restore            */
/*        the semicolon.  This is actually a bug in             */
/*        some spamming software, which has been copied by      */
/*        some recent versions of M$-Outlook, but it is         */
/*        handled by this filter on the grounds that standards- */
/*        conforming software would, without this fix, see a    */
/*        completely blank message.  This did not matter as     */
/*        long as only the junk mailers were doing it, but we   */
/*        have now reached the point where even your friends    */
/*        might be sending you this variety of blank message.   */
/*                                                              */
/*      Author:       Peter Moylan (peter@ee.newcastle.edu.au)  */
/*      Started:      19 January 2002                           */
/*      Last revised: 15 July 2004                              */
/*                                                              */
/*  Installation:                                               */
/*      Put this file in the directory containing WEASEL.INI    */
/*      Put its name in the 'Options' page in Setup.            */
/*      Weasel does not need to be restarted.                   */
/*                                                              */
/****************************************************************/

CALL RxFuncAdd SysLoadFuncs, rexxutil, sysloadfuncs
CALL SysLoadFuncs

PARSE ARG userlist SrcFile

SrcFile = STRIP(SrcFile)
SrcFile = TRANSLATE(SrcFile, '\', '/')

/* Generate a file name for the copy. */

DstFile = SysTempFileName( '?????.TMP' )

/* Copy SrcFile to DstFile, changing the headers where needed. */

InHeader = 1
found = 0

DO WHILE InHeader & (found = 0)

    /* Each time around this loop we look at one line of   */
    /* the header.                                         */

    line = LineIn(SrcFile)
    IF line = "" THEN InHeader = 0
    ELSE IF (LEFT(line,1) = ' ') | (LEFT(line,1) = '09'X) THEN
        DO
           /* Continuation line */
           line = DefaultHeaderProcessing(line)
        END
    ELSE IF POS(':', line) = 0 THEN InHeader = 0
    ELSE
        DO
           PARSE VALUE line WITH keyword ':' remainder
           IF TRANSLATE(keyword) = "CONTENT-TYPE" THEN
               DO
                   line = keyword||': 'Modify(remainder)
                   found = 1
               END
           ELSE line = DefaultHeaderProcessing(line)
        END

    /* Write the (possibly modified) line to the output file. */

    CALL LineOut DstFile, line

END

/* Copy the remainder of the source file to the destination. */

DO WHILE Lines(SrcFile) > 0
    CALL LineOut DstFile, LineIn(SrcFile)
END

CALL stream SrcFile, 'C', 'CLOSE'
CALL stream DstFile, 'C', 'CLOSE'

/* Replace the source file by the destination file. */

'@DEL 'SrcFile
'@COPY 'DstFile' 'SrcFile' >nul'
'@DEL 'DstFile

/* Return to Weasel with an 'OK' return code. */

RETURN 0

/****************************************************************/

/* Procedure to modify the parameters of a Content-Type header  */
/* line.  On entry we've already stripped the part up to and    */
/* including the ': '.                                          */

Modify: PROCEDURE
    parse arg rest
    ans = ''
    NeedBoundaryCode = 0
    DO WHILE rest \= ''
        rest = STRIP(rest)
        IF LEFT(TRANSLATE(rest),10) = "MULTIPART/" THEN
            NeedBoundaryCode = 1
        ELSE IF LEFT(TRANSLATE(rest),9) = "BOUNDARY=" THEN
            NeedBoundaryCode = 0
        parse var rest current ';' rest
        current = STRIP(current)
        IF TRANSLATE(current) = "FORMAT=FLOWED" THEN
            current = '' /* remove this parameter */
        ELSE IF TRANSLATE(current) = "CHARSET=ISO-8859-15" THEN
            ans = ans'; charset=iso-8859-1'
        ELSE IF ans = '' THEN ans = current
        ELSE ans = ans'; 'current
    END
    IF NeedBoundaryCode THEN ans = ans';'
    return ans

/****************************************************************/

/* Procedure to modify its argument by changing all instances   */
/* of '=?iso-8859-15' to '=?iso-8859-1'.                        */

DefaultHeaderProcessing: PROCEDURE
    parse arg rest
    ans = ''
    DO FOREVER
        k = POS('=?ISO-8859-15', TRANSLATE(rest))
        IF k = 0 THEN LEAVE
        ELSE
            DO
                ans = ans||LEFT(rest, k-1)||'=?iso-8859-1'
                rest = SUBSTR(rest, k+13)
            END
    END
    return ans||rest

/****************************************************************/