Menu
▾
▴
RE: [Tcllib-devel] More on mime processing
|
From: Cameron L. <cl...@st...> - 2001-11-13 21:38:14
|
> From and...@Ac... Mon Nov 12 17:06:57 2001
> .
> .
> .
> Is is possible to send me the whole modified mime.tcl, or a unified diff ?
> I would like to integrate this change into the current sources.
> .
> .
> .
Dirty, dirty, dirty.
All I do is append what follows to mime.tcl.
There are dozens of better ways to do this,
none of which I have the time now to explain.
So, my answer is, yes, it's possible, but please
understand this is very much in the "at your own
risk" category.
When I can make time, I'll describe more of what's
going on.
Most important: it's only the "while {$moreP} ..."
loop that matters; and, in that neighborhood,
$string is "disposable", in a sense I can make pre-
cise.
======================================================================
# CL is experimenting with this on 12 November 2001.
# mime::parsepart --
#
# Parses the MIME headers and attempts to break up the message
# into its various parts, creating a MIME token for each part.
#
# Arguments:
# token The MIME token to parse.
#
# Results:
# Throws an error if it has problems parsing the MIME token,
# otherwise it just sets up the appropriate variables.
proc mime::parsepart {token} {
variable $token
upvar 0 $token state
if {[set fileP [info exists state(file)]]} {
seek $state(fd) [set pos $state(offset)] start
set last [expr {$state(offset)+$state(count)-1}]
} else {
set string $state(string)
}
set vline ""
while {1} {
set blankP 0
if {$fileP} {
if {($pos > $last) || ([set x [gets $state(fd) line]] <= 0)} {
set blankP 1
} else {
incr pos [expr {$x+1}]
}
} else {
if {[string length $string] == 0} {
set blankP 1
} else {
switch -- [set pos [string first "\n" $string]] {
-1 {
set line $string
set string ""
}
0 {
set blankP 1
set line ""
set string [string range $string 1 end]
}
default {
set line [string range $string 0 [expr {$pos-1}]]
set string [string range $string [expr {$pos+1}] end]
}
}
set x [string length $line]
}
}
if {(!$blankP) && ([string last "\r" $line] == [expr {$x-1}])} {
set line [string range $line 0 [expr {$x-2}]]
if {$x == 1} {
set blankP 1
}
}
if {(!$blankP) \
&& (([string first " " $line] == 0) \
|| ([string first "\t" $line] == 0))} {
append vline "\n" $line
continue
}
if {![string compare $vline ""]} {
if {$blankP} {
break
}
set vline $line
continue
}
if {([set x [string first ":" $vline]] <= 0) \
|| (![string compare \
[set mixed \
[string trimright \
[string range \
$vline 0 [expr {$x-1}]]]] \
""])} {
error "improper line in header: $vline"
}
set value [string trim [string range $vline [expr {$x+1}] end]]
switch -- [set lower [string tolower $mixed]] {
content-type {
if {[info exists state(content)]} {
error "multiple Content-Type fields starting with $vline"
}
if {![catch { set x [mime::parsetype $token $value] }]} {
set state(content) [lindex $x 0]
set state(params) [lindex $x 1]
}
}
content-md5 {
}
content-transfer-encoding {
if {([string compare $state(encoding) ""]) \
&& ([string compare $state(encoding) \
[string tolower $value]])} {
error "multiple Content-Transfer-Encoding fields starting with $vline"
}
set state(encoding) [string tolower $value]
}
mime-version {
set state(version) $value
}
default {
if {[lsearch -exact $state(lowerL) $lower] < 0} {
lappend state(lowerL) $lower
lappend state(mixedL) $mixed
}
array set header $state(header)
lappend header($lower) $value
set state(header) [array get header]
}
}
if {$blankP} {
break
}
set vline $line
}
if {![info exists state(content)]} {
set state(content) text/plain
set state(params) [list charset us-ascii]
}
if {![string match multipart/* $state(content)]} {
if {$fileP} {
set x [tell $state(fd)]
incr state(count) [expr {$state(offset)-$x}]
set state(offset) $x
} else {
set state(string) $string
}
if {[string match message/* $state(content)]} {
variable [set child $token-[incr state(cid)]]
set state(value) parts
set state(parts) $child
if {$fileP} {
mime::initializeaux $child \
-file $state(file) -root $state(root) \
-offset $state(offset) -count $state(count)
} else {
mime::initializeaux $child -string $state(string)
}
}
return
}
set state(value) parts
set boundary ""
foreach {k v} $state(params) {
if {![string compare $k boundary]} {
set boundary $v
break
}
}
if {![string compare $boundary ""]} {
error "boundary parameter is missing in $state(content)"
}
if {![string compare [string trim $boundary] ""]} {
error "boundary parameter is empty in $state(content)"
}
if {$fileP} {
set pos [tell $state(fd)]
}
set inP 0
set moreP 1
set i 0
if {!$fileP} {set list [split $string \n]}
while {$moreP} {
if {$fileP} {
if {$pos > $last} {
error "termination string missing in $state(content)"
}
if {[set x [gets $state(fd) line]] < 0} {
error "end-of-file encountered while parsing $state(content)"
}
incr pos [expr {$x+1}]
} else {
if {[string length $string] == 0} {
error "end-of-string encountered while parsing $state(content)"
}
# switch -- [set pos [string first "\n" $string]] {
# -1 {
# set line $string
# set string ""
# }
#
# 0 {
# set line ""
# set string [string range $string 1 end]
# }
#
# default {
# set line [string range $string 0 [expr {$pos-1}]]
# set string [string range $string [expr {$pos+1}] end]
# }
# }
if {$i >= [llength $list]} {
set line2 ???
set string ""
}
set line2 [lindex $list $i]
set line $line2
incr i
set x [string length $line]
}
if {[string last "\r" $line] == [expr {$x-1}]} {
set line [string range $line 0 [expr {$x-2}]]
}
if {[string first "--$boundary" $line] != 0} {
if {$inP && !$fileP} {
append start $line "\n"
}
continue
}
if {!$inP} {
if {![string compare $line "--$boundary"]} {
set inP 1
if {$fileP} {
set start $pos
} else {
set start ""
}
}
continue
}
if {([set moreP [string compare $line "--$boundary--"]]) \
&& ([string compare $line "--$boundary"])} {
if {$inP && !$fileP} {
append start $line "\n"
}
continue
}
variable [set child $token-[incr state(cid)]]
lappend state(parts) $child
if {$fileP} {
if {[set count [expr {$pos-($start+$x+3)}]] < 0} {
set count 0
}
mime::initializeaux $child \
-file $state(file) -root $state(root) \
-offset $start -count $count
seek $state(fd) [set start $pos] start
} else {
mime::initializeaux $child -string \
[string range $start 0 [expr {[string length $start]-2}]]
set start ""
}
}
}
|
