qp.tcl

#                  #
# convert/qp.tcl   #
# V1.0		   #
####################


#############################################################################
#                                                                           #
# This file contains functions to convert a message to MIME QUOTED-PRINTABLE#
# format. 								    #
#                                                                           #
#############################################################################



#
# 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" \
					"Quoted-Printable"
				if {![is_root]} {
					tocharset "ISO-8859-1"
					encode "Quoted-Printable"
				}
			}
		}

	APPLICATION	{

			if {[is_set FILENAME]} {

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

			    	   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 {
				   addheader "Content-Transfer-Encoding" \
					"BASE64"

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

	IMAGE	{
			case $SUBTYPE in {
				
			GIF	{
					addheader "Content-Type" \
						"Image/GIF"
					addheader "Content-Transfer-Encoding" \
						"BASE64"

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

			JPEG	{
					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 {
			debug "$TYPE $SUBTYPE $ENC"
			addheader "Content-Type" \
				"application/octet-stream; X-Info=\"unknown\""
			addheader "Content-Transfer-Encoding" \
				"BASE64"

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

if {[set MAINTYPE [getmaintype]] != 0} {
	if {$MAINTYPE == "MIME"} {
		nextmessnode
		if {[set ENCO [getencoding]] != "8BIT"} {
		  dotunnel
		  return
		} \
		else {
		  set MTYPE [gettype]
		  case $MTYPE in {
		   TEXT {
		  	  encode "QUOTED-PRINTABLE"
			  topmessnode
			  rmheader "Content-Transfer-Encoding"
	                  addheader "Content-Transfer-Encoding" \
        	                 "Quoted-Printable"
			  return
			}
		   default {
			  encode "BASE64"
                          topmessnode
                          rmheader "Content-Transfer-Encoding"
                          addheader "Content-Transfer-Encoding" \
                                 "BASE64"
                          return
			}
		  }
	       }
	}
}

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

while {1 == 1} {
	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 ENC [getencoding]
			set FILENAME [getfilename]
			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
	}
}