1
# $Id: post.tcl 391 2007-01-25 03:53:59Z mikes@u.washington.edu $
2
# ========================================================================
3
# Copyright 2006 University of Washington
5
# Licensed under the Apache License, Version 2.0 (the "License");
6
# you may not use this file except in compliance with the License.
7
# You may obtain a copy of the License at
9
# http://www.apache.org/licenses/LICENSE-2.0
11
# ========================================================================
15
# Purpose: CGI script to perform message posting via compose.tcl
20
{cid "Missing Command ID"}
41
{postpost {} "main.tcl"}
55
proc fieldname {name} {
56
regsub -all -- {-} [string tolower $name] {_} fieldname
60
proc expand_address_field {field _msgdata} {
61
upvar 1 $_msgdata msgdata
63
set fn [fieldname $field]
64
for {set i 0} {$i < [llength $msgdata]} {incr i} {
65
if {[string length [lindex [lindex $msgdata $i] 1]]} {
66
set fld [lindex $msgdata $i]
67
if {[string compare [fieldname [lindex $fld 0]] $fn] == 0} {
68
if {[catch {WPCmd PEAddress expand [lindex $fld 1] fcc} expaddr]} {
69
WPCmd PEInfo statmsg "Can't expand $field: $expaddr"
71
if {[lindex $expaddr 1] != 0} {
72
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
73
# addresses and ldapaddrs should be set at this point
77
set a [lindex $expaddr 0]
78
set l [lindex $expaddr 1]
82
# else fall thru back into composer
83
WPCmd PEInfo statmsg "Compose Error: $errstr"
86
} elseif {[string compare [lindex $expaddr 0] [lindex $fld 1]]} {
87
set msgdata [lreplace $msgdata $i $i [list [lindex $fld 0] [lindex $expaddr 0]]]
90
set fccfn [lindex $expaddr 2]
91
if {[string compare to [string tolower $fn]] == 0 && [string length $fccfn]} {
92
for {set j 0} {$j < [llength $msgdata]} {incr j} {
93
if {[string compare fcc [fieldname [lindex [lindex $msgdata $j] 0]]] == 0} {
99
set savedef [WPTFSaveDefault 0]
100
set colid [lindex $savedef 0]
101
if {[info exists fcc_index]} {
102
if {[string compare $fccfn [lindex [lindex [lindex $msgdata $fcc_index] 1] 1]]} {
103
lappend msgdata [list postoption [list fcc-set-by-addrbook 1]]
106
set msgdata [lreplace $msgdata $fcc_index $fcc_index [list Fcc [list $colid $fccfn]]]
108
lappend msgdata [list Fcc [list $colid $fccfn]]
109
lappend msgdata [list postoption [list fcc-set-by-addrbook 1]]
123
proc chartest_value {entity} {
126
if {[catch {cgi_import_as ke_${entity} tc}] == 0} {
128
if {[set j [string length $tc]]} {
129
for {set i 0} {$i < $j} {incr i} {
130
binary scan [string index $tc $i] c x
131
set x [expr ($x & 0xff)]
132
lappend tcval [format {%o} $x]
138
error "Unset testchar_$entity"
143
foreach item $post_vars {
144
if {[catch {cgi_import [lindex $item 0].x}]} {
145
if {[catch {eval WPImport $item} errstr]} {
146
error [list _action "Impart Variable" $errstr]
149
set [lindex $item 0] 1
153
if {$cid != [WPCmd PEInfo key]} {
154
error [list _action Postpone "Invalid Operation ID" "Click Back button to try again."]
157
# collect message data
159
# For now the input headers have to match the postheaders
160
# list. Any outside the list are ignored (and probably should
161
# be to avoid hostile input). Note, postheaders is a
162
# super-set of composeheaders as not all headers are meant
163
# to be shown the user for composition
164
if {[catch {WPCmd PECompose userhdrs} headers]} {
165
error [list _action "User Headers" $headers "Click browser's Back button to try again."]
168
if {[catch {WPCmd PECompose syshdrs} otherhdrs]} {
169
error [list _action "System Headers" $otherhdrs "Click browser's Back button to try again."]
171
eval "lappend headers $otherhdrs"
174
foreach field $headers {
175
set hdr [string tolower [lindex $field 0]]
176
regsub -all -- {-} $hdr {_} hdr
177
WPLoadCGIVarAs $hdr val
180
# disregard: u/i convenience (attachments marshalled below)
183
if {[string length $val]} {
185
lappend msgdata [list Fcc [list $colid $val]]
190
if {[string length $val] || [lsearch -exact {subject} $hdr] >= 0} {
191
set hdrvals($hdr) $val
192
lappend msgdata [list [lindex $field 0] $val]
193
if {[lsearch -exact {to cc bcc} $hdr] >= 0} {
201
if {[info exists env(REMOTE_ADDR)]} {
202
lappend msgdata [list x-auth-received "from \[$env(REMOTE_ADDR)\] by [info hostname] via HTTP; [clock format [clock seconds] -format "%a, %d %b %Y %H:%M:%S %Z"]"]
205
if {[catch {cgi_import attachments}] == 0} {
206
foreach id [split $attachments ","] {
207
lappend msgdata [list attach $id]
212
lappend msgdata [list body [split $body "\n"]]
215
switch -exact -- $fccattach {
218
lappend msgdata [list postoption [list fcc-without-attachments [expr {!$fccattach}]]]
222
# pass on form's charset?
223
# TURNED OFF since all compose form interaction BETTER be UTF-8
224
if {0 && [string length $form_charset]} {
225
# messy charset heuristics
226
# idea is to look for planted HTML entities and see if known
227
# encoding transliterations have occured. inspired by:
228
# <http://www.cs.tut.fi/~jkorpela/chars.html#encinfo>
233
# cyrillic shcha (#1060)
234
# iso-8859-15 (Latin0): euro IS 200
235
# iso-8859-1 (Latin1): thorn IS 376 or U+C3BE BUT NOT “ þ OR þ
236
# Unicode literal full width yen: U+FFE5 IS 215F (ISO-2022-JP), A1EF (EUC-JP), or 818F (Shift-JIS) and so on
238
# remember, the first element of each group MUST appear in compose.tcl, too
241
{#8364 {{{40 254} ISO-10646} {{342 202 254} UTF-8} {244 ISO-8859-15} {325 IBM-850}} {}}
242
{#1066 {{{377} KOI8-R} {312 ISO-8859-5}} {}}
243
{thorn {{376 ISO-8859-1}} {{303 276} UTF-8} {iso-8859-1 {{46 43 70 62 62 60 73} {46 43 62 65 64 73} {46 164 150 157 162 156 73}}}}
244
{tcedil {{376 ISO-8859-2}} {{46 164 143 145 144 151 154 73}}}
245
{#65509 {{{302 245} UTF-8} {{241 315} EUC-KR} {{243 244} GB2312} {{242 104} BIG5} {{241 357} EUC-JP} {{201 217} Shift-JIS} {{33 44 102 41 157 33 50 102} ISO-2022-JP}} {}}
248
catch {unset test_charset}
249
foreach cs $cstests {
250
# asked for test entity available?
251
if {[catch {chartest_value [lindex $cs 0]} ctest] == 0} {
252
# test for positive [re]encoding assertions
253
foreach testpos [lindex $cs 1] {
254
if {[regexp "^[lindex $testpos 0]\$" $ctest]} {
255
set test_charset [lindex $testpos 1]
260
if {![info exists test_charset]} {
261
set csneg [lindex [lindex $cs 2] 0]
262
foreach testneg [lindex [lindex $cs 2] 1] {
263
if {[regexp "^$testneg\$" $ctest]} {
264
if {[info exists form_charset]
265
&& [string compare [string tolower $form_charset] $csneg] == 0} {
277
if {[info exists test_charset]} {
278
lappend msgdata [list postoption [list charset $test_charset]]
279
} elseif {[info exists form_charset]} {
280
lappend msgdata [list postoption [list charset $form_charset]]
282
lappend msgdata [list postoption [list charset "X-UNKNOWN"]]
285
lappend msgdata [list postoption [list charset "UTF-8"]]
288
# pass on text fomat=flowed?
289
if {[string length $form_flowed]} {
290
lappend msgdata [list postoption [list flowed yes]]
293
# figure out what to do with data
294
if {[string compare OK [string trim $action]] == 0 && ($send || [string compare $sendop send] == 0)} {
295
if {[info exists has_to] || [info exists has_cc] || [info exists has_bcc] || [info exists has_fcc]} {
296
# expand any nicknames
298
for {set i 0} {$i < [llength $msgdata]} {incr i} {
299
if {[string length [lindex [lindex $msgdata $i] 1]]} {
300
set fld [lindex $msgdata $i]
301
set fn [string tolower [lindex $fld 0]]
304
if {[string length [lindex [lindex $fld 1] 1]]} {
305
# setup for send confirmation
306
set colidval [lindex [lindex $fld 1] 0]
307
set fccval [lindex [lindex $fld 1] 1]
314
set expaddr [WPCmd PEAddress expand [lindex $fld 1] {}]
315
if {[string compare [lindex $expaddr 0] [lindex $fld 1]]} {
316
set msgdata [lreplace $msgdata $i $i [list [lindex $fld 0] [lindex $expaddr 0]]]
318
# if expanded, update fcc?
319
if {[string compare to $fn] == 0 && [string length $fn]} {
320
set expanded_fcc [lindex $expaddr 2]
325
if {[string length $form_flowed]} {
329
set nextline [lindex [lindex $fld 1] 0]
330
for {set j 1} {$j <= [llength [lindex $fld 1]]} {incr j} {
333
if {[regexp "^${ws}+" $line]} {
337
set nextline [lindex [lindex $fld 1] $j]
338
if {[regexp {^-- $} $line] == 0} {
339
catch {unset linetext}
340
# trim trailing WS from lines preceding those with LWS (space-stuff as needed)
341
if {[string length $nextline] == 0 || [regexp "^${ws}+(${nws}?.*)\$" $nextline dummy linetext]} {
342
set line [string trimright $line]
343
if {[info exists linetext] == 0 || [string length $linetext] == 0} {
348
# break overly long lines in a flowed way
349
if {[regexp {^[^>]} $line] && [string length $line] > 1000} {
350
while {[regexp "^(${ws}*${nws}+${ws}+)$nws" [string range $line 900 end] dummy linex]} {
351
set cliplen [expr {900 + [string length $linex]}]
352
lappend newbody [string range $line 0 [expr {$cliplen - 1}]]
353
set line [string range $line $cliplen end]
358
lappend newbody $line
361
set msgdata [lreplace $msgdata $i $i [list body $newbody]]
370
WPCmd PEInfo statmsg "Address problem: $result"
373
if {[info exists expanded_fcc]} {
374
for {set j 0} {$j < [llength $msgdata]} {incr j} {
375
if {[string compare fcc [fieldname [lindex [lindex $msgdata $j] 0]]] == 0} {
381
set savedef [WPTFSaveDefault 0]
382
set colid [lindex $savedef 0]
383
if {[info exists fcc_index]} {
384
set msgdata [lreplace $msgdata $fcc_index $fcc_index [list Fcc [list $colid $expanded_fcc]]]
386
lappend msgdata [list Fcc [list $colid $expanded_fcc]]
393
set postcmd PECompose
397
WPCmd PEInfo statmsg "Send MUST include Recipients (To, Cc, Bcc, or Fcc)"
399
} elseif {[string compare OK [string trim $action]] == 0 && ($postpone || [string compare $sendop postpone] == 0)} {
401
set verbpast Postponed
402
set postcmd PEPostpone
403
set postcmdopt append
404
} elseif {$help == 1 || [string compare "get help" [string tolower $help]] == 0} {
405
# save msgdata to servlet
406
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
407
# fake cgi input for script
408
_cgi_set_uservar oncancel "compose&restore=1"
411
# else fall thru back into composer
412
WPCmd PEInfo statmsg "Compose Error: $errstr"
414
} elseif {$check == 1 || [string compare spell [string tolower [string range $check 0 4]]] == 0} {
415
# save msgdata to servlet
416
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
419
# else fall thru back into composer
420
WPCmd PEInfo statmsg "Compose Error: $errstr"
422
} elseif {$queryattach == 1 || [string compare "add attachment" [string tolower $queryattach]] == 0 || [string compare "attach" [string tolower $queryattach]] == 0} {
423
# save msgdata to servlet
424
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
425
# fake cgi input for script
428
# else fall thru back into composer
429
WPCmd PEInfo statmsg "Compose Error: $errstr"
431
} elseif {$br_to == 1 || [string compare browse [string tolower $br_to]] == 0 || [string compare to [string tolower $br_to]] == 0} {
432
# save msgdata to servlet
433
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
434
# fake cgi input for script
436
_cgi_set_uservar op browse
437
_cgi_set_uservar field to
440
# else fall thru back into composer
441
WPCmd PEInfo statmsg "Compose Error: $errstr"
443
} elseif {$br_cc == 1 || [string compare browse [string tolower $br_cc]] == 0 || [string compare cc [string tolower $br_cc]] == 0} {
444
# save msgdata to servlet
445
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
446
# fake cgi input for script
448
_cgi_set_uservar op browse
449
_cgi_set_uservar field cc
452
# else fall thru back into composer
453
WPCmd PEInfo statmsg "Compose Error: $errstr"
455
} elseif {$br_bcc == 1 || [string compare browse [string tolower $br_bcc]] == 0 || [string compare bcc [string tolower $br_bcc]] == 0} {
456
# save msgdata to servlet
457
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
458
# fake cgi input for script
460
_cgi_set_uservar op browse
461
_cgi_set_uservar field bcc
464
# else fall thru back into composer
465
WPCmd PEInfo statmsg "Compose Error: $errstr"
467
} elseif {$br_reply_to == 1 || [string compare browse [string tolower $br_reply_to]] == 0 || [string compare "reply_to" [string tolower $br_reply_to]] == 0} {
468
# save msgdata to servlet
469
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
470
# fake cgi input for script
472
_cgi_set_uservar op browse
473
_cgi_set_uservar field reply-to
476
# else fall thru back into composer
477
WPCmd PEInfo statmsg "Compose Error: $errstr"
479
} elseif {$br_fcc == 1 || ($br_fcc > 0 && [string length $br_fcc] > 0)} {
480
# save msgdata to servlet
481
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
482
# fake cgi input for script
483
_cgi_set_uservar onselect compose
484
_cgi_set_uservar oncancel compose
487
# else fall thru back into composer
488
WPCmd PEInfo statmsg "Compose Error: $errstr"
490
} elseif {[string compare expand [string tolower $ex_to]] == 0} {
491
if {[expand_address_field To msgdata]} {
494
} elseif {[string compare expand [string tolower $ex_cc]] == 0} {
495
if {[expand_address_field Cc msgdata]} {
498
} elseif {[string compare expand [string tolower $ex_bcc]] == 0} {
499
if {[expand_address_field Bcc msgdata]} {
502
} elseif {[string compare expand [string tolower $ex_reply_to]] == 0} {
503
if {[expand_address_field Reply-To msgdata]} {
506
} elseif {[string length $extrahdrs] > 0} {
507
# save msgdata to servlet
508
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
509
if {[catch {WPCmd PEInfo set wp_extra_hdrs} extras] || $extras == 1} {
515
catch {WPCmd PEInfo set wp_extra_hdrs $toggle}
517
_cgi_set_uservar restore 1
520
# else fall thru back into composer
521
WPCmd PEInfo statmsg "Compose Error: $errstr"
523
} elseif {[string compare OK [string trim $action]] == 0 && ($cancel || [string compare $sendop cancel] == 0)} {
524
# clean up attachments
525
WPCmd PEInfo statmsg "Message cancelled"
526
catch {WPCmd PEInfo unset suspended_composition}
527
catch {WPCmd PEInfo unset wp_extra_hdrs}
530
# check for per-attachment ops
531
if {[info exists attachments]} {
532
set a [split $attachments ","]
533
for {set i 0} {$i < [llength $a]} {incr i} {
534
if {[catch {cgi_import detach_[lindex $a $i].x}] == 0} {
535
if {[catch {WPCmd PECompose unattach [lindex $a $i]} result]} {
536
WPCmd PEInfo statmsg "Unattach: $result"
538
set attachment_deleted [lindex $a $i]
540
set a [lreplace $a $i $i]
541
set attachments [join $a ","]
543
for {set i 0} {$i < [llength $msgdata]} {incr i} {
544
if {[string compare attach [lindex [lindex $msgdata $i] 0]] == 0 && [lindex [lindex $msgdata $i] 1] == $attachment_deleted} {
545
set msgdata [lreplace $msgdata $i $i]
550
WPCmd PEInfo statmsg "Attachment Removed"
558
if {![info exists attachment_deleted]} {
559
WPCmd PEInfo statmsg "Unrecognized Action"
564
if {[info exists postcmd]} {
565
if {[info exists msgdata]} {
566
if {[catch {WPCmd $postcmd $postcmdopt $msgdata} errstr]} {
567
# if auth problem, save msgdata for after we ask for credentials
568
if {([string compare $errstr NOPASSWD] == 0 || [string compare $errstr BADPASSWD] == 0)
569
&& [catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
571
if {[catch {WPCmd PEInfo authrequestor} server]} {
572
append reason "Unknown server asking for authentication. Press cancel to abort if you think this message is in error."
574
append reason "[cgi_nl]Enter Username and Password to connect to [cgi_bold $server]"
575
lappend params [list server $server]
578
if {[catch {WPCmd PESession creds 0 "{$server}"} creds] == 0 && $creds != 0} {
579
catch {WPCmd PEInfo statmsg "Invalid Username or Password"}
580
WPCmd PESession nocred 0 "{$server}"
583
WPCmd set reason "The server ($server) used to send this message requires authentication.[cgi_nl]"
585
WPCmd set cid [WPCmd PEInfo key]
587
WPCmd set authfolder "{$server}"
588
WPCmd set authpage [WPPercentQuote "[cgi_root]/$_wp(appdir)/wp.tcl?page=dosend"]
589
WPCmd set authcancel [WPPercentQuote "[cgi_root]/$_wp(appdir)/wp.tcl?page=compose&restore=1&cid=$cid"]
594
# regurgitate the compose window
596
set title "$verb Error: [cgi_font class=notice "$errstr"]"
597
if {[string length $errstr]} {
598
set notice "$verb FAILED: $errstr"
600
set notice "$verb FAILED: [WPCmd PEInfo statmsg]"
603
WPCmd PEInfo statmsg "$notice"
605
# regurgitate the compose window
606
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
607
_cgi_set_uservar restore 1
617
catch {WPCmd PEInfo unset suspended_composition}
618
WPCmd PEInfo statmsg "Message $verbpast!"
621
WPCmd PEInfo statmsg "No Message $verbpast!"
624
if {[info exists delete_me]} {
625
foreach i $delete_me {
626
catch {file delete $i}
629
} elseif {![info exists src]} {
631
set title "Compose Message"
632
catch {unset attachments}
634
# regurgitate the compose window
635
if {[catch {WPCmd PEInfo set suspended_composition $msgdata} errstr] == 0} {
636
_cgi_set_uservar restore 1
643
if {[info exists src] && [string length $src]} {
644
source [WPTFScript $src]
646
cgi_redirect "[cgi_root]/$_wp(appdir)/wp.tcl?page=$postpost"
added
removed
web/cgi/alpine/post.tcl
