localmime.tcl

#                                   #
# convert/localmime.tcl version 2.0 #
#####################################

#############################################################################
#                                                                           #
# This file contains functions to convert a message to MIME format for      #
# local MIME-capable mailers. Decodes QP'ed and BASE64'ed Text parts        #
#                                                                           #
#                                                       LadyBug 15.12. -94  #
#############################################################################




#
# mime_type {TYPE}
#
# Process various types
#
if {[is_set APPLEOUBLE]} {
	unset APPLEDOUBLE
}
proc mime_type {TYPE SUBTYPE HIGHCHARS FILENAME ENC} {
	global APPLEDOUBLE
	if {[is_set APPLEDOUBLE]} {
		putendboundary
		unset APPLEDOUBLE
	}
	case $TYPE in {
	TEXT	{
			if {$HIGHCHARS == 0} {

				addheader "Content-Type" \
					"text/plain; charset=\"us-ascii\""

				addheader "Content-Transfer-Encoding" \
					"7bit"
			} \
			else \
			{
				if {[knowfromcharset]} {
					addheader "Content-Type" \
					"text/plain; charset=\"iso-8859-1\""
				} \
				else \
				{
					addheader "Content-Type" \
					"text/plain; charset=\"unknown-8bit\""
				}
				addheader "Content-Transfer-Encoding" \
					"8bit"
			}
		}

	APPLICATION	{
			if {[is_set FILENAME]} {

                                if {$ENC == "UUENCODE"} {
 
				   addheader "Content-Type" \
				    "application/octet-stream; name=\"$FILENAME.uue\""

                                   addheader "Content-Transfer-Encoding" \
                                      "7bit"

                                } \
                                else {

				       addheader "Content-Type" \
				         "application/octet-stream; name=\"$FILENAME\""

					if {$ENC == "BINHEX"} {
					  addheader "Content-Transfer-Encoding" \
						"7bit"
					} \
					else {
					  addheader "Content-Transfer-Encoding" \
					   "BASE64"

					  if {![is_root]} {
						do_code "BASE64"
					  }
					}
				}
			} \
			else \
			{

				addheader "Content-Type" \
					"application/octet-stream"

                                if {$ENC == "UUENCODE"} {
 
                                   addheader "Content-Transfer-Encoding" \
                                      "7bit"
                                } \
                                else {
                                   if {$ENC == "BINHEX"} {
                                         addheader "Content-Transfer-Encoding"$
                                                "7bit"
                                   } \   
                                   else {

  				      addheader "Content-Transfer-Encoding" \
					"BASE64"

				      if {![is_root]} {
					do_code "BASE64"
				      }
				  }
				}
			}
		}

	IMAGE	{
			case $SUBTYPE in {
				
			GIF	{
					if {[is_set FILENAME]} { 
					    addheader "Content-Type" \
						"Image/GIF"
					} \
					else {
					    addheader "Content-Type" \
						"Image/GIF; name=\"$FILENAME.gif\""
					}
					addheader "Content-Transfer-Encoding" \
						"BASE64"

					if {![is_root]} {
						do_code "BASE64"
					}
				}

			JPEG	{
					if {[is_set FILENAME]} { 
					    addheader "Content-Type" \
						"Image/JPEG; name=\"$FILENAME.jpg\""
					} \
					else {
					    addheader "Content-Type" \
						"Image/JPEG"
					}
					addheader "Content-Transfer-Encoding" \
						"BASE64"

					if {![is_root]} {
						do_code "BASE64"
					}
				}

			default {
					if {[is_set SUBTYPE]} {
						addheader "Content-Type" \
					"Image/X-$SUBTYPE"
					} \
					else {
						addheader "Content-Type" \
					"Application/Octet-Stream"
					}
					addheader "Content-Transfer-Encoding" \
						"BASE64"

					if {![is_root]} {
						do_code "BASE64"
					}
				}
			}
		}

	AUDIO	{
			case $SUBTYPE in {
				
			ULAW	{
					addheader "Content-Type" \
						"Audio/Basic"
					addheader "Content-Transfer-Encoding" \
						"BASE64"

					if {![is_root]} {
						do_code "BASE64"
					}
				}
			default {
					if {[is_set SUBTYPE]} {
						addheader "Content-Type" \
					"Audio/X-$SUBTYPE"
					} \
					else {
						addheader "Content-Type" \
					"Application/Octet-Stream"
					}
					addheader "Content-Transfer-Encoding" \
						"BASE64"

					if {![is_root]} {
						do_code "BASE64"
					}
				}
			}
		}

	BINHEX {
			if {[is_set FILENAME] != 0} {

				addheader "Content-Type" \
					 "application/mac-binhex40; name=\"$FILENAME\""

			} \
			else \
			{

				addheader "Content-Type" \
					"application/mac-binhex40"

			}
		}

	APPLESINGLE {
			if {[is_set FILENAME] != 0} {

				addheader "Content-Type" \
				 "application/applefile; name=\"$FILENAME\""

			} \
			else \
			{

				addheader "Content-Type" \
					"application/applefile"

			}
			addheader "Content-Transfer-Encoding" \
				"BASE64"

			if {![is_root]} {
				do_code "BASE64"
			}
		}

	APPLEDOUBLE {
			insertmessnode
			set BOUNDARY [makeboundary]
			addheader "Content-Type" \
			"multipart/appledouble; boundary=\"$BOUNDARY\""
			nextmessnode
			addboundary "--$BOUNDARY"
			addendboundary "--$BOUNDARY--"
			if {[is_set FILENAME] != 0} {

				addheader "Content-Type" \
				 "application/applefile; name=\"$FILENAME\""

			} \
			else \
			{

				addheader "Content-Type" \
					"application/applefile"

			}
			addheader "Content-Transfer-Encoding" \
				"Base64"
			do_code "BASE64"
			set APPLEDOUBLE "TRUE"
		}

	default {
			addheader "Content-Type" \
				"application/octet-stream; X-Info=\"unknown\""
			addheader "Content-Transfer-Encoding" \
				"BASE64"

			if {![is_root]} {
				do_code "BASE64"
			}
		}
	}
}

proc handle_part { TYPE SUB ENC BOUNDARY } {
	case $TYPE in {

	    TEXT {
		   set NRO [is_multipart]
		   if { $ENC == "QUOTED-PRINTABLE" || $ENC == "BASE64" } {
		     do_decode
		     if {$NRO < 1} {
			topmessnode
		     }
		     rmheader "Content-Transfer-Encoding"
       		     addheader "Content-Transfer-Encoding" "8BIT"
	   	   }
	    }

	    default {
	    }

	}
}


if {[set MAINTYPE [getmaintype]] != 0} {
	if {$MAINTYPE == "MIME"} {
		if {[is_multipart] > 0} {
		     set MMAIN [gettype]
		     if { $MMAIN == "MULTIPART" } {
			set BOUNDARY [makeboundary]
			set A [nextmessnode]
			while { $A > 0 } {
				set MMAIN [gettype]
				set ENCO [getencoding]
				set SUB [getsubtype]
				if { $MMAIN == "MULTIPART" } {
					dotunnel
					return
				} \
				else {
					handle_part $MMAIN $SUB $ENCO $BOUNDARY
				}
				set A [nextmessnode]
			}
			dosubheaders
			topmessnode
			addboundary "--$BOUNDARY"
			addendboundary "--$BOUNDARY--"
			set SUB [getsubtype]
			rmheader "Content-Type"
		        addheader "Content-Type" \
				"MULTIPART/$SUB; boundary=\"$BOUNDARY\""
			return
		     }
		} \
		else {
		    set BOUNDARY [makeboundary]
		    nextmessnode
		    set MMAIN [gettype]
		    set ENCO [getencoding]
		    set SUB [getsubtype]
		    handle_part $MMAIN $SUB $ENCO $BOUNDARY
		    dosubheaders
		    return
		}
	}
}

topmessnode
if {[is_multipart] < 1} {
	set MMAIN [gettype]
} \
else \
{
	set MMAIN "MULTIPART"
	set BOUNDARY [makeboundary]
	addboundary "--$BOUNDARY"
	addendboundary "--$BOUNDARY--"
	dosubheaders
}

while {1 == 1} {
	rmspecheader
	joinextension
	if {[is_root]} {
		addheader "MIME-Version" "1.0"
		if {$MMAIN == "MULTIPART"} {
			addheader "Content-Type" \
				"Multipart/Mixed; boundary=\"$BOUNDARY\""
		} \
		else \
		{
			nextmessnode
			set MMAIN [gettype]
			set SUBTYPE [getsubtype]
			set HIGHCHARS [gethighchars]
			set FILENAME [getfilename]
			set ENC [getencoding]
			topmessnode
			mime_type $MMAIN $SUBTYPE $HIGHCHARS $FILENAME $ENC
		}
	} \
	else \
	{
		if {[is_set APPLEDOUBLE]} {
			if {![hasbody]} {
				killbody
			}
		}
		set SUBTYPE [getsubtype]
		set MMAIN [gettype]
		set HIGHCHARS [gethighchars]
		set FILENAME [getfilename]
		set ENC [getencoding]
		mime_type $MMAIN $SUBTYPE $HIGHCHARS $FILENAME $ENC
	}

	set A [nextmessnode]
	if {$A < 1} {
		break
	}
}