# mime.test - Test suite for TclMIME                     -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
#
# RCS: @(#) $Id: mime.test,v 1.12.2.1 2004/05/24 02:58:11 andreas_kupries Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

# This code loads md5x, i.e. md5 v2. Proper testing should do one run
# using md5 v1, aka md5.tcl as well.

package forget md5
catch {namespace delete md5}
if {[catch {source [file join [file dirname [file dirname [info script]]] md5 md5x.tcl]} msg]} {
    puts "skipped [file tail [info script]] (md5x.tcl): $msg"
    return
}

package forget mime
catch {namespace delete mime}
if {[catch {source [file join [file dirname [info script]] mime.tcl]} msg]} {
    puts "skipped [file tail [info script]] (mime.tcl): $msg"
    return
}

namespace import mime::*

puts "tcltest [package present tcltest]"
puts "mime    [package present mime]"
puts "- md5 [package present md5]"



test mime-1.1 {initialize with no args} {
    catch {initialize} res
    subst $res
} {specify exactly one of -file, -parts, or -string}

test mime-2.1 {Generate a MIME message} {
    set tok [initialize -canonical "Text/plain" -string "jack and jill"]
    set msg [mime::buildmessage $tok]
    # The generated message is predictable except for the Content-ID
    regexp "MIME-Version: 1.0\r
Content-ID: \[^\n]+\r
Content-Type: text/plain\r
\r
jack and jill" $msg
} 1

test mime-2.2 {Generate a multi-part MIME message} {
    set tok1 [initialize -canonical "Text/plain" -string "jack and jill"]
    set tok2 [initialize -canonical "Text/plain" -string "james"]
    set bigTok [mime::initialize -canonical Multipart/MyType \
	    -param [list MyParam foo] \
	    -param [list boundary bndry] \
	    -header [list Content-Description "Test Multipart"] \
	    -parts [list $tok1 $tok2]]
    set msg [mime::buildmessage $bigTok]

    # The generated message is predictable except for the Content-ID
    list [regexp "MIME-Version: 1.0\r
Content-Description: Test Multipart\r
Content-ID: \[^\n]+\r
Content-Type: multipart/mytype;\r
              \[^\n]+;\r
              \[^\n]+\r
\r
--bndry\r
MIME-Version: 1.0\r
Content-ID: \[^\n]+\r
Content-Type: text/plain\r
\r
jack and jill\r
\r
--bndry\r
MIME-Version: 1.0\r
Content-ID: \[^\n]+\r
Content-Type: text/plain\r
\r
james\r
\r
--bndry--\r
" $msg] [regexp "boundary=\"bndry\"" $msg] [regexp "myparam=\"foo\"" $msg]
} {1 1 1}

test mime-3.1 {Parse a MIME message} {
    set msg {MIME-Version: 1.0
Content-Type: Text/plain

I'm the message.}
    set tok [mime::initialize -string $msg]
    mime::getbody $tok
} "I'm the message."

test mime-3.2 {Parse a multi-part MIME message} {
    set msg {MIME-Version: 1.0
Content-Type: Multipart/foo; boundary="bar"

--bar
MIME-Version: 1.0
Content-Type: Text/plain

part1
--bar
MIME-Version: 1.0
Content-Type: Text/plain

part2
--bar
MIME-Version: 1.0
Content-Type: Text/plain

part3
--bar--
}

    set tok [mime::initialize -string $msg]
    set partToks [mime::getproperty $tok parts]

    set res ""
    foreach childTok $partToks {
	lappend res [mime::getbody $childTok]
    }
    set res
} {part1 part2 part3}

test mime-3.3 {Try to parse a totally invalid message} {
    catch {mime::initialize -string "blah"} err0
    set err0
} {improper line in header: blah}

test mime-3.4 {Try to parse a MIME message with an invalid version} {
    set msg1 {MIME-Version: 2.0
Content-Type: text/plain

msg1}

    set tok [mime::initialize -string $msg1]
    catch {mime::getbody $tok} err1
    catch {mime::buildmessage $tok} err1a
    list $err1 $err1a
} "msg1 {MIME-Version: 2.0\r
Content-Type: text/plain\r
\r
msg1\r
}"

test mime-3.5 {Try to parse a MIME message with no newline between headers and data} {
    set msg2 {MIME-Version: 1.0
Content-Type: foobar
data without newline}

    catch {mime::initialize -string $msg2} err2
    set err2
} {improper line in header: data without newline}

test mime-3.6 {Try to parse a MIME message with no MIME version and generate a new message from it} {

    # No MIME version
    set msg3 {Content-Type: text/plain

foo}

    set tok [mime::initialize -string $msg3]
    catch {mime::getbody $tok} err3
    catch {mime::buildmessage $tok} err3a
    list $err3 $err3a
} "foo {MIME-Version: 1.0\r
Content-Type: text/plain\r
\r
foo\r
}"

test mime-3.7 {Test mime with a bad email [SF Bug 631314 ]} {
    catch {
	set tok [mime::initialize -file \
		[file join $tcltest::testsDirectory badmail1.txt]]
    } msg ; #{}
    set msg
} {termination string missing in multipart/mixed}

test mime-3.8 {Test mime with another bad email [SF Bug 631314 ]} {
    catch {
	set tok [mime::initialize -file \
		[file join $tcltest::testsDirectory badmail2.txt]]
    } msg ; #{}
    set msg
} {termination string missing in multipart/related}

test mime-4.1 {Test qp_encode with a > 76 character string containing special chars.} {
    set str1 "foo!\"\t barbaz \$ ` \{ # jack and jill went up a hill to fetch a pail of water. Jack fell down and said !\"\#\$@\[\\\]^`\{\|\}\~  \nJill said, \"Oh my\""
    mime::qp_encode $str1
} "foo=21=22\t barbaz =24 =60 =7B =23 jack and jill went up a hill to fetch a=\n pail of water. Jack fell down and said =21=22=23=24=40=5B=5C=5D=5E=60=7B=\n=7C=7D=7E =20\nJill said, =22Oh my=22"

test mime-4.2 {Check that encode/decode yields original string} {
    set str1 "foo!\"\t barbaz \$ ` \{ # jack and jill went up a hill to fetch a pail of water. Jack fell down and said !\"\#\$@\[\\\]^`\{\|\}\~  \nJill said, \"Oh my\"  "
    set enc [mime::qp_encode $str1]
    set dec [mime::qp_decode $enc]
    string equal $dec $str1
} {1}

test mime-4.3 {mime::decode data that might come from an MUA} {
    set enc "I'm the =22 message =\nwith some new lines=  \n but with some extra space, too.   "
    mime::qp_decode $enc
} "I'm the \" message with some new lines but with some extra space, too."

test mime-4.4 {Test qp_encode with non-US_ASCCI characters.} {
    set str1 "Test de caractères accentués : â î é ç et quelques contrôles \"\[|\]()\""
    mime::qp_encode $str1
} "Test de caract=E8res accentu=E9s : =E2 =EE =E9 =E7 et quelques contr=F4le=\ns =22=5B=7C=5D()=22"





test mime-5.1 {Test word_encode with quoted-printable method} {
    mime::word_encode iso8859-1 quoted-printable "Test de contrôle effectué"
} "=?ISO-8859-1?Q?Test_de_contr=F4le_effectu=E9?="

test mime-5.2 {Test word_encode with base64 method} {
    mime::word_encode iso8859-1 base64 "Test de contrôle effectué"
} "=?ISO-8859-1?B?VGVzdCBkZSBjb250cvRsZSBlZmZlY3R16Q==?="

test mime-5.3 {Test encode+decode with quoted-printable method} {
    set enc [mime::word_encode iso8859-1 quoted-printable "Test de contrôle effectué"]
    mime::word_decode $enc
} {iso8859-1 quoted-printable {Test de contrôle effectué}}

test mime-5.4 {Test encode+decode with base64 method} {
    set enc [mime::word_encode iso8859-1 base64 "Test de contrôle effectué"]
    mime::word_decode $enc
} {iso8859-1 base64 {Test de contrôle effectué}}

test mime-5.5 {Test decode with lowercase quoted-printable method} {
	mime::word_decode "=?ISO-8859-1?q?Test_lowercase_q?="
} {iso8859-1 quoted-printable {Test lowercase q}}

test mime-5.6 {Test decode with lowercase base64 method} {
	mime::word_decode "=?ISO-8859-1?b?VGVzdCBsb3dlcmNhc2UgYg==?="
} {iso8859-1 base64 {Test lowercase b}}

test mime-6.1 {Test field_decode (from RFC 2047, part 8)} {
    mime::field_decode {=?US-ASCII?Q?Keith_Moore?= <moore@cs.utk.edu>}
} {Keith Moore <moore@cs.utk.edu>}

test mime-6.2 {Test field_decode (from RFC 2047, part 8)} {
    mime::field_decode {=?ISO-8859-1?Q?Patrik_F=E4ltstr=F6m?= <paf@nada.kth.se>}
} {Patrik Fältström <paf@nada.kth.se>}

test mime-6.3 {Test field_decode (from RFC 2047, part 8)} {
    mime::field_decode {=?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
			=?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=}
} {If you can read this you understand the example.}

foreach {n encoded expected} {
    4 "(=?ISO-8859-1?Q?a?=)"
    "(a)"
    5 "(=?ISO-8859-1?Q?a?= b)"
    "(a b)"
    6 "(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)"
    "(ab)"
    7 "(=?ISO-8859-1?Q?a?=  =?ISO-8859-1?Q?b?=)"
    "(ab)"
    8 "(=?ISO-8859-1?Q?a?=
    =?ISO-8859-1?Q?b?=)"
    "(ab)"
    9 "(=?ISO-8859-1?Q?a_b?=)"
    "(a b)"
    10 "(=?ISO-8859-1?Q?a?= =?ISO-8859-2?Q?_b?=)"
    "(a b)"
    11 "(=?ISO-8859-1?Q?a?=x=?ISO-8859-2?Q?_b?=)"
    "(ax b)"
    12 "a         b         c"
    "a         b         c"
    13 ""
    ""
} {
    test mime-6.$n {Test field_decode (from RFC 2047, part 8)} {
	mime::field_decode $encoded
    } $expected ; # {}
}

foreach {bug n encoded expected} {
    764702 1 "(=?utf-8?Q?H=C3=BCrz?=)" "(Hürz)"
} {
    test mime-7.$n "Test field_decode (from SF Tcllib bug $bug)" {
	mime::field_decode $encoded
    } $expected ; # {}
}

test mime-7.1 {Test reversemapencoding+mapencoding with preferred name} {
    set charset [mime::reversemapencoding "US-ASCII"]
    mime::mapencoding $charset
} {US-ASCII}

test mime-7.2 {Test reversemapencoding+mapencoding with alias} {
    set charset [mime::reversemapencoding "UTF8"]
    mime::mapencoding $charset
} {UTF-8}


test mime-8.0 {Test chunk handling of copymessage and helpers} {
    set in [makeFile [set data [string repeat [string repeat "123456789 " 10]\n 350]] input.txt]
    set mi [makeFile {} mime.txt]

    set token [mime::initialize -canonical text/plain -file $in]

    set f [open $mi w]
    fconfigure $f -translation binary
    mime::copymessage $token $f
    close $f

    set token [mime::initialize -file $mi]
    set newdata [mime::getbody $token]
    set res [string compare $data $newdata]

    removeFile input.txt
    removeFile mime.txt
    unset data newdata token f in mi
    set res
} 0

::tcltest::cleanupTests
