1
# $Id: folders.tcl 1204 2009-02-02 19:54:23Z hubert@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 generate html output associated with folder
16
# and collection management
46
# HTML/Javascript/CSS data representing the message specified
47
# by the 'uid' argument
49
proc linecolor {linenum} {
57
proc pretty_folder_name {collections folder} {
58
set fcolid [lindex $folder 0]
59
for {set i 0} {$i < [llength $collections]} {incr i} {
60
set col [lindex $collections $i]
61
if {$fcolid == [lindex $col 0]} {
62
set coltext [lindex $col 1]
65
return "${coltext}:[join [lrange $folder 1 end] /]"
69
# Display the given folder list in a table (w/ mihodge mods)
71
proc blat_folder_list {colid flist shown path baseurl scroll anchorcntref depth} {
72
global key border indention mbox _wp
74
upvar $anchorcntref anchorcnt
78
foreach folder $flist {
79
set t [lindex $folder 0]
80
set f [lindex $folder 1]
81
set ff [linsert $path [llength $path] $f]
84
set bgcolor [linecolor [incr anchorcnt]]
86
# initial pad=12, expand/contract control is 9px wide
87
set cellpad [expr {12 + ($depth * $indention)}]
88
set delim [WPCmd PEFolder delimiter $colid]
89
set fullpath [join [lrange $ff 1 end] $delim]
91
if {[string first F $t] >= 0} {
92
regsub -all {(')} [lrange $ff 1 end] {\\\\\1} ef
93
set celldata [cgi_url $f open.tcl?colid=${colid}&folder=[WPPercentQuote $fullpath]&oncancel=folders&cid=$key target=_top]
98
if {[string first D $t] >= 0} {
100
if {[set index [lsearch $shown $ff]] < 0} {
106
set celldata "[cgi_url [cgi_imglink $control] "${baseurl}${control}=[WPPercentQuote $ff]#f_[WPPercentQuote $ff]" name=f_[WPPercentQuote $ff] "style=\"padding-right:10px\""]$celldata"
110
cgi_table_row bgcolor=$bgcolor {
112
cgi_table_data align=center {
113
if {[string first F $t] >= 0 || ([WPCmd PEFolder isincoming $colid] == 0 && [string compare $mbox $fullpath])} {
114
cgi_radio_button "fid=f_[WPPercentQuote $ff]"
118
cgi_table_data align=left "style=\"padding-left: ${cellpad}px\"" nowrap {
122
cgi_table_data valign=top nowrap {
123
if {[info exists control] && [string compare $control contract] == 0} {
124
cgi_submit_button "new_[WPPercentQuote $ff]=Create New..."
125
cgi_submit_button "imp_[WPPercentQuote $ff]=Import..."
127
cgi_puts [cgi_nbspace]
132
if {[string first D $t] >= 0 && $index >= 0} {
133
set nflist [eval WPCmd PEFolder list $ff]
136
blat_folder_list $colid $nflist $shown $newpath $baseurl $scroll anchorcnt [expr {$depth + 1}]
139
catch {unset control}
145
# Command Menu definition for Message View Screen
155
# * * * * Ubiquitous INBOX link * * * *
156
if {[string compare inbox [string tolower $mbox]]} {
157
cgi_put [cgi_url INBOX [cgi_root]/$_wp(appdir)/$_wp(ui1dir)/open.tcl?folder=INBOX&colid=0&cid=[WPCmd PEInfo key] target=_top class=navbar]
159
cgi_put [cgi_url INBOX fr_main.tcl target=_top class=navbar]
168
# * * * * COMPOSE * * * *
169
cgi_puts [cgi_url Compose wp.tcl?page=compose&oncancel=folders&cid=$key target=_top class=navbar]
177
# * * * * RESUME * * * *
178
#set button [cgi_img [WPimg but_resume] border=0 alt="Resume"]
180
cgi_puts [cgi_url $button wp.tcl?page=resume&oncancel=folders&cid=$key class=navbar]
188
# * * * * Addr books * * * *
189
#set button [cgi_img [WPimg but_abook] border=0 alt="Address Book"]
190
set button "Address Book"
191
cgi_puts [cgi_url $button wp.tcl?page=addrbook&oncancel=folders class=navbar]
195
{{cgi_puts [cgi_nbspace]}}
200
cgi_put [cgi_url "Configure" wp.tcl?page=conf_process&newconf=1&oncancel=folders&cid=[WPCmd PEInfo key] class=navbar target=_top]
208
cgi_put [cgi_url "Get Help" wp.tcl?page=help&oncancel=folders class=navbar target=_top]
212
{{cgi_puts [cgi_nbspace]}}
217
# * * * * LOGOUT * * * *
218
if {[WPCmd PEInfo feature quit-without-confirm]} {
219
cgi_puts [cgi_url "Quit $_wp(appname)" $_wp(serverpath)/session/logout.tcl?cid=[WPCmd PEInfo key]&sessid=$sessid target=_top class=navbar]
221
cgi_puts [cgi_url "Quit $_wp(appname)" wp.tcl?page=quit&cid=[WPCmd PEInfo key] target=_top class=navbar]
229
foreach item $folder_vars {
230
if {[catch {cgi_import [lindex $item 0].x}]} {
231
if {[catch {eval WPImport $item} errstr]} {
232
error [list _action "Impart Variable" $errstr]
235
set [lindex $item 0] 1
239
if {[catch {WPCmd PEInfo key} key]} {
240
error [list _action "command ID" $key]
243
# perform requested op
244
if {$delquery == 1 || [string compare $delquery Delete] == 0} {
245
if {[string length $fid]} {
246
set fid [string range $fid 2 end]
247
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_querydelfldr.tcl]
250
lappend newmail [list "Click button next to folder name then Click [cgi_italic Delete]"]
252
} elseif {$delete == 1 || [string compare $delete Delete] == 0} {
254
lappend newmail [list "Invalid Command ID"]
255
} elseif {[string length $fid]} {
256
if {[catch [concat WPCmd PEFolder delete $fid] result] == 0} {
257
lappend newmail [list "'[lindex $fid end]' permanently removed"]
260
lappend newmail [list "Click button next to folder name then Click [cgi_italic Delete]"]
262
} elseif {[string compare $delete Cancel] == 0} {
263
catch {WPCmd PEInfo unset wp_folder_script}
264
lappend newmail [list "Folder Delete Cancelled"]
265
} elseif {[string compare $rename Cancel] == 0} {
266
catch {WPCmd PEInfo unset wp_folder_script}
267
lappend newmail [list "Folder Rename Cancelled"]
268
} elseif {$renquery == 1 || [string compare $renquery Rename] == 0} {
270
lappend newmail [list "Invalid Command ID"]
271
} elseif {[string length $fid]} {
272
set fid [string range $fid 2 end]
273
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_queryrenfldr.tcl]
276
lappend newmail [list "Click button next to folder name then Click [cgi_italic Rename]"]
278
} elseif {$dwnquery == 1 || [string compare $dwnquery Export] == 0} {
280
lappend newmail [list "Invalid Command ID"]
281
} elseif {[string length $fid] <= 0} {
282
lappend newmail [list "Click button next to folder name then Click [cgi_italic Export]"]
283
} elseif {[file isdirectory $_wp(detachpath)] <= 0} {
284
lappend newmail [list "Server Configuration Problem: $_wp(detachpath) does not exist"]
286
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) exporting.tcl]
289
} elseif {[string compare $rename Rename] == 0} {
290
if {[string length $folder]} {
291
if {[catch [concat WPCmd PEFolder rename $fid [list $folder]] result]} {
293
lappend newmail [list "'[lindex $fid end]' renamed to '$folder'"]
296
lappend newmail [list "Rename failed: no new name provided"]
298
} elseif {[string compare [string range $newfolder 0 5] Create] == 0} {
300
lappend newmail [list "Invalid Command ID"]
301
} elseif {[string length $folder]} {
302
set fpath [lrange $fid 1 end]
303
lappend fpath $folder
304
if {[catch {WPCmd PEFolder delimiter [lindex $fid 0]} result]
305
|| [catch {WPCmd PEFolder create [lindex $fid 0] [join $fpath $result]} result]} {
306
lappend newmail [list "Create failed: $result"]
308
lappend newmail [list "Folder $folder created"]
311
lappend newmail [list "Folder creation failed: no folder name provided"]
313
} elseif {[string compare $newfolder Cancel] == 0} {
314
catch {WPCmd PEInfo unset wp_folder_script}
315
lappend newmail [list "Folder Create Cancelled"]
316
} elseif {[string compare [string range $import 0 5] Import] == 0} {
317
if {[catch {WPImport file "Missing File Upload"} errstr] == 0} {
318
set local_file [lindex $file 0]
320
if {[catch {WPImport iname "import name"} errstr] == 0} {
321
set iname [string trim $iname]
323
if {[string length $iname]} {
325
set colid [lindex $fid 0]
326
set fldr [eval "file join [lrange $fid 1 end] $iname"]
328
if {[catch {WPCmd PEFolder import $local_file $colid $fldr} errstr] == 0} {
329
lappend newmail [list "Imported folder $iname"]
331
lappend newmail [list "Can't Import File: $errstr"]
334
lappend newmail [list "Must provide uploaded folder name"]
337
lappend newmail [list "Can't get uploaded folder name"]
340
catch {file delete -force $local_file}
342
lappend newmail [list "Problem uploading file"]
344
} elseif {[string compare [string range $newdir 0 5] Create] == 0} {
346
lappend newmail [list "Invalid Command ID"]
347
} elseif {[string length $directory]} {
348
set fpath [lrange $fid 1 end]
349
lappend fpath "${directory}/"
350
if {[catch {WPCmd PEFolder delimiter [lindex $fid 0]} result]
351
|| [catch {WPCmd PEFolder create [lindex $fid 0] [join $fpath $result]} result]} {
352
lappend newmail [list "Create failed: $result"]
354
lappend newmail [list "Folder $directory created"]
357
lappend newmail [list "Directory Create failed: no name provided"]
359
} elseif {[string compare $newdir Cancel] == 0} {
360
catch {WPCmd PEInfo unset wp_folder_script}
361
lappend newmail [list "Directory Creation Cancelled"]
362
} elseif {[string compare $cancelled Cancel] == 0} {
363
catch {WPCmd PEInfo unset wp_folder_script}
364
lappend newmail [list "New Folder or Directory Creation Cancelled"]
365
} elseif {[catch {WPCmd PEInfo set wp_folder_script} script] == 0} {
366
catch {WPCmd PEInfo unset wp_folder_script}
368
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) $script]
371
foreach i [cgi_import_list] {
372
switch -regexp -- $i {
373
^new_[a-zA-Z0-9%_]*$ {
374
set fid [string range $i 4 end]
375
catch {WPCmd PEInfo set fid $fid}
376
catch {WPCmd PEInfo set wp_folder_script fr_querynewdir.tcl}
377
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_querynewfoldir.tcl]
380
^nd_[a-zA-Z0-9%_]*$ {
381
set fid [string range $i 3 end]
382
catch {WPCmd PEInfo set fid $fid}
383
catch {WPCmd PEInfo set wp_folder_script fr_querynewdir.tcl}
384
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_querynewdir.tcl]
387
^nf_[a-zA-Z0-9%_]*$ {
388
set fid [string range $i 3 end]
389
catch {WPCmd set fid $fid}
390
catch {WPCmd set wp_folder_script fr_querynewfldr.tcl}
391
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_querynewfldr.tcl]
394
^imp_[a-zA-Z0-9%_]*$ {
395
set fid [string range $i 4 end]
396
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_queryimport.tcl]
403
catch {WPCmd PEInfo unset fid}
404
catch {WPCmd PEInfo unset wp_folder_script}
408
if {[info exists nopage] == 0} {
409
if {$reload || $frestore || ([string length $show] == 0 && [string length $expand] == 0 && [string length $contract] == 0)} {
410
catch {set show [WPCmd PEInfo set fr_show]
411
set expand [WPCmd PEInfo set fr_expand]
412
set contract [WPCmd PEInfo set fr_contract]}
414
WPCmd set fr_show $show
415
WPCmd set fr_expand $expand
416
WPCmd set fr_contract $contract
419
# collect top level folder lists
420
if {[catch {WPCmd PEFolder collections} collections]} {
421
error [list _action "Collection list" $collections]
424
set shown [split $show ,]
428
# mihodge: process actions
429
if {[llength $expand]} {
430
lappend shown $expand
434
if {[llength $contract]} {
435
if {[set index [lsearch $shown $contract]] >= 0} {
436
set shown [lreplace $shown $index $index]
441
set baseurl wp.tcl?page=folders&
443
if {[llength $shown]} {
444
append baseurl "show=[WPPercentQuote [join $shown ,]]&"
447
# build top-level collection's folder list
448
for {set i 0} {$i < [llength $collections]} {incr i} {
449
set col [lindex $collections $i]
450
set colid [lindex $col 0]
452
if {[llength $collections] == 1} {
455
if {[set index [lsearch $shown $colid]] < 0} {
462
if {[llength $flist]} {
463
if {[catch {WPCmd PEFolder list $colid} flist]} {
464
if {[string compare BADPASSWD [string range $flist 0 8]] == 0} {
465
# control error messages
466
set statmsgs [WPCmd PEInfo statmsgs]
467
WPCmd PEMailbox newmailreset
468
if {[catch {WPCmd PESession creds [lindex $expand 0] folder} creds] == 0 && $creds != 0} {
469
catch {WPCmd PEInfo statmsg "Invalid Username or Password"}
470
WPCmd PESession nocred $expand folder
473
if {[catch {WPCmd PEFolder clextended} coln]} {
474
WPCmd set reason "Can't get Collection Info: $coln"
476
set coln [lindex $coln $expand]
477
if {[regexp {^([a-zA-Z\.]+).*\/user=([^ /]*)} [lindex $coln 4] dummy srvname authuser]} {
478
WPCmd set reason "Listing folders in the [cgi_bold [lindex $coln 1]] collection first requires that you log in to the server [cgi_bold "$srvname"]."
479
WPCmd set authuser $authuser
481
WPCmd set reason "Folders in the [cgi_bold [lindex $coln 1]] collection are on a server that must be logged into."
485
WPCmd set cid [WPCmd PEInfo key]
486
WPCmd set authcol [lindex $expand 0]
487
WPCmd set authfolder folder
488
WPCmd set authpage [WPPercentQuote "[cgi_root]/$_wp(appdir)/$_wp(ui1dir)/wp.tcl?page=folders&expand=$expand"]
489
WPCmd set authcancel [WPPercentQuote "[cgi_root]/$_wp(appdir)/$_wp(ui1dir)/wp.tcl?page=folders"]
491
source [file join $_wp(cgipath) $_wp(appdir) $_wp(ui1dir) fr_queryauth.tcl]
493
catch {WPCmd unset fr_expand}
502
lappend collectionfolders $flist
506
if {[info exists nopage] == 0} {
507
# collect new mail message and errors
508
if {[catch {WPNewMail $reload} newmailmsg]} {
509
error [list _action "new mail" $newmailmsg]
511
foreach m $newmailmsg {
515
if {[info exists newmail] == 0} {
522
WPStdHttpHdrs text/html
527
WPStdHtmlHdr "Folder List" folders
530
set onunload "onUnload="
531
set normalreload [cgi_buffer {WPHtmlHdrReload "$_wp(appdir)/$_wp(ui1dir)/wp.tcl?page=folders"}]
533
if {[info exists _wp(exitonclose)]} {
535
append onload "wpLoad();"
536
append onunload "wpUnLoad();"
538
cgi_script type="text/javascript" language="JavaScript" {
539
cgi_put "function viewReloadTimer(t){"
540
cgi_put " reloadtimer = window.setInterval('wpLink(); window.location.replace(\\'[cgi_root]/$_wp(appdir)/$_wp(ui1dir)/wp.tcl?page=folders&reload=1\\')', t * 1000);"
544
append onload "viewReloadTimer($_wp(refresh));"
546
cgi_puts $normalreload
549
cgi_puts $normalreload
553
if {$_wp(keybindings)} {
555
{{i} {top.location = 'fr_main.tcl'}}
556
{{a} {top.location = 'wp.tcl?page=addrbook'}}
557
{{?} {top.location = 'wp.tcl?page=help&oncancel=folders'}}
560
lappend kequiv [list {c} "top.location = 'wp.tcl?page=compose&oncancel=folders&cid=$key'"]
562
append onload [WPTFKeyEquiv $kequiv]
566
cgi_body bgcolor=$_wp(bordercolor) background=[file join $_wp(imagepath) logo $_wp(logodir) back.gif] "style=\"background-repeat: repeat-x\"" $onload $onunload {
568
catch {WPCmd PEInfo set help_context folders}
570
# prepare context and navigation information
572
set mbox [WPCmd PEMailbox mailboxname]
574
lappend pagehier [list "Folder List"]
575
lappend pagehier [list [cgi_bold "\[Return to $mbox\]"] fr_main.tcl "View list of messages"]
576
if {[string compare $oncancel view] == 0} {
578
set num [WPCmd PEMessage $uid number]
583
lappend pagehier [list [cgi_bold "\[Return to Message $num\]"] view.tcl "View Message"]
588
WPTFTitle "Folder List" $newmail 0 "folders"
590
cgi_table border=0 cellspacing=0 cellpadding=0 width="100%" height="100%" {
593
cgi_table_data valign=top class=navbar {
594
cgi_table bgcolor=$_wp(menucolor) border=0 cellspacing=0 cellpadding=0 {
596
cgi_table_data class=navbar "style=\"padding: 6 0 0 4\"" {
597
cgi_puts [cgi_span "style=font-weight: bold" "Current Folder"]
598
cgi_division align=center "style=margin-top:4;margin-bottom:4" {
599
set mbn [WPCmd PEMailbox mailboxname]
600
if {[string length $mbn] > 16} {
601
set mbn "[string range $mbn 0 14]..."
604
cgi_put [cgi_url $mbn fr_main.tcl target=_top class=navbar]
606
switch -exact -- [WPCmd PEMailbox state] {
609
#cgi_put [cgi_span "style=color: black; border: 1px solid red; background-color: pink; font-weight: bold" "Read Only"]
610
cgi_put [cgi_span "style=color: pink; font-weight: bold" "(Read Only)"]
614
#cgi_put [cgi_span "style=color: black; border: 1px solid red; background-color: pink; font-weight: bold" "Closed"]
615
cgi_put [cgi_span "style=color: pink; font-weight: bold" "(Closed)"]
628
# next comes the menu down the left side, with suitable
631
cgi_table_data $_wp(menuargs) class=navbar style=padding-bottom:10 {
632
WPTFCommandMenu folder_menu common_menu
639
# down the right side of the table is the window's contents
640
cgi_table_data width="100%" bgcolor=#ffffff valign=top {
642
if {[llength $collections] > 1} {
643
cgi_division "style=\"font-family: helvetica; padding: 18; text-align: center\"" {
644
cgi_puts [cgi_span "style=font-weight: bold; font-size: 14pt; vertical-align: middle" "Folder Collections"]
646
cgi_puts [cgi_span "style=font-size: smaller" "(click to expand, open, delete, etc.)"]
650
cgi_form $_wp(appdir)/$_wp(ui1dir)/wp method=post target=_top {
651
cgi_text "page=folders" type=hidden notab
652
cgi_text "cid=$key" type=hidden notab
653
cgi_text "frestore=1" type=hidden notab
654
# then the table representing the folders
655
cgi_table border=0 cellspacing=0 cellpadding=2 align=center {
656
for {set i 0} {$i < [llength $collections]} {incr i} {
657
set col [lindex $collections $i]
658
set colid [lindex $col 0]
660
if {[llength $collections] == 1} {
664
if {[set index [lsearch $shown $colid]] < 0} {
674
cgi_table_data nowrap valign=middle {
675
if {[WPCmd PEFolder isincoming $colid] == 0 && [llength $flist]} {
676
cgi_image_button delquery=[WPimg but_folddel] border=0 alt=Delete
677
cgi_image_button renquery=[WPimg but_foldren] border=0 alt=Rename style=margin-left:4
678
cgi_image_button dwnquery=[WPimg but_foldexp] border=0 alt=Export style=margin-left:4
682
if {[llength $collections] > 1} {
683
if {[set index [lsearch $shown $colid]] < 0} {
684
set colpref [cgi_url [cgi_imglink expand] "${baseurl}expand=$colid" name=f_$colid]
686
set colpref [cgi_url [cgi_imglink contract] "${baseurl}contract=$colid" name=f_$colid]
692
cgi_table_data align=left "style=\"padding-left:10\"" nowrap {
693
if {[llength [lindex $collectionfolders $i]]} {
694
set flist [lindex $collectionfolders $i]
697
cgi_puts ${colpref}[cgi_span "style=font-family:Helvetica; size: large; padding-left:10" "[lindex $col 1]"]
700
if {[llength $flist]} {
701
if {[WPCmd PEFolder isincoming $colid] == 0} {
702
cgi_table_data valign=middle nowrap {
703
cgi_submit_button "new_$colid=Create New..."
704
cgi_submit_button "imp_$colid=Import..."
710
if {[llength $flist]} {
711
blat_folder_list $colid $flist $shown $colid $baseurl $scroll anchorcnt 1
715
cgi_table_data height=12 {
716
cgi_put [cgi_nbspace]
added
removed
web/cgi/alpine/1.0/folders.tcl
