# header/mime.tcl
# 
# Procedures to parse a MIME message.
#
#

proc check_mime_multipart {} {
	global PARAMETER
	if {[is_set PARAMETER(boundary)]} {
		addboundary "--$PARAMETER(boundary)"
		addendboundary "--$PARAMETER(boundary)--"
	}
}
proc check_mime_file {} {
	global PARAMETER
	if {[is_set PARAMETER(name)]} {
		setfilename "$PARAMETER(name)"
		unset PARAMETER(name)
	}
}

proc check_mime_text {} {
	global PARAMETER
debug "check_mime_text"
	if {[is_set PARAMETER(charset)]} {
		set CHARSET [string toupper $PARAMETER(charset)]
		case $CHARSET in {
			X-MACINTOSH	{
				setfromcharset "MACINTOSH"
			}
		
			default		{
				setfromcharset $PARAMETER(charset)
			}
		}
	} \
	else \
	{
		setfromcharset "US-ASCII"
	}
}

proc check_mime_encoding {} {
	global ENCODING
	case $ENCODING in {
	BASE64		{
				setencoding "BASE64"
			}

	QUOTED-PRINTABLE {
				setencoding "QUOTED-PRINTABLE"
			}

	X-UUENCODE	{
				setencoding "UUENCODE"
				set ENCODING "UUENCODE"
			}
	
	X-BINHEX	{
				setencoding "BINHEX"
				set ENCODING "BINHEX"
			}

	default		{
				setencoding "7BIT"
			}
	}
}

#
# Main routine for parsing MIME type headers
#

proc check_mime_header { } {
	global ENCODING
	global MAINTYPE
	global KNOW_TYPE
	global PARAMETER
	global APPLEDOUBLE

	if {[is_set PARAMETER]} {
		unset PARAMETER	
	}

	if {[is_set ENCODING]} {
		unset ENCODING
	}

	#
	# If type specifically known not to be MIME return
	#
	if {[is_set MAINTYPE]} {
		if {$MAINTYPE != "MIME"} {
			return 0
		}
	} \
	else \
	{
		#
		# If processing root of message then check if message
		# has got the required header MIME-Version. If so, this
		# message is considered to be in MIME format, else return
		# and check other message types.
		#
	if {[is_root]} {
		if {[set MIMEVERSION [getheader "MIME-Version"]] != 0} {
			set MAINTYPE "MIME"
			setmaintype "MIME"
		} \
		else \
		{
			return 0
		}
	}
	}


	addspecheader MIME-version

	if {[set CTYPE [getheader "Content-Type"]] != 0} \
	{
		addspecheader Content-Type

		if {![regsub -all ";" $CTYPE " " CONTENTTYPE]} {
			set CONTENTTYPE $CTYPE
		}
		set HTYPE [string tolower [lindex $CONTENTTYPE 0]]
		if {[llength $CONTENTTYPE] > 1} {
			set PARMS [lrange $CONTENTTYPE 1 end]	

			foreach PAR  $PARMS {
				regsub "=" $PAR " " PP
				set PARAMETER([string tolower \
					[lindex $PP 0]])\
					[lindex $PP 1]
			}
		}

		if {[is_set TYPE]} {
			unset TYPE
		}

		case $HTYPE in { 

	application/mac-binhex40	{
				settype "APPLICATION"
				setencoding "BINHEX"
				set ENCODING "BINHEX"
				set TYPE "APPLICATION"
					}

	application/applefile	{
				if {[is_set APPLEDOUBLE]} {
					settype "APPLEDOUBLE"
					unset APPLEDOUBLE
					set APPLEDDATA "TRUE"
					
				} \
				else {
					settype "APPLESINGLE"
				}
				set TYPE "APPLICATION"
					}
				}

	if {![is_set TYPE]} {
		case $HTYPE in { 

	application/octet-stream	{
				settype "APPLICATION"
				set TYPE "APPLICATION"
					}


	application/postscript		{
				settype "APPLICATION"
				setsubtype "POSTSCRIPT"
				set TYPE "APPLICATION"
					}


	audio/basic			{
				setsubtype "ULAW"
				settype "AUDIO"
				set TYPE "AUDIO"
					}


	image/gif			{
				settype "IMAGE"
				setsubtype "GIF"
				set TYPE "IMAGE"
					}


	image/jpeg			{
				settype "IMAGE"
				setsubtype "JPEG"
				set TYPE "IMAGE"
					}


	message/rfc822			{
				settype "MESSAGE"
				setsubtype "RFC822"
				set TYPE "MESSAGE"
					}


	message/partial			{
				settype "MESSAGE"
				setsubtype "PARTIAL"
				set TYPE "MESSAGE"
					}


	message/external-body		{
				settype "MESSAGE"
				setsubtype "EXTERNAL"
				set TYPE "MESSAGE"
					}


	multipart/alternative		{
				settype "MULTIPART"
				set TYPE "MULTIPART"
					}


	multipart/appledouble		{
				settype "MULTIPART"
				set TYPE "MULTIPART"
				set APPLEDOUBLE "TRUE"
					}


	multipart/digest		{
				settype "MULTIPART"
				set TYPE "MULTIPART"
					}


	multipart/mixed			{
				settype "MULTIPART"
				set TYPE "MULTIPART"
					}


	multipart/parallell		{
				settype "MULTIPART"
				set TYPE "MULTIPART"
					}


	text/plain			{
				settype "TEXT"
				set TYPE "TEXT"
				debug "setting type text"
					}


	text/richtext			{
				settype "TEXT"
				setsubtype "RICHTEXT"
				set TYPE "TEXT"
					}


	video/mpeg			{
				settype "VIDEO"
				setsubtype "MPEG"
				set TYPE "VIDOE"
					}


	default				{
				settype "APPLICATION"
				set TYPE "UNKNOWN"
					}
				}
			}
		} \
		else \
		{
			settype "TEXT"
			set TYPE "TEXT"
		}
	
		#
		# Check which encoding is specified if not set already
		#
		if {[is_set ENCODING]} {
			debug "Already got encoding $ENCODING"
		}
		if {[set ENCODING [string toupper [getheader \
			"Content-Transfer-Encoding"]]] != 0} {
			addspecheader Content-Transfer-Encoding
			check_mime_encoding
		} \
		else \
		{
			set ENCODING "7BIT"
		}
			
		debug "Setting suspected encoding to $ENCODING"
		unset ENCODING



		#
		# Check for description line
		#
		if {[set DESCRIPTION [getheader "Content-Description"]] != 0} {
			addspecheader Content-Description
		}

		#
		# Check for Content-ID
		#
		if {[set CID [getheader "Content-ID"]] != 0} {
			addspecheader Content-ID
		}

		#
		# Special processing
		#
		if {$TYPE == "MULTIPART"} {
			check_mime_multipart
		}
		if {$TYPE == "TEXT"} {
			check_mime_text
		}
		check_mime_file

		return 1
}

check_mime_header


