2
# $Id: conf_process.tcl 391 2007-01-25 03:53:59Z mikes@u.washington.edu $
3
# ========================================================================
4
# Copyright 2006 University of Washington
6
# Licensed under the Apache License, Version 2.0 (the "License");
7
# you may not use this file except in compliance with the License.
8
# You may obtain a copy of the License at
10
# http://www.apache.org/licenses/LICENSE-2.0
12
# ========================================================================
16
# Purpose: CGI script to perform various message/mailbox
22
{cid "Missing Command ID"}
23
{oncancel "Missing oncancel"}
42
foreach item $cfs_vars {
43
if {[catch {cgi_import [lindex $item 0].x}]} {
44
if {[catch {eval WPImport $item} result]} {
45
error [list _action "Impart Variable" $result]
48
set [lindex $item 0] 1
52
proc wpGetVar {_var} {
55
if {[catch {cgi_import_as $_var var} result]} {
56
error [list _action "Import Var $_var" $result]
60
proc wpGetVarAs {_var _varas} {
63
if {[catch {cgi_import_as $_var varas} result]} {
68
if {$cid != [WPCmd PEInfo key]} {
69
catch {WPCmd PEInfo statmsg "Invalid Command ID"}
72
proc wpGetGoodVars {} {
74
global general_vars msglist_vars composer_vars folder_vars address_vars msgview_vars rule_vars
78
set goodvars $msglist_vars
81
set goodvars $msgview_vars
84
set goodvars $address_vars
87
set goodvars $composer_vars
90
set goodvars $folder_vars
93
set goodvars $rule_vars
96
set goodvars $general_vars
102
proc fieldPos {fmt field} {
103
for {set i 0} {$i < [llength $fmt]} {incr i} {
104
if {[string compare [string toupper [lindex [lindex $fmt $i] 0]] [string toupper $field]] == 0} {
113
if {[catch {WPCmd set conf_page} conftype]} {
116
if {[string length $wv]} {
120
if {$save == 1 || [string compare $save Save] == 0} {
123
} elseif {$newconf} {
127
set conftype "general"
136
set conftype "composer"
139
set conftype "address"
142
set conftype "folder"
146
} elseif {$cancel == 1 || [string compare $cancel Cancel] == 0} {
150
proc wpGetRulePattern {} {
172
foreach patfield $patfields {
173
wpGetVarAs $patfield tval
174
lappend patlist [list $patfield $tval]
181
proc wpGetRuleAction {tosave} {
185
lappend actlist [list "action" $action]
188
move {lappend actlist [list "kill" 0]}
189
delete {lappend actlist [list "kill" 1]}
192
wpGetVar actionfolder
193
lappend actlist [list "folder" $actionfolder]
194
wpGetVarAs moind moind
195
if {[string compare $moind "on"] == 0} {
196
lappend actlist [list [expr {$tosave == 1 ? "moind" : "move_only_if_not_deleted"}] "1"]
198
lappend actlist [list [expr {$tosave == 1 ? "moind" : "move_only_if_not_deleted"}] "0"]
203
# Meat and potatoes of processing goes on here.
204
# Errors are barfed up as they occur,
205
# otherwise the result is communicated below...
207
set setfeatures [WPCmd PEConfig featuresettings]
208
set script fr_tconfig.tcl
211
if {[info exists goodvars] == 0} {
212
set goodvars [wpGetGoodVars]
214
foreach goodvar $goodvars {
215
set vtypeinp [lindex $goodvar 0]
216
set varname [lindex $goodvar 1]
218
wpGetVarAs hlp.$varname.x thlp
219
if {[string length $thlp]} {
221
set helpcancelset conf_process
223
switch -- $vtypeinp {
229
set varhelpname wp-columns
232
WPCmd PEConfig columns $columns
237
set cursig [string trimright [join [WPCmd PEConfig rawsig] "\n"]]
238
set signature [string trimright $signature]
239
if {[string compare $cursig $signature]} {
240
WPCmd PEConfig rawsig [split $signature "\n"]
244
wpGetVarAs $varname-sz sz
245
wpGetVarAs vla.$varname.x fltadd
246
wpGetVarAs hlp.$varname.x do_help
247
if {[string length $do_help]} {
249
set varhelpname filtconf
250
} elseif {[string length $fltadd]} {
251
set script "fr_filtedit.tcl"
253
set filtedit_onfiltcancel conf_process
255
if {[string length $sz] == 0} {
256
error [list _action "ERROR" "No size given for filters"]
258
for {set i 0} {$i < $sz} {incr i} {
259
wpGetVarAs vle.$varname.$i.x vle
260
wpGetVarAs vld.$varname.$i.x vld
261
wpGetVarAs vlsu.$varname.$i.x vlsu
262
wpGetVarAs vlsd.$varname.$i.x vlsd
265
if {[string length $vle]} {
266
set script "fr_filtedit.tcl"
268
set filtedit_onfiltcancel conf_process
269
} elseif {[string length $vld]} {
270
set flt_ret [catch {WPCmd PEConfig ruleset filter delete $i} flt_res]
271
} elseif {[string length $vlsu]} {
272
set flt_ret [catch {WPCmd PEConfig ruleset filter shuffup $i} flt_res]
273
} elseif {[string length $vlsd]} {
274
set flt_ret [catch {WPCmd PEConfig ruleset filter shuffdown $i} flt_res]
278
} elseif {[string length $flt_res]} {
279
# something wrong here
285
wpGetVarAs $varname-sz sz
286
wpGetVarAs vla.$varname.x cladd
287
if {[string length $cladd]} {
288
set script "fr_cledit.tcl"
290
set cledit_onclecancel conf_process
292
if {[string length $sz] == 0} {
293
error [list _action "ERROR" "No size given for collections"]
295
for {set i 0} {$i < $sz} {incr i} {
296
wpGetVarAs vle.$varname.$i.x vle
297
wpGetVarAs vld.$varname.$i.x vld
298
wpGetVarAs vlsu.$varname.$i.x vlsu
299
wpGetVarAs vlsd.$varname.$i.x vlsd
302
if {[string length $vle]} {
303
set script "fr_cledit.tcl"
305
set cledit_onclecancel conf_process
306
} elseif {[string length $vld]} {
307
set cle_ret [catch {WPCmd PEConfig cldel $i} cle_res]
308
} elseif {[string length $vlsu]} {
309
set cle_ret [catch {WPCmd PEConfig clshuff up $i} cle_res]
310
} elseif {[string length $vlsd]} {
311
set cle_ret [catch {WPCmd PEConfig clshuff down $i} cle_res]
315
} elseif {[string length $cle_res]} {
316
WPCmd PEInfo statmsg $cle_res
317
# something wrong here
323
wpGetVarAs index-format iformat
329
set varhelpname index-format
330
} elseif {[catch {cgi_import hlp.index_tokens.x} result] == 0} {
333
set feathelpname h_index_tokens
334
set varhelpname h_index_tokens
337
if {[catch {cgi_import indexadd}] == 0
338
&& [string compare "Add Field" $indexadd] == 0
339
&& [catch {cgi_import indexaddfield}] == 0} {
340
if {[lsearch $iformat $indexaddfield] < 0} {
341
set iformat [linsert $iformat 0 $indexaddfield]
344
} elseif {[catch {cgi_import adjust}] == 0
345
&& [string compare Change $adjust] == 0
346
&& [catch {cgi_import iop}] == 0
347
&& [catch {cgi_import ifield}] == 0
348
&& [set pos [fieldPos $iformat $ifield]] >= 0} {
351
set iformat [lreplace $iformat $pos $pos]
352
set iformat [linsert $iformat [incr pos -1] $ifield]
356
set iformat [lreplace $iformat $pos $pos]
357
set iformat [linsert $iformat [incr pos] $ifield]
361
set f [lindex [lindex $iformat $pos] 0]
362
set w [lindex [lindex $iformat $pos] 1]
363
set dw [expr {round((100/[llength $iformat]) * [WPTFIndexWidthRatio $iformat $f])}]
365
if {[regexp {([0123456789]+)[%]} $w dummy w] == 0} {
381
set iformat [lreplace $iformat $pos $pos [list $f $ws]]
385
set f [lindex [lindex $iformat $pos] 0]
386
set w [lindex [lindex $iformat $pos] 1]
387
set dw [expr {round((100/[llength $iformat]) * [WPTFIndexWidthRatio $iformat $f])}]
389
if {[regexp {([0123456789]+)[%]} $w dummy w] == 0} {
405
set iformat [lreplace $iformat $pos $pos [list $f $ws]]
409
set iformat [lreplace $iformat $pos $pos]
415
if {[catch {cgi_import_as shrm.${f}.x shift} result] == 0} {
416
if {[set pos [fieldPos $iformat $f]] >= 0} {
417
set iformat [lreplace $iformat $pos $pos]
420
} elseif {[catch {cgi_import_as shlf.${f}.x shift} result] == 0} {
421
if {[set pos [fieldPos $iformat $f]] > 0} {
422
set iformat [lreplace $iformat $pos $pos]
423
set iformat [linsert $iformat [incr pos -1] $f]
426
} elseif {[catch {cgi_import_as shrt.${f}.x shift} result] == 0} {
427
if {[set pos [fieldPos $iformat $f]] >= 0} {
428
set iformat [lreplace $iformat $pos $pos]
429
set iformat [linsert $iformat [incr pos] $f]
438
if {[string length [lindex $f 1]]} {
439
lappend ifv "[lindex $f 0]([lindex $f 1])"
441
lappend ifv [lindex $f 0]
445
WPCmd PEConfig varset index-format [list $ifv]
451
set varhelpname index-format
452
} elseif {[catch {cgi_import_as colormap.x colx}] == 0
453
&& [catch {cgi_import_as colormap.y coly}] == 0} {
454
set rgbs {"000" "051" "102" "153" "204" "255"}
455
set xrgbs {"00" "33" "66" "99" "CC" "FF"}
456
set rgblen [llength $rgbs]
459
set colx [expr {${colx} / $imappixwidth}]
460
set coly [expr {${coly} / $imappixwidth}]
461
if {($coly >= 0 && $coly < $rgblen)
462
&& ($colx >= 0 && $colx < [expr {$rgblen * $rgblen}])} {
464
set igreen [expr {($colx / $rgblen) % $rgblen}]
465
set iblue [expr {$colx % $rgblen}]
466
set rgb "[lindex $rgbs $ired],[lindex $rgbs ${igreen}],[lindex $rgbs ${iblue}]"
467
set xrgb "[lindex $xrgbs $ired][lindex $xrgbs ${igreen}][lindex $xrgbs ${iblue}]"
469
if {[catch {cgi_import_as text tt}] == 0} {
470
set type [split $tt .]
471
catch {WPCmd set config_deftext [lindex $type end]}
473
if {[catch {cgi_import_as ground ground}] == 0} {
476
catch {WPCmd set config_defground f}
480
catch {WPCmd set config_defground b}
485
if {[info exists fg] || [info exists bg]} {
486
switch [lindex $type 0] {
488
set type [lindex $type 1]
489
if {[catch {cgi_import_as add.${type} foo}] == 0} {
491
} elseif {[catch {cgi_import_as hi.${type} hindex}] == 0} {
495
if {[info exists colop]} {
496
if {![info exists bg] && [catch {cgi_import_as dbg.$type bg} result]} {
497
WPCmd PEInfo statmsg "Can't import default background: $result"
498
} elseif {![info exists fg] && [catch {cgi_import_as dfg.$type fg} result]} {
499
WPCmd PEInfo statmsg "Can't import default foreground: $result"
504
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors update [list $hindex $type ""] [list $fg $bg]} result]} {
505
WPCmd PEInfo statmsg "Problem changing $type color: $result"
509
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors add [list $type ""] [list $fg $bg]} result]} {
510
WPCmd PEInfo statmsg "Problem adding $type color: $result"
518
if {![info exists bg] && [catch {cgi_import_as dbg.$type bg} result]} {
519
WPCmd PEInfo statmsg "Can't import default background: $result"
520
} elseif {![info exists fg] && [catch {cgi_import_as dfg.$type fg} result]} {
521
WPCmd PEInfo statmsg "Can't import default foreground: $result"
522
} elseif {[catch {WPCmd PEConfig colorset $type [list $fg $bg]} result]} {
523
WPCmd PEInfo statmsg "Can't set $type color: $result"
528
WPCmd PEInfo statmsg "Invalid fore/back ground input!"
531
WPCmd PEInfo statmsg "Choose foreground or background!"
534
WPCmd PEInfo statmsg "Choose the type of text to color!"
537
WPCmd PEInfo statmsg "Invalid RGB Input!"
539
} elseif {[catch {cgi_import addfield}] == 0
540
&& [string compare "add " [string tolower [string range $addfield 0 3]]] == 0
541
&& [catch {cgi_import newfield}] == 0
542
&& [string length [set newfield [string trim $newfield]]]
543
&& [catch {cgi_import_as dfg.normal dfg}] == 0
544
&& [catch {cgi_import_as dbg.normal dbg}] == 0} {
545
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors add [list $newfield ""] [list $dfg $dbg]} result]} {
546
WPCmd PEInfo statmsg "Problem adding $type color: $result"
548
} elseif {[catch {cgi_import reset}] == 0
549
&& [string compare "restore " [string tolower [string range $reset 0 7]]] == 0} {
550
if {[catch {cgi_import_as text tt}] == 0} {
551
if {[llength [set type [split $tt .]]] == 2 && [string compare [lindex $type 0] hdr] == 0} {
552
set hdr [lindex $type end]
553
if {[catch {cgi_import_as hi.$hdr hindex}] == 0} {
554
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors delete $hindex} result]} {
555
# bug: reloads cause this error - need better way to report it
556
#WPCmd PEInfo statmsg "Can't reset $hdr ($hindex) text: $result!"
558
catch {WPCmd PEInfo unset config_deftext}
561
} elseif {[string compare normal $tt] == 0} {
562
if {[catch {WPCmd PEConfig varset normal-foreground-color ""} result]
563
|| [catch {WPCmd PEConfig varset normal-background-color ""} result]} {
564
WPCmd PEInfo statmsg "Can't reset normal text: $result!"
566
} elseif {[catch {cgi_import_as dfg.normal dfg}] == 0
567
&& [catch {cgi_import_as dbg.normal dbg}] == 0} {
568
catch {WPCmd set config_deftext $tt}
569
if {[catch {WPCmd PEConfig colorset $tt [list $dfg $dbg]} result]} {
570
WPCmd PEInfo statmsg "Can't reset $tt text: $result!"
574
WPCmd PEInfo statmsg "Choose the type of text to color!"
581
wpGetVarAs $varname formval
582
set varvals [WPCmd PEConfig varget $varname]
583
set vals [lindex $varvals 0]
584
set vartype [lindex $varvals 1]
585
set formvals [split $formval "\n"]
590
set varhelpname $varname
593
if {[string compare $vartype textarea] == 0} {
594
wpGetVarAs vla.$varname.x vlavar
595
wpGetVarAs $varname-sz sz
596
wpGetVarAs $varname-add valadd
597
if {[string length $vlavar]} {
598
set fr_tconfig_vlavar $varname
601
if {[string length $valadd]} {
602
lappend formvals $valadd
604
if {[string length $sz]} {
606
for {set i 0} {$i < $sz} {incr i} {
607
wpGetVarAs vle.$varname.$i fval
608
wpGetVarAs vld.$varname.$i.x fvaldel
609
wpGetVarAs vlsu.$varname.$i.x fvalsu
610
wpGetVarAs vlsd.$varname.$i.x fvalsd
615
if {[string length $fval]} {
618
if {[string length $fvaldel]} {
620
} elseif {[string length $fvalsu]} {
622
} elseif {[string length $fvalsd]} {
625
if {$fed && $fdel == 0 && $prevwassd} {
627
set formvals [linsert $formvals [expr {[llength $formvals] - 1}] $fval]
628
} elseif {$fed && $fdel == 0 && $fsu == 0} {
629
lappend formvals $fval
633
} elseif {$fed && $fdel == 0 && $fsu} {
634
set fvallen [llength $formvals]
636
set formvals [linsert $formvals [expr {$fvallen - 2}] $fval]
638
lappend formvals $fval
643
set len [llength $formvals]
644
if {$len != [llength $vals]} {
647
for {set i 0} {$i < $len} {incr i} {
648
if {[string compare [lindex $formvals $i] [lindex $vals $i]]} {
654
} elseif {[llength $formvals] != [llength $vals]} {
657
set valslength [llength $vals]
658
for {set i 0} {$i < $valslength} {incr i} {
659
if {[string compare [lindex $vals $i] [lindex $formvals $i]]} {
666
WPCmd PEConfig varset $varname $formvals
668
# what about wp-indexheight?
671
wpGetVarAs $varname tval
674
set feathelpname $varname
676
set featset [expr {[lsearch $setfeatures $varname] >= 0}]
677
set formfeatset [expr {[string compare $tval on] == 0}]
678
if {$formfeatset != $featset} {
679
WPCmd PEConfig feature $varname $formfeatset
684
if {[info exists subop]} {
687
catch {WPCmd PEInfo unset help_context}
688
catch {WPCmd set oncancel $oncancel}
689
set help_vars [list topic topicclass]
690
set topic $varhelpname
691
set _cgi_uservar(topic) $varhelpname
692
set topicclass variable
693
set _cgi_uservar(topicclass) variable
694
set _cgi_uservar(oncancel) conf_process
698
catch {WPCmd PEInfo unset help_context}
699
catch {WPCmd set oncancel $oncancel}
700
set help_vars [list topic topicclass oncancel]
701
set topic $feathelpname
702
set _cgi_uservar(topic) $feathelpname
703
set topicclass feature
704
set _cgi_uservar(topicclass) feature
705
set _cgi_uservar(oncancel) conf_process
709
catch {WPCmd PEInfo unset help_context}
710
catch {WPCmd set oncancel $oncancel}
711
set help_vars [list topic topicclass oncancel]
712
set topic $feathelpname
713
set _cgi_uservar(topic) $feathelpname
714
set topicclass $topicclass
715
set _cgi_uservar(topicclass) $topicclass
716
set _cgi_uservar(oncancel) conf_process
720
if {$cid != [WPCmd PEInfo key]} {
721
error [list _close "Invalid Operation ID"]
723
WPCmd PEConfig saveconf
725
catch {WPCmd PEInfo unset config_deftext}
734
if {[catch {wpGetVar filtcancel}]} {
735
if {[catch {wpGetVar filthelp}] == 0} {
736
catch {WPCmd PEInfo unset help_context}
737
catch {WPCmd set oncancel $oncancel}
738
if {[string compare $subop "edit"] == 0 || [string compare $subop "add"] == 0} {
739
set patlist [wpGetRulePattern]
740
set actlist [wpGetRuleAction 0]
741
# we have to save this exactly as it would look when getting it from alpined
742
set ftsadd [expr {[string compare $subop "add"] == 0 ? 1 : 0}]
743
set ftsform [list [list "pattern" $patlist] [list "filtaction" $actlist]]
744
catch {WPCmd set filttmpstate [list $ftsadd $fno $ftsform]}
746
set help_vars [list topic]
748
set _cgi_uservar(topic) filtedit
751
set fakeimg "vle.filters.$fno"
752
set fakesz [expr {$fno + 1}]
755
set fakeimg "vla.filters"
760
set _cgi_uservar(oncancel) [WPPercentQuote "conf_process&wv=rule&filters-sz=${fakesz}&${fakeimg}.x=1&${fakeimg}.y=1&oncancel=main.tcl"]
762
} elseif {[catch {wpGetVar headers}] == 0} {
763
WPCmd PEInfo statmsg "Should CREATE HEADER"
768
set patlist [wpGetRulePattern]
769
set actlist [wpGetRuleAction 1]
770
set ret [catch {WPCmd PEConfig ruleset filter $subop $fno $patlist $actlist} res]
772
error [list _action "Filter Set" $res]
773
} elseif {[string length $res]} {
774
WPCmd PEInfo statmsg "Filter setting failed: $res"
776
set filtedit_fno $fno
777
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
778
set filtedit_onfiltcancel conf_process
779
set script "fr_filtedit.tcl"
795
wpGetVarAs cle_cancel.x cle_cancel
796
wpGetVarAs cle_save.x cle_save
800
set cledit_onclecancel conf_process
801
if {[string length $cle_save]} {
802
if {[catch {cgi_import_as "ssl" sslval}]} {
805
if {[string compare $sslval on] == 0} {
811
regexp "\{?(\[^\}\]*)\}?(.*)" $server match serverb serverrem
812
if {[string length $serverb]} {
814
set serverb "$serverb/ssl"
816
if {[string compare "" "$user"]} {
817
set serverb "$serverb/user=$user"
819
if {[string compare "imap" [string tolower $stype]]} {
820
set serverb "$serverb/[string tolower $stype]"
822
if {[string compare "nntp" [string tolower $stype]] == 0} {
823
regsub -nocase {^(#news\.)?(.*)$} "$path" "#news.\\2" path
824
if {[string compare "" $path] == 0} {
830
set servera "\{$serverb\}$serverrem"
832
set ret [catch {WPCmd PEConfig cladd $cl $nick $servera $path $view} result]
834
set ret [catch {WPCmd PEConfig cledit $cl $nick $servera $path $view} result]
837
error [list _action "Collection List Set" $result]
838
} elseif {[string compare "" $result]} {
840
set clerrtext "Add failed: $result"
842
set clerrtext "Edit failed: $result"
844
WPCmd PEInfo statmsg $clerrtext
845
set script "fr_cledit.tcl"
848
set clerrtext "Bad data: Nothing defined for Server"
849
WPCmd PEInfo statmsg $clerrtext
850
set script "fr_cledit.tcl"
855
catch {WPCmd PEInfo noop}
859
catch {WPCmd PEInfo unset conf_page} res
862
error [list _close "Unknown process operation: $op"]
867
source [WPTFScript $script]
added
removed
web/cgi/alpine/conf_process.tcl
