# @(#) pm-jamime-save.rc -- save message's MIME attachement (one file) to a file
# @(#) $Id: pm-jamime-save.rc,v 2.1 2002/01/01 23:34:26 jaalto Exp $
#
#   File id
#
#       .Copyright (C)   1998-2002 Jari Aalto
#       .$Maintainer:    Jari Aalto <jari.aalto@poboxes.com> $
#       .$Created:       1998-01 $
#       .$Keywords:      procmail, subroutine, mime $
#
#       This code is free software in terms of GNU Gen. pub. Lic. v2 or later
#	Refer to http://www.gnu.org/copyleft/gpl.html
#
#   Documentation
#
#       This module saves _one_ simple file attachement (MIME) from he
#       message. The message must define following MIME headers. If
#       "filename=" does not exists, then the message will not be
#       handled.
#
#	    Mime-Version: <version>
#	    Content-Type: <type>
#	    Content-Disposition: attachment; filename="file.txt"
#
#       Procmail is not very suitable for saving MIME attachements and
#       you should not think that this the right tool for you.
#       If you receive anything more than 1 attachement, this recipe
#	does nothing, because that's out of our league and you need some
#	more heavy weight mime tools. Eg. Perl CPAN has MIME libraries.
#
#	_Note_: When the attachement is in the body, it is simply written
#	to a disk and the place is replaced with message
#
#	    Extracted to file:/users/jaalto/junk/file.txt.1998-03-30
#
#	The existing mime headers that surrounded the attachement are
#	untouched, so don't try to press your Mail Agents MIME buttons
#	at that point any more. 8There is no such file in that spot
#	if you set `JA_MIME_SAVE_DEL' to `yes').
#
#   Required settings
#
#       PMSRC must point to source direcry of procmail code. This subroutine
#       will include
#
#       o   pm-javar.rc
#
#   Call arguments (variables to set before calling)
#
#	o   JA_MIME_SAVE_DIR, point this to directory where you
#	    want to store attachements.
#	o   JA_MIME_SAVE_DECODE, set this to "yes", if you want that
#	    attachement is decoded before written to disk. This usually
#	    opens quoted printable or base64 encoding.
#	o   JA_MIME_SAVE_DEL, set this to "yes", if you want to remove
#	    the attachement from the body of the message after it has
#	    been filed. Be vary carefull if you use this option. If you
#	    keep backup cache of incoming mail, then you might try "yes".
#       o   JA_MIME_SAVE_OVERWRITE, set this to "yes" if it's okay to
#           overwrite to an existing filename found from attachement.
#           If you get periodic attachements always with same name, then
#           you would want to set this to yes.
#
#   Core dump note
#
#	Because procmail uses LINEBUF when filtering messages, a core
#	dump may happen if the attachement beeing filtered is bigger than
#	the LINEBUF. The current setting accepts 524K attachements, buf if
#	you expect to get bigger than that, you want to increase
#	`JA_MIME_SAVE_LINEBUF'.
#
#   Possible conflict with your awk
#
#	Awk is used because it is much more system load friendly than perl.
#       If you see an error message in the logfile saying that awk failed:
#
#           procmail: Executing awk,
#           ...
#           procmail: Error while writing to "awk"
#           procmail: Rescue of unfiltered data succeeded
#
#       it means that the system's standard awk doesn't support the
#       variable passing syntax: do following test
#
#           % awk '{print VAR; exit}' VAR="value" /etc/passwd
#
#       And it should print "value". If not, then see if you have `nawk' or
#       `gawk' is your system, which should understand the variable passing
#       syntax. In HP 9 and 10 the standard awk will do fine. The only
#       change you need is
#
#           AWK = "nawk"        # if that works better than standard "awk"
#
#       Somewhere at the top of your .procmailrc
#
#   Return values (none)
#
#   Change Log (none)

# .................................................... &initialising ...


id    = "pm-jacron.rc"
dummy = "
========================================================================
$id: init:
"

:0
* !  WSPC ?? ( )
{
    INCLUDERC = $PMSRC/pm-javar.rc
}

:0
* !  MIME_VER ?? [0-9]
{
    INCLUDERC = $PMSRC/pm-jamime.rc
}


:0				# if has no value, set it
*$ ! LINEBUF ?? $d
{
    LINEBUF = 1024
}


MimeSaveLinebuf	    = $LINEBUF

# .......................................................... &public ...
# User configurable sections

JA_MIME_SAVE_DIR       = ${JA_MIME_SAVE_DIR:-"$HOME"}
JA_MIME_SAVE_DECODE    = ${JA_MIME_SAVE_DECODE:-"no"}
JA_MIME_SAVE_DEL       = ${JA_MIME_SAVE_DEL:-"no"}
JA_MIME_SAVE_LINEBUF   = ${JA_MIME_SAVE_LINEBUF:-524280}
JA_MIME_SAVE_OVERWRITE = ${JA_MIME_SAVE_OVERWRITE:-"no"}

# ........................................................... &do-it ...

dummy = "$id: HEADER; $MIME_H_ATTACHEMENT"

:0
*  MIME_H_ATTACHEMENT ?? [a-z]
{
    file = $JA_MIME_SAVE_DIR/$MIME_H_ATTACHEMENT

    :0
    * JA_MIME_SAVE_DECODE ?? yes
    {
	#   decode regardless of body content
	JA_MIME_DECODE_REGEXP = ".*"

	INCLUDERC = $RC_MIME_DECODE
    }

    # ..................................................... filename ...

    :0
    *    JA_MIME_SAVE_OVERWRITE ?? no
    *$ ? $IS_EXIST $file
    {
	:0
	*$ ! YYYY ?? $d
	{
            INCLUDERC = $RC_DATE
	}

	file = "$file.$YYYY-$MM-$DD"

	#   Still not unique?

	:0
	*$ ? $IS_EXIST $file
	{
	    :0 fhw
	    | $FORMAIL -I "X-MimeSave-Error: (file exists) $file"

	    # kill variable to prevent next recipe from running
	    file
	}
    }

    # .................................................... write out ...

    :0
    * file ?? [a-z]
    {
	:0 bwc:					# do not modify body
	* JA_MIME_SAVE_DEL ?? no
	| $CAT > $file

	#	Write out the attachement and replace body
	#	with reference to the file.

	:0 E
	{
	    LINEBUF	    = $JA_MIME_SAVE_LINEBUF

	    :0 fbw:
	    | ( $CAT > $file; echo "Saved to $file" )

	    LINEBUF = $MimeSaveLinebuf
	}
    }
}


dummy = "$id: BODY check"

:0 E
*  MIME_B_ATTACHEMENT		    ??  [a-z]
*  MIME_B_ATTACHEMENT_FILE_COUNT    ??  ^^1^^
{
    dummy = "$id: BODY ENTERED: can do only some limited operations."
    file  = $JA_MIME_SAVE_DIR/$MIME_B_ATTACHEMENT

    #	Try to locate the header where the content type is defined for
    #	file attachement. Note: there is no typo in the regexp, the
    #	caret(^) matches newline. See procmail tips page.
    #
    #   Content-Type: application/octet-stream
    #   Content-Disposition: attachment; filename="file.txt"
    #   Content-Transfer-Encoding: 7bit

    dummy = "$id: Check contentType BODY 1"

    :0
    *$ B ?? ^Content-Type:$s+\/.*\
            ^Content-Disposition:.*$MIME_B_ATTACHEMENT
    *  MATCH ?? \/.*
    {
	contentType = $MATCH
    }

    dummy = "$id: Check contentType BODY 2"

    :0 E
    *$ B ?? ^Content-Type:$s+\/.*\
	    ^Content-Transfer-Encoding:.*\
            ^Content-Disposition:.*$MIME_B_ATTACHEMENT
    *  MATCH ?? \/.*
    {
	contentType = $MATCH

	:0 
        *$ B ?? ^Content-Type:.*\
	        ^Content-Transfer-Encoding:$s\/.*\
                ^Content-Disposition:.*$MIME_B_ATTACHEMENT
        *  MATCH ?? \/.*
        {
	    contentEncoding = $MATCH
	}
    }



    #	We expect that the headers come in this order.
    #	If they don't, then we can't know the encoding.
    #	We don't even try anything else: Procmail is not the right tool
    #	for complete MIME handling.

    dummy = "$id: Check contentEncoding BODY"

    :0
    *  contentEncoding ?? ^^^^
    *$ B ?? ^Content-Type:.*\
            ^Content-Disposition:.*\
	    ^Content-Transfer-Encoding:$s+\/.*
    {
	contentEncoding = $MATCH
    }

    :0 E
    *  contentEncoding ?? ^^^^
    *$ B ?? ^Content-Type:.*\
	    ^Content-Transfer-Encoding:$s+\/.*
    {
	contentEncoding = $MATCH
    }


    :0
    *  contentEncoding ?? ^^^^
    *$ B ?? ^Content-Type:.*\
	    ^Content-Transfer-Encoding:$s+\/.*
    {
	contentEncoding = $MATCH
    }

    # ............................................... fix mixed-part ...
    #   In most typical message, user "says" something in text/plain and
    #   then adds an atatchement
    #
    #	But, due to order of the MIME headers we may have picked the
    #	text/plain. Change it to application/octet-stream if found.
    #
    #   Mime-Version: 1.0
    #   Content-Type: multipart/mixed; boundary="----------118D218634724256"
    #   
    #   ------------118D218634724256
    #   Content-Type: text/plain; charset=us-ascii
    #   Content-Transfer-Encoding: 7bit
    #   
    #   
    #   ------------118D218634724256
    #   Content-Type: application/octet-stream; name="Ass_rake.dbf"
    #   Content-Transfer-Encoding: base64
    #   Content-Disposition: attachment; filename="Ass_rake.dbf"

    dummy = "$id: Check contentType ($contentType) text/plain => application"

    :0
    *  contentType ?? text/
    *$ B           ?? ^Content-Type:$s+\/application.*
    {
	contentType = $MATCH

	dummy = "$id: finding Transfer-Encoding for application/*"

	:0
	*$ B     ?? ^Content-Type:$s+application.*\
		    ^Content-Transfer-Encoding:$s\/.*
	{
	    contentEncoding = $MATCH
	}
    }


    # ............................................... check filename ...
    #	Change filename if there is already that file

    dummy = "$id: check filename"

    :0
    *    JA_MIME_SAVE_OVERWRITE ?? no
    *$ ? $IS_EXIST $file
    {
	:0
	*$ ! YYYY ?? $d
	{
            INCLUDERC = $RC_DATE
	}

	file = "$file.$YYYY-$MM-$DD"

	#   Still not unique?

	:0
	*$ ? $IS_EXIST $file
	{
	    :0 fhw
	    | $FORMAIL -I "X-MimeSave-Error: (file exists) $file"

	    # ampty variable to prevent from next recipe from running
	    file = ""
	}

    }

    # ........................................................ &save ...
    # That nice backslash lines in the AWK are automatically handled 
    # by Emacs setup. See "Emacs tiny Tools"

    # 1) Locate the positions where the attchement starts
    # 2) When found, start looking for ( empty line which end the mime
    #    headers. GO is set to 1, when attachement starts
    # 3) Attachement ends when mime boundary is hit. Actually
    #    it ended one line before that, which was empty line.

    MimeSaveShellmetas  = $SHELLMETAS
    LINEBUF		= $JA_MIME_SAVE_LINEBUF
    SHELLMETAS

    :0 fbw
    * COUNT ?? [1-9]
    * file  ?? [a-z]
    | $AWK                                                                  \
      ' { BEGIN found = 0 }                                                 \
        {                                                                   \
            if ( match($0,MATCH) > 0 )                                      \
            {                                                               \
                 found++;                                                   \
            }                                                               \
	    if ( (found = $COUNT-1) &&  match($0,"^[ \t]*$") )              \
	    {                                                               \
		go = 1;                                                     \
		next;                                                       \
	    }                                                               \
	    if ( match($0, MIME) )                                          \
	    {                                                               \
	        go = 0;                                                     \
	    }                                                               \
	    if ( go )                                                       \
	    {                                                               \
		if ( DELETE == "yes")                                       \
		{                                                           \
		    if ( urlFlag == 0 )                                     \
		    {                                                       \
			urlFlag = 1;                                        \
			printf "\nExtracted to file:%s\n\n", FILE;          \
		    }                                                       \
		}                                                           \
                else                                                        \
                {                                                           \
		    print;                                                  \
		}                                                           \
		print $0 >> FILE;                                           \
		next;                                                       \
	    }                                                               \
	    print;                                                          \
	}                                                                   \
      ' DELETE="$JA_MIME_SAVE_DEL"                                          \
	MIME="$MIME_BOUNDARY"                                               \
        COUNT="$MIME_BOUNDARY_COUNT"                                        \
	MATCH="Disposition:.*$MIME_B_ATTACHEMENT"                           \
	FILE="$file"



    LINEBUF	= $MimeSaveLinebuf
    SHELLMETAS	= $MimeSaveShellmetas

    # ....................................................... decode ...
    dummy = "$id: Encoding($contentEncoding) of $file"

    :0
    *$ file		?? $a
    *$ contentEncoding	?? $a
    {
	file2 = "$file.raw";

	:0 wc
	* contentEncoding ?? base64
	| $CAT $file | $MIME_BIN_64 > $file2; $MV $file2 $file

	:0 Ewc
	* contentEncoding ?? quoted-printable
	| $CAT $file | $MIME_BIN_QP > $file2; mv $file2 $file

    }

}

dummy = "$id: end:"

# End of file pm-jamime-save.rc