1# mbox.tcl - mailbox package 2# 3# (c) 1999 Marshall T. Rose 4# Hold harmless the author, and any lawful use is allowed. 5# 6 7# 8# TODO: 9# 10# mbox::initialize 11# add -pop server option 12# add -imap server option 13# along with -username, -password, and -passback 14# 15# mbox::getmsgproperty 16# add support for deleted messages 17# 18# mbox::deletemsg token msgNo 19# marks a message for deletion 20# 21# mbox::synchronize token ?-commit boolean? 22# commits or rollllbacks changes 23 24 25package provide mbox 1.0 26 27package require mime 1.1 28 29 30# 31# state variables: 32# 33# msgs: serialized array of messages, containing array of: 34# msgNo, mime 35# count: number of messages 36# first: number of initial message 37# last: number of final message 38# value: either "file", or "directory" 39# 40# file: file containing mailbox 41# fd: corresponding file descriptor 42# fileA: serialized array of messages, containing array of: 43# msgNo, offset, size 44# 45# directory: directory containing mailbox 46# dirA: serialized array of messages, containing array of: 47# msgNo, size 48# 49 50namespace eval mbox { 51 variable mbox 52 array set mbox { uid 0 } 53 54 namespace export initialize finalize getproperty \ 55 getmsgtoken getmsgproperty 56} 57 58 59proc mbox::initialize {args} { 60 global errorCode errorInfo 61 62 variable mbox 63 64 set token [namespace current]::[incr mbox(uid)] 65 66 variable $token 67 upvar 0 $token state 68 69 if {[set code [catch { eval [list mbox::initializeaux $token] $args } \ 70 result]]} { 71 set ecode $errorCode 72 set einfo $errorInfo 73 74 catch { mbox::finalize $token -subordinates dynamic } 75 76 return -code $code -errorinfo $einfo -errorcode $ecode $result 77 } 78 79 return $token 80} 81 82 83proc mbox::initializeaux {token args} { 84 variable $token 85 upvar 0 $token state 86 87 set state(msgs) "" 88 set state(count) 0 89 set state(first) 0 90 set state(last) 0 91 92 set argc [llength $args] 93 for {set argx 0} {$argx < $argc} {incr argx} { 94 set option [lindex $args $argx] 95 if {[incr argx] >= $argc} { 96 error "missing argument to $option" 97 } 98 set value [lindex $args $argx] 99 100 switch -- $option { 101 -directory { 102 set state(directory) $value 103 } 104 105 -file { 106 set state(file) $value 107 } 108 109 default { 110 error "unknown option $option" 111 } 112 } 113 } 114 115 set valueN 0 116 foreach value [list directory file] { 117 if {[info exists state($value)]} { 118 set state(value) $value 119 incr valueN 120 } 121 } 122 if {$valueN != 1} { 123 error "specify exactly one of -directory, or -file" 124 } 125 126 return [mbox::initialize_$state(value) $token] 127} 128 129 130proc mbox::initialize_file {token} { 131 variable $token 132 upvar 0 $token state 133 134 fconfigure [set state(fd) [open $state(file) { RDONLY }]] \ 135 -translation binary 136 137 array set fileA "" 138 set msgNo 0 139 140 if {[gets $state(fd) line] < 0} { 141 return $token 142 } 143 switch -regexp -- $line { 144 "^From " { 145 set format Mailx 146 set preB "From " 147 148 set phase "" 149 } 150 151 "\01\01\01\01" { 152 set format MMDF 153 set preB "\01\01\01\01" 154 set postB "\01\01\01\01" 155 156 if {([gets $state(fd) line] >= 0) \ 157 && ([string first "From MAILER-DAEMON " $line] == 0)} { 158 set phase skip 159 } else { 160 set phase pre 161 } 162 } 163 164 default { 165 error "unrecognized mailbox format" 166 } 167 } 168 seek $state(fd) 0 start 169 170 while {[gets $state(fd) line] >= 0} { 171 switch -- $format/$phase { 172 Mailx/ { 173 if {[string first $preB $line] == 0} { 174 if {$msgNo > 0} { 175 set fileA($msgNo) [list msgNo $msgNo offset $offset \ 176 size $size] 177 } 178 179 incr msgNo 180 set offset [tell $state(fd)] 181 set size 0 182 } else { 183 incr size [expr {[string length $line]+1}] 184 } 185 } 186 187 MMDF/pre { 188 if {![string compare $preB $line]} { 189 incr msgNo 190 set offset [tell $state(fd)] 191 set size 0 192 193 set phase post 194 } else { 195 error "invalid mailbox" 196 } 197 } 198 199 MMDF/post { 200 if {![string compare $postB $line]} { 201 set fileA($msgNo) [list msgNo $msgNo offset $offset \ 202 size $size] 203 204 set phase pre 205 } else { 206 incr size [expr {[string length $line]+1}] 207 } 208 } 209 210 MMDF/skip { 211 if {![string compare $preB $line]} { 212 set phase skip2 213 } 214 } 215 216 MMDF/skip2 { 217 if {![string compare $postB $line]} { 218 set phase pre 219 } 220 } 221 } 222 } 223 224 switch -- $format/$phase { 225 Mailx/ { 226 if {$msgNo > 0} { 227 set fileA($msgNo) [list msgNo $msgNo offset $offset \ 228 size $size] 229 } 230 } 231 232 MMDF/post 233 - 234 MMDF/skip2 { 235 error "incomplete mailbox" 236 } 237 } 238 239 set state(fileA) [array get fileA] 240 if {[set state(last) [set state(count) $msgNo]] > 0} { 241 set state(first) 1 242 } 243 244 return $token 245} 246 247 248proc mbox::initialize_directory {token} { 249 variable $token 250 upvar 0 $token state 251 252 array set dirA "" 253 254 set first 0 255 set last 0 256 foreach file [glob -nocomplain [file join $state(directory) *]] { 257 if {(![regexp {^[1-9][0-9]*$} [set msgNo [file tail $file]]]) \ 258 || ([catch { file size $file } size])} { 259 continue 260 } 261 262 if {($first == 0) || ($msgNo < $first)} { 263 set first $msgNo 264 } 265 if {$last < $msgNo} { 266 set last $msgNo 267 } 268 269 set dirA($msgNo) [list msgNo $msgNo size $size] 270 incr state(count) 271 } 272 273 set state(dirA) [array get dirA] 274 if {[set state(last) $last] > 0} { 275 set state(first) $first 276 } 277 278 return $token 279} 280 281proc mbox::finalize {token args} { 282 variable $token 283 upvar 0 $token state 284 285 array set options [list -subordinates dynamic] 286 array set options $args 287 288 switch -- $options(-subordinates) { 289 all 290 - 291 dynamic { 292 array set msgs $state(msgs) 293 294 for {set msgNo $state(first)} \ 295 {$msgNo <= $state(last)} \ 296 {incr msgNo} { 297 if {![catch { array set msg $msgs($msgNo) }]} { 298 eval [list mime::finalize $msg(mime)] $args 299 } 300 } 301 } 302 303 none { 304 } 305 306 default { 307 error "unknown value for -subordinates $options(-subordinates)" 308 } 309 } 310 311 if {[info exists state(fd)]} { 312 catch { close $state(fd) } 313 } 314 315 foreach name [array names state] { 316 unset state($name) 317 } 318 unset $token 319} 320 321 322proc mbox::getproperty {token {property ""}} { 323 variable $token 324 upvar 0 $token state 325 326 switch -- $property { 327 "" { 328 return [list count $state(count) \ 329 first $state(first) \ 330 last $state(last) \ 331 messages [mbox::getmessages $token]] 332 } 333 334 -names { 335 return [list count first last messages] 336 } 337 338 count 339 - 340 first 341 - 342 last { 343 return $state($property) 344 } 345 346 messages { 347 return [mbox::getmessages $token] 348 } 349 350 default { 351 error "unknown property $property" 352 } 353 } 354} 355 356 357proc mbox::getmessages {token} { 358 variable $token 359 upvar 0 $token state 360 361 switch -- $state(value) { 362 directory { 363 array set msgs $state(dirA) 364 } 365 366 file { 367 array set msgs $state(fileA) 368 } 369 } 370 371 return [lsort -integer [array names msgs]] 372} 373 374 375proc mbox::getmsgtoken {token msgNo} { 376 variable $token 377 upvar 0 $token state 378 379 if {($msgNo < $state(first)) || ($msgNo > $state(last))} { 380 error "message number out of range: $state(first)..$state(last)" 381 } 382 383 array set msgs $state(msgs) 384 if {![catch { array set msg $msgs($msgNo) }]} { 385 return $msg(mime) 386 } 387 388 switch -- $state(value) { 389 directory { 390 set mime [mime::initialize \ 391 -file [file join $state(directory) $msgNo]] 392 } 393 394 file { 395 array set fileA $state(fileA) 396 array set msg $fileA($msgNo) 397 set mime [mime::initialize -file $state(file) -root $token \ 398 -offset $msg(offset) -count $msg(size)] 399 } 400 } 401 402 set msgs($msgNo) [list msgNo $msgNo mime $mime] 403 set state(msgs) [array get msgs] 404 405 return $mime 406} 407 408 409proc mbox::getmsgproperty {token msgNo {property ""}} { 410 variable $token 411 upvar 0 $token state 412 413 if {($msgNo < $state(first)) || ($msgNo > $state(last))} { 414 error "message number out of range: $state(first)..$state(last)" 415 } 416 417 switch -- $state(value) { 418 directory { 419 array set dirA $state(dirA) 420 if {[catch { array set msg $dirA($msgNo) }]} { 421 error "message $msgNo doesn't exist" 422 } 423 } 424 425 file { 426 array set fileA $state(fileA) 427 array set msg $fileA($msgNo) 428 } 429 } 430 431 set props [list flags size uidl] 432 433 switch -- $property { 434 "" { 435 array set properties "" 436 437 foreach prop $props { 438 if {[info exists msg($prop)]} { 439 set properties($prop) $msg($prop) 440 } 441 } 442 443 return [array get properties] 444 } 445 446 -names { 447 set names "" 448 foreach prop $props { 449 if {[info exists msg($prop)]} { 450 lappend names $prop 451 } 452 } 453 454 return $names 455 } 456 457 default { 458 if {[lsearch -exact $props $property] < 0} { 459 error "unknown property $property" 460 } 461 462 return $msg($property) 463 } 464 } 465} 466