2
# $Id: conf_process.tcl 1204 2009-02-02 19:54:23Z hubert@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
23
{cid "Missing Command ID"}
24
{oncancel "Missing oncancel"}
43
foreach item $cfs_vars {
44
if {[catch {cgi_import [lindex $item 0].x}]} {
45
if {[catch {eval WPImport $item} result]} {
46
error [list _action "Import Variable" $result]
49
set [lindex $item 0] 1
53
proc wpGetVar {_var {valid ""}} {
56
if {[catch {cgi_import_as $_var var} result]} {
57
error [list _action "Import Var $_var" $result]
60
if {[string length $valid]} {
61
switch -exact -- $valid {
63
if {[string is integer -strict $var] != 1} {
64
error [list _action "Invalid Input" "Non-Numeric Value for $_var"]
68
if {[lsearch -exact $valid $var] < 0} {
69
error [list _action "Invalid Input" "Unrecognized Value $var for $_var"]
76
proc wpGetVarAs {_var _varas} {
79
if {[catch {cgi_import_as $_var varas} result]} {
84
if {$cid != [WPCmd PEInfo key]} {
85
catch {WPCmd PEInfo statmsg "Invalid Command ID"}
88
proc wpGetGoodVars {} {
90
global general_vars msglist_vars composer_vars folder_vars address_vars msgview_vars rule_vars
94
set goodvars $msglist_vars
97
set goodvars $msgview_vars
100
set goodvars $address_vars
103
set goodvars $composer_vars
106
set goodvars $folder_vars
109
set goodvars $rule_vars
112
set goodvars $general_vars
118
proc fieldPos {fmt field} {
119
for {set i 0} {$i < [llength $fmt]} {incr i} {
120
if {[string compare [string toupper [lindex [lindex $fmt $i] 0]] [string toupper $field]] == 0} {
128
proc numberedVar {nvbase nvtotal} {
129
if {[catch {wpGetVarAs $nvtotal nvtot}] == 0} {
130
for {set i 0} {$i < $nvtot} {incr i} {
131
if {[catch {wpGetVar ${nvbase}${i}} nvval] == 0} {
141
if {[catch {WPCmd set conf_page} conftype]} {
144
if {[string length $wv]} {
148
if {$save == 1 || [string compare $save Save] == 0} {
151
} elseif {$newconf} {
155
set conftype "general"
164
set conftype "composer"
167
set conftype "address"
170
set conftype "folder"
174
} elseif {$cancel == 1 || [string compare $cancel Cancel] == 0} {
178
proc wpGetRulePattern {} {
179
global pattern_fields
183
foreach {patvar patfield} $pattern_fields {
184
wpGetVarAs $patvar tval
188
# collect header fields/values into "headers"
190
if {[catch {wpGetVarAs header_total hcnt} res] == 0} {
191
for {set i 0} {$i < $hcnt} {incr i} {
192
if {[catch {wpGetVarAs hdrfld${i} fld}] == 0
193
&& [catch {wpGetVarAs hdrval${i} val}] == 0} {
194
lappend headers [list $fld $val]
199
lappend patlist [list headers $headers]
202
lappend patlist [list $patvar $tval]
212
proc wpGetRuleAction {tosave} {
216
lappend actlist [list "action" $action]
219
move {lappend actlist [list "kill" 0]}
220
delete {lappend actlist [list "kill" 1]}
223
wpGetVar actionfolder
224
lappend actlist [list "folder" $actionfolder]
225
wpGetVarAs moind moind
226
if {[string compare $moind "on"] == 0} {
227
lappend actlist [list [expr {$tosave == 1 ? "moind" : "move_only_if_not_deleted"}] "1"]
229
lappend actlist [list [expr {$tosave == 1 ? "moind" : "move_only_if_not_deleted"}] "0"]
234
# Meat and potatoes of processing goes on here.
235
# Errors are barfed up as they occur,
236
# otherwise the result is communicated below...
238
set setfeatures [WPCmd PEConfig featuresettings]
239
set script fr_tconfig.tcl
242
if {[info exists goodvars] == 0} {
243
set goodvars [wpGetGoodVars]
245
foreach goodvar $goodvars {
246
set vtypeinp [lindex $goodvar 0]
247
set varname [lindex $goodvar 1]
249
wpGetVarAs hlp.$varname.x thlp
250
if {[string length $thlp]} {
252
set helpcancelset conf_process
254
switch -- $vtypeinp {
260
set varhelpname wp-columns
263
WPCmd PEConfig columns $columns
266
left-column-folders {
267
if {0 == [catch {wpGetVar fcachel}]} {
268
if {$fcachel <= $_wp(fldr_cache_max)} {
269
catch {WPSessionState left_column_folders $fcachel}
275
set cursig [string trimright [join [WPCmd PEConfig rawsig] "\n"]]
276
set signature [string trimright $signature]
277
if {[string compare $cursig $signature]} {
278
WPCmd PEConfig rawsig [split $signature "\n"]
282
wpGetVarAs $varname-sz sz
283
wpGetVarAs vla.$varname.x fltadd
284
wpGetVarAs hlp.$varname.x do_help
285
if {[string length $do_help]} {
287
set varhelpname filtconf
288
} elseif {[string length $fltadd]} {
289
set script "fr_filtedit.tcl"
291
set filtedit_onfiltcancel conf_process
293
if {[string length $sz] == 0} {
294
error [list _action "ERROR" "No size given for filters"]
296
for {set i 0} {$i < $sz} {incr i} {
297
wpGetVarAs vle.$varname.$i.x vle
298
wpGetVarAs vld.$varname.$i.x vld
299
wpGetVarAs vlsu.$varname.$i.x vlsu
300
wpGetVarAs vlsd.$varname.$i.x vlsd
303
if {[string length $vle]} {
304
set script "fr_filtedit.tcl"
306
set filtedit_onfiltcancel conf_process
307
} elseif {[string length $vld]} {
308
set flt_ret [catch {WPCmd PEConfig ruleset filter delete $i} flt_res]
309
} elseif {[string length $vlsu]} {
310
set flt_ret [catch {WPCmd PEConfig ruleset filter shuffup $i} flt_res]
311
} elseif {[string length $vlsd]} {
312
set flt_ret [catch {WPCmd PEConfig ruleset filter shuffdown $i} flt_res]
316
} elseif {[string length $flt_res]} {
317
# something wrong here
323
wpGetVarAs $varname-sz sz
324
wpGetVarAs vla.$varname.x fltadd
325
wpGetVarAs hlp.$varname.x do_help
326
if {[string length $do_help]} {
328
set varhelpname filtconf
329
} elseif {[string length $fltadd]} {
330
set script "fr_filtedit.tcl"
333
set filtedit_onfiltcancel conf_process
335
if {[string length $sz] == 0} {
336
error [list _action "ERROR" "No size given for scores"]
338
for {set i 0} {$i < $sz} {incr i} {
339
wpGetVarAs vle.$varname.$i.x vle
340
wpGetVarAs vld.$varname.$i.x vld
341
wpGetVarAs vlsu.$varname.$i.x vlsu
342
wpGetVarAs vlsd.$varname.$i.x vlsd
345
if {[string length $vle]} {
346
set script "fr_filtedit.tcl"
349
set filtedit_onfiltcancel conf_process
350
} elseif {[string length $vld]} {
351
set flt_ret [catch {WPCmd PEConfig ruleset score delete $i} flt_res]
352
} elseif {[string length $vlsu]} {
353
set flt_ret [catch {WPCmd PEConfig ruleset score shuffup $i} flt_res]
354
} elseif {[string length $vlsd]} {
355
set flt_ret [catch {WPCmd PEConfig ruleset score shuffdown $i} flt_res]
359
} elseif {[string length $flt_res]} {
360
# something wrong here
366
wpGetVarAs $varname-sz sz
367
wpGetVarAs vla.$varname.x fltadd
368
wpGetVarAs hlp.$varname.x do_help
369
if {[string length $do_help]} {
371
set varhelpname filtconf
372
} elseif {[string length $fltadd]} {
373
set script "fr_filtedit.tcl"
375
set filtedit_indexcolor 1
376
set filtedit_onfiltcancel conf_process
378
if {[string length $sz] == 0} {
379
error [list _action "ERROR" "No size given for index colors"]
381
for {set i 0} {$i < $sz} {incr i} {
382
wpGetVarAs vle.$varname.$i.x vle
383
wpGetVarAs vld.$varname.$i.x vld
384
wpGetVarAs vlsu.$varname.$i.x vlsu
385
wpGetVarAs vlsd.$varname.$i.x vlsd
388
if {[string length $vle]} {
389
set script "fr_filtedit.tcl"
390
set filtedit_indexcolor 1
392
set filtedit_onfiltcancel conf_process
393
} elseif {[string length $vld]} {
394
set flt_ret [catch {WPCmd PEConfig ruleset indexcolor delete $i} flt_res]
395
} elseif {[string length $vlsu]} {
396
set flt_ret [catch {WPCmd PEConfig ruleset indexcolor shuffup $i} flt_res]
397
} elseif {[string length $vlsd]} {
398
set flt_ret [catch {WPCmd PEConfig ruleset indexcolor shuffdown $i} flt_res]
402
} elseif {[string length $flt_res]} {
403
# something wrong here
409
wpGetVarAs $varname-sz sz
410
wpGetVarAs vla.$varname.x cladd
411
if {[string length $cladd]} {
412
set script "fr_cledit.tcl"
414
set cledit_onclecancel conf_process
416
if {[string length $sz] == 0} {
417
error [list _action "ERROR" "No size given for collections"]
419
for {set i 0} {$i < $sz} {incr i} {
420
wpGetVarAs vle.$varname.$i.x vle
421
wpGetVarAs vld.$varname.$i.x vld
422
wpGetVarAs vlsu.$varname.$i.x vlsu
423
wpGetVarAs vlsd.$varname.$i.x vlsd
426
if {[string length $vle]} {
427
set script "fr_cledit.tcl"
429
set cledit_onclecancel conf_process
430
} elseif {[string length $vld]} {
431
set cle_ret [catch {WPCmd PEConfig cldel $i} cle_res]
432
} elseif {[string length $vlsu]} {
433
set cle_ret [catch {WPCmd PEConfig clshuff up $i} cle_res]
434
} elseif {[string length $vlsd]} {
435
set cle_ret [catch {WPCmd PEConfig clshuff down $i} cle_res]
439
} elseif {[string length $cle_res]} {
440
WPCmd PEInfo statmsg $cle_res
441
# something wrong here
447
wpGetVarAs index-format iformat
453
set varhelpname index-format
454
} elseif {[catch {cgi_import hlp.index_tokens.x} result] == 0} {
457
set feathelpname h_index_tokens
458
set varhelpname h_index_tokens
461
if {[catch {cgi_import indexadd}] == 0
462
&& [string compare "Add Field" $indexadd] == 0
463
&& [catch {cgi_import indexaddfield}] == 0} {
464
if {[lsearch $iformat $indexaddfield] < 0} {
465
set iformat [linsert $iformat 0 $indexaddfield]
468
} elseif {[catch {cgi_import adjust}] == 0
469
&& [string compare Change $adjust] == 0
470
&& [catch {cgi_import iop}] == 0
471
&& [catch {cgi_import ifield}] == 0
472
&& [set pos [fieldPos $iformat $ifield]] >= 0} {
475
set iformat [lreplace $iformat $pos $pos]
476
set iformat [linsert $iformat [incr pos -1] $ifield]
480
set iformat [lreplace $iformat $pos $pos]
481
set iformat [linsert $iformat [incr pos] $ifield]
485
set f [lindex [lindex $iformat $pos] 0]
486
set w [lindex [lindex $iformat $pos] 1]
487
set dw [expr {round((100/[llength $iformat]) * [WPTFIndexWidthRatio $iformat $f])}]
489
if {[regexp {([0123456789]+)[%]} $w dummy w] == 0} {
505
set iformat [lreplace $iformat $pos $pos [list $f $ws]]
509
set f [lindex [lindex $iformat $pos] 0]
510
set w [lindex [lindex $iformat $pos] 1]
511
set dw [expr {round((100/[llength $iformat]) * [WPTFIndexWidthRatio $iformat $f])}]
513
if {[regexp {([0123456789]+)[%]} $w dummy w] == 0} {
529
set iformat [lreplace $iformat $pos $pos [list $f $ws]]
533
set iformat [lreplace $iformat $pos $pos]
539
if {[catch {cgi_import_as shrm.${f}.x shift} result] == 0} {
540
if {[set pos [fieldPos $iformat $f]] >= 0} {
541
set iformat [lreplace $iformat $pos $pos]
544
} elseif {[catch {cgi_import_as shlf.${f}.x shift} result] == 0} {
545
if {[set pos [fieldPos $iformat $f]] > 0} {
546
set iformat [lreplace $iformat $pos $pos]
547
set iformat [linsert $iformat [incr pos -1] $f]
550
} elseif {[catch {cgi_import_as shrt.${f}.x shift} result] == 0} {
551
if {[set pos [fieldPos $iformat $f]] >= 0} {
552
set iformat [lreplace $iformat $pos $pos]
553
set iformat [linsert $iformat [incr pos] $f]
562
if {[string length [lindex $f 1]]} {
563
lappend ifv "[lindex $f 0]([lindex $f 1])"
565
lappend ifv [lindex $f 0]
569
WPCmd PEConfig varset index-format [list $ifv]
575
set varhelpname index-format
576
} elseif {[catch {cgi_import_as colormap.x colx}] == 0
577
&& [catch {cgi_import_as colormap.y coly}] == 0} {
578
set rgbs {"000" "051" "102" "153" "204" "255"}
579
set xrgbs {"00" "33" "66" "99" "CC" "FF"}
580
set rgblen [llength $rgbs]
583
set colx [expr {${colx} / $imappixwidth}]
584
set coly [expr {${coly} / $imappixwidth}]
585
if {($coly >= 0 && $coly < $rgblen)
586
&& ($colx >= 0 && $colx < [expr {$rgblen * $rgblen}])} {
588
set igreen [expr {($colx / $rgblen) % $rgblen}]
589
set iblue [expr {$colx % $rgblen}]
590
set rgb "[lindex $rgbs $ired],[lindex $rgbs ${igreen}],[lindex $rgbs ${iblue}]"
591
set xrgb "[lindex $xrgbs $ired][lindex $xrgbs ${igreen}][lindex $xrgbs ${iblue}]"
593
if {[catch {cgi_import_as text tt}] == 0} {
594
set type [split $tt .]
595
catch {WPCmd set config_deftext [lindex $type end]}
597
if {[catch {cgi_import_as ground ground}] == 0} {
600
catch {WPCmd set config_defground f}
604
catch {WPCmd set config_defground b}
609
if {[info exists fg] || [info exists bg]} {
610
switch [lindex $type 0] {
612
set type [lindex $type 1]
613
if {[catch {cgi_import_as add.${type} foo}] == 0} {
615
} elseif {[catch {cgi_import_as hi.${type} hindex}] == 0} {
619
if {[info exists colop]} {
620
if {![info exists bg] && [catch {cgi_import_as dbg.$type bg} result]} {
621
WPCmd PEInfo statmsg "Can't import default background: $result"
622
} elseif {![info exists fg] && [catch {cgi_import_as dfg.$type fg} result]} {
623
WPCmd PEInfo statmsg "Can't import default foreground: $result"
628
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors update [list $hindex $type ""] [list $fg $bg]} result]} {
629
WPCmd PEInfo statmsg "Problem changing $type color: $result"
633
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors add [list $type ""] [list $fg $bg]} result]} {
634
WPCmd PEInfo statmsg "Problem adding $type color: $result"
642
if {![info exists bg] && [catch {cgi_import_as dbg.$type bg} result]} {
643
WPCmd PEInfo statmsg "Can't import default background: $result"
644
} elseif {![info exists fg] && [catch {cgi_import_as dfg.$type fg} result]} {
645
WPCmd PEInfo statmsg "Can't import default foreground: $result"
646
} elseif {[catch {WPCmd PEConfig colorset $type [list $fg $bg]} result]} {
647
WPCmd PEInfo statmsg "Can't set $type color: $result"
652
WPCmd PEInfo statmsg "Invalid fore/back ground input!"
655
WPCmd PEInfo statmsg "Choose foreground or background!"
658
WPCmd PEInfo statmsg "Choose the type of text to color!"
661
WPCmd PEInfo statmsg "Invalid RGB Input!"
663
} elseif {[catch {cgi_import addfield}] == 0
664
&& [string compare "add " [string tolower [string range $addfield 0 3]]] == 0
665
&& [catch {cgi_import newfield}] == 0
666
&& [string length [set newfield [string trim $newfield]]]
667
&& [catch {cgi_import_as dfg.normal dfg}] == 0
668
&& [catch {cgi_import_as dbg.normal dbg}] == 0} {
669
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors add [list $newfield ""] [list $dfg $dbg]} result]} {
670
WPCmd PEInfo statmsg "Problem adding $type color: $result"
672
} elseif {[catch {cgi_import reset}] == 0
673
&& [string compare "restore " [string tolower [string range $reset 0 7]]] == 0} {
674
if {[catch {cgi_import_as text tt}] == 0} {
675
if {[llength [set type [split $tt .]]] == 2 && [string compare [lindex $type 0] hdr] == 0} {
676
set hdr [lindex $type end]
677
if {[catch {cgi_import_as hi.$hdr hindex}] == 0} {
678
if {[catch {WPCmd PEConfig colorset viewer-hdr-colors delete $hindex} result]} {
679
# bug: reloads cause this error - need better way to report it
680
#WPCmd PEInfo statmsg "Can't reset $hdr ($hindex) text: $result!"
682
catch {WPCmd PEInfo unset config_deftext}
685
} elseif {[string compare normal $tt] == 0} {
686
if {[catch {WPCmd PEConfig varset normal-foreground-color ""} result]
687
|| [catch {WPCmd PEConfig varset normal-background-color ""} result]} {
688
WPCmd PEInfo statmsg "Can't reset normal text: $result!"
690
} elseif {[catch {cgi_import_as dfg.normal dfg}] == 0
691
&& [catch {cgi_import_as dbg.normal dbg}] == 0} {
692
catch {WPCmd set config_deftext $tt}
693
if {[catch {WPCmd PEConfig colorset $tt [list $dfg $dbg]} result]} {
694
WPCmd PEInfo statmsg "Can't reset $tt text: $result!"
698
WPCmd PEInfo statmsg "Choose the type of text to color!"
705
wpGetVarAs $varname formval
706
set varvals [WPCmd PEConfig varget $varname]
707
set vals [lindex $varvals 0]
708
set vartype [lindex $varvals 1]
709
set formvals [split $formval "\n"]
714
set varhelpname $varname
717
if {[string compare $vartype textarea] == 0} {
718
wpGetVarAs vla.$varname.x vlavar
719
wpGetVarAs $varname-sz sz
720
wpGetVarAs $varname-add valadd
721
if {[string length $vlavar]} {
722
set fr_tconfig_vlavar $varname
725
if {[string length $valadd]} {
726
lappend formvals $valadd
728
if {[string length $sz]} {
730
for {set i 0} {$i < $sz} {incr i} {
731
wpGetVarAs vle.$varname.$i fval
732
wpGetVarAs vld.$varname.$i.x fvaldel
733
wpGetVarAs vlsu.$varname.$i.x fvalsu
734
wpGetVarAs vlsd.$varname.$i.x fvalsd
739
if {[string length $fval]} {
742
if {[string length $fvaldel]} {
744
} elseif {[string length $fvalsu]} {
746
} elseif {[string length $fvalsd]} {
749
if {$fed && $fdel == 0 && $prevwassd} {
751
set formvals [linsert $formvals [expr {[llength $formvals] - 1}] $fval]
752
} elseif {$fed && $fdel == 0 && $fsu == 0} {
753
lappend formvals $fval
757
} elseif {$fed && $fdel == 0 && $fsu} {
758
set fvallen [llength $formvals]
760
set formvals [linsert $formvals [expr {$fvallen - 2}] $fval]
762
lappend formvals $fval
767
set len [llength $formvals]
768
if {$len != [llength $vals]} {
771
for {set i 0} {$i < $len} {incr i} {
772
if {[string compare [lindex $formvals $i] [lindex $vals $i]]} {
778
} elseif {[llength $formvals] != [llength $vals]} {
781
set valslength [llength $vals]
782
for {set i 0} {$i < $valslength} {incr i} {
783
if {[string compare [lindex $vals $i] [lindex $formvals $i]]} {
790
WPCmd PEConfig varset $varname $formvals
792
# what about wp-indexheight?
795
wpGetVarAs $varname tval
798
set feathelpname $varname
800
set featset [expr {[lsearch $setfeatures $varname] >= 0}]
801
set formfeatset [expr {[string compare $tval on] == 0}]
802
if {$formfeatset != $featset} {
803
WPCmd PEConfig feature $varname $formfeatset
808
if {[info exists subop]} {
811
catch {WPCmd PEInfo unset help_context}
812
catch {WPCmd set oncancel $oncancel}
813
set help_vars [list topic topicclass]
814
set topic $varhelpname
815
set _cgi_uservar(topic) $varhelpname
816
set topicclass variable
817
set _cgi_uservar(topicclass) variable
818
set _cgi_uservar(oncancel) conf_process
822
catch {WPCmd PEInfo unset help_context}
823
catch {WPCmd set oncancel $oncancel}
824
set help_vars [list topic topicclass oncancel]
825
set topic $feathelpname
826
set _cgi_uservar(topic) $feathelpname
827
set topicclass feature
828
set _cgi_uservar(topicclass) feature
829
set _cgi_uservar(oncancel) conf_process
833
catch {WPCmd PEInfo unset help_context}
834
catch {WPCmd set oncancel $oncancel}
835
set help_vars [list topic topicclass oncancel]
836
set topic $feathelpname
837
set _cgi_uservar(topic) $feathelpname
838
set topicclass $topicclass
839
set _cgi_uservar(topicclass) $topicclass
840
set _cgi_uservar(oncancel) conf_process
844
if {$cid != [WPCmd PEInfo key]} {
845
error [list _close "Invalid Operation ID"]
847
WPCmd PEConfig saveconf
849
catch {WPCmd PEInfo unset config_deftext}
855
wpGetVar fno [list _INTEGER_]
856
wpGetVar subop [list edit add]
858
if {[catch {wpGetVar filtcancel}]} {
859
if {[catch {wpGetVar filthelp}] == 0} {
860
catch {WPCmd PEInfo unset help_context}
861
catch {WPCmd set oncancel $oncancel}
863
set patlist [wpGetRulePattern]
864
set actlist [wpGetRuleAction 0]
865
# we have to save this exactly as it would look when getting it from alpined
866
set ftsadd [expr {[string compare $subop "add"] == 0 ? 1 : 0}]
867
set ftsform [list [list "pattern" $patlist] [list "filtaction" $actlist]]
868
catch {WPCmd set filttmpstate [list $ftsadd $fno $ftsform]}
870
set help_vars [list topic]
872
set _cgi_uservar(topic) filtedit
874
if {[string compare $subop "edit"] == 0} {
875
set fakeimg "vle.filters.$fno"
876
set fakesz [expr {$fno + 1}]
878
set fakeimg "vla.filters"
882
set _cgi_uservar(oncancel) [WPPercentQuote "conf_process&wv=rule&filters-sz=${fakesz}&${fakeimg}.x=1&${fakeimg}.y=1&oncancel=main.tcl"]
884
} elseif {[set nv [numberedVar rmheader header_total]] >= 0} {
886
# load all the rules, process "headers"
887
foreach pat [wpGetRulePattern] {
888
set [lindex $pat 0] [lindex $pat 1]
890
if {[string compare headers [lindex $pat 0]] == 0} {
891
if {[llength $headers] > $nv} {
892
set headers [lreplace $headers $nv $nv]
897
# load all the actions
898
foreach act [wpGetRuleAction 0] {
899
set [lindex $act 0] [lindex $act 1]
902
# load other variables
903
wpGetVarAs nickname nickname
904
wpGetVarAs comment comment
905
wpGetVarAs folder folder
906
wpGetVarAs ftype ftype
909
set filtedit_fno $fno
910
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
911
set filtedit_onfiltcancel conf_process
912
set script "fr_filtedit.tcl"
913
} elseif {[catch {wpGetVar addheader}] == 0} {
915
# load all the rules, process "headers"
916
foreach pat [wpGetRulePattern] {
917
set [lindex $pat 0] [lindex $pat 1]
918
if {[string compare headers [lindex $pat 0]] == 0} {
919
foreach h [set headers [lindex $pat 1]] {
920
if {0 == [string length [lindex $h 0]]
921
&& 0 == [string length [lindex $h 1]]} {
926
if {![info exists emptyheader]} {
927
lappend headers [list {} {}]
932
# load all the actions
933
foreach act [wpGetRuleAction 0] {
934
set [lindex $act 0] [lindex $act 1]
937
# load other variables
940
wpGetVarAs folder folder
941
wpGetVarAs ftype ftype
944
set filtedit_fno $fno
945
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
946
set filtedit_onfiltcancel conf_process
947
set script "fr_filtedit.tcl"
949
# load other variables
952
wpGetVarAs folder folder
953
wpGetVarAs ftype ftype
955
set patlist [wpGetRulePattern]
956
set actlist [wpGetRuleAction 1]
958
lappend patlist [list nickname $nickname]
959
lappend patlist [list comment $comment]
961
set ret [catch {WPCmd PEConfig ruleset filter $subop $fno $patlist $actlist} res]
963
error [list _action "Filter Set" $res]
964
} elseif {[string length $res]} {
965
WPCmd PEInfo statmsg "Filter setting failed: $res"
967
set filtedit_fno $fno
968
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
969
set filtedit_onfiltcancel conf_process
970
set script "fr_filtedit.tcl"
976
wpGetVar fno [list _INTEGER_]
977
wpGetVar subop [list edit add]
979
if {[catch {wpGetVar filtcancel}]} {
980
if {[catch {wpGetVar filthelp}] == 0} {
981
catch {WPCmd PEInfo unset help_context}
982
catch {WPCmd set oncancel $oncancel}
983
if {[string compare $subop "edit"] == 0 || [string compare $subop "add"] == 0} {
984
set patlist [wpGetRulePattern]
986
# we have to save this exactly as it would look when getting it from alpined
987
set ftsadd [expr {[string compare $subop "add"] == 0 ? 1 : 0}]
988
set ftsform [list [list "pattern" $patlist] [list "filtaction" $actlist]]
989
catch {WPCmd set filttmpstate [list $ftsadd $fno $ftsform]}
991
set help_vars [list topic]
993
set _cgi_uservar(topic) scoreedit
996
set fakeimg "vle.scores.$fno"
997
set fakesz [expr {$fno + 1}]
1000
set fakeimg "vla.scores"
1005
set _cgi_uservar(oncancel) [WPPercentQuote "conf_process&wv=rule&scores-sz=${fakesz}&${fakeimg}.x=1&${fakeimg}.y=1&oncancel=main.tcl"]
1007
} elseif {[set nv [numberedVar rmheader header_total]] >= 0} {
1009
# load all the rules, process "headers"
1010
foreach pat [wpGetRulePattern] {
1011
set [lindex $pat 0] [lindex $pat 1]
1013
if {[string compare headers [lindex $pat 0]] == 0} {
1014
if {[llength $headers] > $nv} {
1015
set headers [lreplace $headers $nv $nv]
1020
# load other variables
1023
wpGetVarAs folder folder
1024
wpGetVarAs ftype ftype
1027
set filtedit_score 1
1028
set filtedit_fno $fno
1029
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1030
set filtedit_onfiltcancel conf_process
1031
set script "fr_filtedit.tcl"
1032
} elseif {[catch {wpGetVar addheader}] == 0} {
1034
# load all the rules, process "headers"
1035
foreach pat [wpGetRulePattern] {
1036
set [lindex $pat 0] [lindex $pat 1]
1037
if {[string compare headers [lindex $pat 0]] == 0} {
1038
foreach h [set headers [lindex $pat 1]] {
1039
if {0 == [string length [lindex $h 0]]
1040
&& 0 == [string length [lindex $h 1]]} {
1045
if {![info exists emptyheader]} {
1046
lappend headers [list {} {}]
1051
# load other variables
1054
wpGetVarAs folder folder
1055
wpGetVarAs ftype ftype
1058
set filtedit_score 1
1059
set filtedit_fno $fno
1060
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1061
set filtedit_onfiltcancel conf_process
1062
set script "fr_filtedit.tcl"
1067
# load other variables
1070
wpGetVarAs folder folder
1071
wpGetVarAs ftype ftype
1073
set patlist [wpGetRulePattern]
1075
lappend patlist [list nickname $nickname]
1076
lappend patlist [list comment $comment]
1079
lappend actlist [list "scoreval" $scoreval]
1082
lappend actlist [list "scorehdr" $scorehdr]
1084
set ret [catch {WPCmd PEConfig ruleset score $subop $fno $patlist $actlist} res]
1087
error [list _action "Score Set" $res]
1088
} elseif {[string length $res]} {
1089
WPCmd PEInfo statmsg "Score setting failed: $res"
1091
set filtedit_score 1
1092
set filtedit_fno $fno
1093
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1094
set filtedit_onfiltcancel conf_process
1095
set script "fr_filtedit.tcl"
1103
wpGetVar fno [list _INTEGER_]
1104
wpGetVar subop [list edit add]
1106
if {[catch {wpGetVar filtcancel}]} {
1107
if {[catch {wpGetVar filthelp}] == 0} {
1108
catch {WPCmd PEInfo unset help_context}
1109
catch {WPCmd set oncancel $oncancel}
1110
if {[string compare $subop "edit"] == 0 || [string compare $subop "add"] == 0} {
1111
set patlist [wpGetRulePattern]
1113
# we have to save this exactly as it would look when getting it from alpined
1114
set ftsadd [expr {[string compare $subop "add"] == 0 ? 1 : 0}]
1115
set ftsform [list [list "pattern" $patlist] [list "filtaction" $actlist]]
1116
catch {WPCmd set filttmpstate [list $ftsadd $fno $ftsform]}
1118
set help_vars [list topic]
1119
set topic indexcoloredit
1120
set _cgi_uservar(topic) indexcoloredit
1123
set fakeimg "vle.indexcolor.$fno"
1124
set fakesz [expr {$fno + 1}]
1127
set fakeimg "vla.indexcolor"
1132
set _cgi_uservar(oncancel) [WPPercentQuote "conf_process&wv=rule&indexcolor-sz=${fakesz}&${fakeimg}.x=1&${fakeimg}.y=1&oncancel=main.tcl"]
1134
} elseif {[set nv [numberedVar rmheader header_total]] >= 0} {
1136
# load all the rules, process "headers"
1137
foreach pat [wpGetRulePattern] {
1138
set [lindex $pat 0] [lindex $pat 1]
1140
if {[string compare headers [lindex $pat 0]] == 0} {
1141
if {[llength $headers] > $nv} {
1142
set headers [lreplace $headers $nv $nv]
1147
# load other variables
1150
wpGetVarAs folder folder
1151
wpGetVarAs ftype ftype
1154
set filtedit_indexcolor 1
1155
set filtedit_fno $fno
1156
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1157
set filtedit_onfiltcancel conf_process
1158
set script "fr_filtedit.tcl"
1159
} elseif {[catch {wpGetVar addheader}] == 0} {
1160
# load all the rules, process "headers"
1161
foreach pat [wpGetRulePattern] {
1162
set [lindex $pat 0] [lindex $pat 1]
1163
if {[string compare headers [lindex $pat 0]] == 0} {
1164
foreach h [set headers [lindex $pat 1]] {
1165
if {0 == [string length [lindex $h 0]]
1166
&& 0 == [string length [lindex $h 1]]} {
1171
if {![info exists emptyheader]} {
1172
lappend headers [list {} {}]
1177
# load other variables
1180
wpGetVarAs folder folder
1181
wpGetVarAs ftype ftype
1184
set filtedit_indexcolor 1
1185
set filtedit_fno $fno
1186
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1187
set filtedit_onfiltcancel conf_process
1188
set script "fr_filtedit.tcl"
1189
} elseif {[catch {cgi_import_as colormap.x colx}] == 0
1190
&& [catch {cgi_import_as colormap.y coly}] == 0} {
1191
set rgbs {"000" "051" "102" "153" "204" "255"}
1192
set xrgbs {"00" "33" "66" "99" "CC" "FF"}
1193
set rgblen [llength $rgbs]
1196
set colx [expr {${colx} / $imappixwidth}]
1197
set coly [expr {${coly} / $imappixwidth}]
1198
if {($coly >= 0 && $coly < $rgblen)
1199
&& ($colx >= 0 && $colx < [expr {$rgblen * $rgblen}])} {
1201
set igreen [expr {($colx / $rgblen) % $rgblen}]
1202
set iblue [expr {$colx % $rgblen}]
1203
set rgb "[lindex $rgbs $ired],[lindex $rgbs ${igreen}],[lindex $rgbs ${iblue}]"
1204
set xrgb "[lindex $xrgbs $ired][lindex $xrgbs ${igreen}][lindex $xrgbs ${iblue}]"
1206
if {[catch {wpGetVar fgorbg [list fg bg]}]} {
1207
WPCmd PEInfo statmsg "Invalid fore/back ground input!"
1211
WPCmd PEInfo statmsg "Invalid RGB Input!"
1214
# relay any other config changes
1217
wpGetVarAs folder folder
1218
wpGetVarAs ftype ftype
1219
foreach pat [wpGetRulePattern] {
1220
set [lindex $pat 0] [lindex $pat 1]
1223
# import previous settings
1228
if {[info exists xrgb]} {
1233
set filtedit_indexcolor 1
1234
set filtedit_fno $fno
1235
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1236
set filtedit_onfiltcancel conf_process
1237
set script "fr_filtedit.tcl"
1246
set patlist [wpGetRulePattern]
1248
lappend patlist [list nickname $nickname]
1249
lappend patlist [list comment $comment]
1253
if {[catch {wpGetVar fg}] == 0 && [catch {wpGetVar bg}] == 0} {
1254
lappend actlist [list fg $fg]
1255
lappend actlist [list bg $bg]
1258
set ret [catch {WPCmd PEConfig ruleset indexcolor $subop $fno $patlist $actlist} res]
1260
error [list _action "Color Set Error" $res]
1261
} elseif {[string length $res]} {
1262
WPCmd PEInfo statmsg "Index Color setting failed: $res"
1264
set filtedit_indexcolor 1
1265
set filtedit_fno $fno
1266
set filtedit_add [expr {[string compare $subop add] == 0 ? 1 : 0}]
1267
set filtedit_onfiltcancel conf_process
1268
set script "fr_filtedit.tcl"
1271
error [list _action "Unset FG/BG" "Internal Error: Unset Color Variables"]
1287
wpGetVarAs cle_cancel.x cle_cancel
1288
wpGetVarAs cle_save.x cle_save
1292
set cledit_onclecancel conf_process
1293
if {[string length $cle_save]} {
1294
if {[catch {cgi_import_as "ssl" sslval}]} {
1297
if {[string compare $sslval on] == 0} {
1303
regexp "\{?(\[^\}\]*)\}?(.*)" $server match serverb serverrem
1304
if {[string length $serverb]} {
1306
set serverb "$serverb/ssl"
1308
if {[string compare "" "$user"]} {
1309
set serverb "$serverb/user=$user"
1311
if {[string compare "imap" [string tolower $stype]]} {
1312
set serverb "$serverb/[string tolower $stype]"
1314
if {[string compare "nntp" [string tolower $stype]] == 0} {
1315
regsub -nocase {^(#news\.)?(.*)$} "$path" "#news.\\2" path
1316
if {[string compare "" $path] == 0} {
1322
set servera "\{$serverb\}$serverrem"
1324
set ret [catch {WPCmd PEConfig cladd $cl $nick $servera $path $view} result]
1326
set ret [catch {WPCmd PEConfig cledit $cl $nick $servera $path $view} result]
1329
error [list _action "Collection List Set" $result]
1330
} elseif {[string compare "" $result]} {
1332
set clerrtext "Add failed: $result"
1334
set clerrtext "Edit failed: $result"
1336
WPCmd PEInfo statmsg $clerrtext
1337
set script "fr_cledit.tcl"
1340
set clerrtext "Bad data: Nothing defined for Server"
1341
WPCmd PEInfo statmsg $clerrtext
1342
set script "fr_cledit.tcl"
1347
catch {WPCmd PEInfo noop}
1350
set script $oncancel
1351
catch {WPCmd unset conf_page} res
1354
error [list _close "Unknown process operation: $op"]
1358
source [WPTFScript $script]
added
removed
web/cgi/alpine/1.0/conf_process.tcl
