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
}
}