1 # Web Alpine Config options
2 # $Id: alpine.tcl 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $
3 # ========================================================================
4 # Copyright 2006-2008 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 # ========================================================================
14 encoding system
"utf-8"
16 set _wp
(appname
) Alpine
17 set _wp
(admin
) admin
@sample-domain.edu
18 set _wp
(helpdesk
) admin
@sample-domain.edu
19 set _wp
(comments
) help
@sample-domain.edu
21 # List of userid's allowed to request the monitor script output
24 # directory prefix web server uses for web alpine page requests
25 # Note: set to {} if DocumentRoot set to the root of web alpine cgi scripts
26 set _wp
(urlprefix
) webmail
28 # file system path to CGI application files
29 # directory containing web alpine application scripts and supporting tools
30 # The htdocs/ directory is located at /srv/www/htdocs. Here we copy the
31 # web directory to /srv/www/Webalpine/web using "tar cf" followed by
32 # "tar xf" which preserves symbolic links
33 # Original configuration:
34 #set _wp(fileroot) /usr/local/libexec/alpine
35 set _wp
(fileroot
) /srv
/www
/Webalpine
/web
40 # NOTE: Make SURE tclsh and alpine.tcl symlinks in this directory
41 set _wp
(cgipath
) [file join $_wp(fileroot
) cgi
]
43 # CGI scripts implementing U/I, session cookie scope
44 set _wp
(appdir
) alpine
50 # place for CGI scripts not requiring session-key
53 # place for binaries referenced by the CGI scripts
54 set _wp
(bin
) [file join $_wp(fileroot
) bin
]
55 set _wp
(servlet
) alpined
56 set _wp
(pc_servlet
) pc_alpined
57 set _wp
(pldap
) alpineldap
59 # place for config files referenced by the CGI scripts
60 set _wp
(confdir
) [file join $_wp(fileroot
) config
]
61 set _wp
(conffile
) pine.conf
62 set _wp
(defconf
) $_wp(conffile
)
64 # place for library files used by CGI scripts
65 set _wp
(lib
) [file join $_wp(fileroot
) lib
]
67 # directory used temporarily to stage attached and detached files
68 # this directory is owned by wwwrun:www
69 set _wp
(detachpath
) [file join $_wp(fileroot
) detach
]
71 set _wp
(imagepath
) [file join / $_wp(urlprefix
) images
]
73 set _wp
(buttonpath
) [file join $_wp(imagepath
) buttons silver
]
75 set _wp
(staticondir
) env
77 set _wp
(servername
) [info hostname
]
79 # MUST specify SSL/TLS connection
80 set _wp
(serverport
) {}
81 set _wp
(serverpath
) https
://[file join [join [eval list $_wp(servername
) $_wp(serverport
)] :] $_wp(urlprefix
)]
83 # MAY specify a plaintext connection (comment out if plain support undesired)
85 set _wp
(plainservpath
) http://[file join [join [eval list $_wp(servername
) $_wp(plainport
)] :] $_wp(urlprefix
)]
87 # url of faq page(s) available from initial greeting page
88 #set _wp(faq) "http://www.yourserver/faqs/alpine.html"
90 # url of informational page accessible from initial greeting page
91 set _wp
(releaseblurb
) "$_wp(plainservpath)/alpine/help/release.html"
93 # url of previous version server to be accessible from initial greeting page
94 #set _wp(oldserverpath) "https://previous.version.server.edu:444/"
96 # session id length: make sure the integer count below matches what's built
97 # into the pubcookie: "src/pubcookie/wp_uidmapper_lib.h:#define WP_KEY_LEN 6"
100 # Where and what format the alpined comm socket should take
101 set _wp
(sockdir
) $_wp(tmpdir
)
102 set _wp
(sockpat
) wp
%s
105 set _wp
(bordercolor
) #FEFAC9
106 set _wp
(menucolor
) #3E2E6D
107 set _wp
(dialogcolor
) #FEFAC9
108 set _wp
(titlecolor
) #000000
109 set _wp
(logodir
) alpine
111 # various timerouts, dimensions and feature settings
114 set _wp
(autodraft
) 300
115 set _wp
(logoutpause
) 60
116 set _wp
(indexlines
) 20
117 set _wp
(indexlinesmax
) 50
118 set _wp
(indexheight
) 24
119 set _wp
(navheight
) 28
121 set _wp
(titleheight
) 34
123 set _wp
(config
) remote_pinerc
125 set _wp
(save_cache_max
) 6
126 set _wp
(fldr_cache_max
) 20
127 set _wp
(fldr_cache_def
) 3
128 set _wp
(statushelp
) 0
129 set _wp
(imgbuttons
) 0
130 set _wp
(keybindings
) 1
131 set _wp
(dictionary
) 0
135 set _wp
(menuargs
) {width
="112" nowrap valign
=top
}
136 set _wp
(ispell
) /usr
/local
/bin
/ispell
138 # Yahoo! User Interface Library location
139 set _wp
(yui
) $_wp(serverpath
)/$_wp(appdir
)/$_wp(ui2dir
)/lib
/yui
140 #set _wp(yui) "http://yui.yahooapis.com/2.7.0"
142 # usage reporter - input: username as first command line argument
143 # output: space separated integers usage and total
144 #set _wp(usage) $_wp(bin)/usage.tcl
145 #set _wp(usage_link) "https://uwnetid.washington.edu/disk/"
147 # limit uploads to 1 file at a time, maximum 20MB.
148 set _wp
(uplim_files
) 1
149 set _wp
(uplim_bytes
) 20000000
151 # verify sessid from consistent REMOTE_ADDR (set to 0 for proxying clusters)
154 # set to list of domains for which ssl is NOT required
155 #set _wp(ssl_safe_domains) {}
157 # set to list of address blocks or ranges for which ssl is NOT required
158 #set _wp(ssl_safe_addrs) {}
160 # set this value to zero to turn OFF ssl by default
161 set _wp
(ssl_default
) 1
163 # allow connecting user to specify imap server on greeting page
164 set _wp
(flexserver
) 1
166 # make sure tmp files and such are ours alone to read/write
167 catch {exec umask
044}
169 #fix up indexheight so it isn't too high or too low
170 set _wp
(indexheight
) [expr {$_wp(indexheight
) <= 20 ?
20 : $_wp(indexheight
) >= 30 ?
30 : $_wp(indexheight
)}]
172 # SPAM reporting facility, if set "Report Spam" button appears at top of View Page
173 #set _wp(spamaddr) spamaddr@sample-domain.edu
174 #set _wp(spamfolder) junk-mail
175 #set _wp(spamsubj) "ATTACHED SPAM"
177 # external mail filter config link
178 #set _wp(filter_link) http://delivery-filter.sample-domain.edu/filter/config
180 # external vacation config link
181 #set _wp(vacation_link) http://vacation.sample-domain.edu/vacation/config
184 # Nickname server bindings. If not present, prompt for the
185 # destination of the default pinerc location.
191 $_wp(confdir
)/gmail.conf
196 $_wp(confdir
)/gmx.conf
200 $User.deskmail.washington.edu
/ssl
201 $_wp(confdir
)/conf.deskmail
205 # Everybody inherits the cgi, comm packages
206 lappend auto_path
$_wp(lib
)
209 package require WPComm
211 # Recipient of bad news bubbling up from cgi.tcl...
212 cgi_admin_mail_addr
$_wp(admin
)
216 #cgi_mail_relay localhost
217 cgi_mail_relay smtpserver.sample-domain.edu
219 # set permissions for owner-only handling
220 cgi_tmpfile_permissions
0640
223 cgi_file_limit
$_wp(uplim_files
) $_wp(uplim_bytes
)
225 # universal body tag parameters
226 cgi_body_args link
=#0000FF vlink=#000080 alink=#FF0000 marginwidth=0 marginheight=0 topmargin=0 leftmargin=0
228 # Common Images Image definitions
229 cgi_imglink logo
[file join $_wp(imagepath
) logo
$_wp(logodir
) big.gif
] border
=0 "alt=Web Alpine"
230 cgi_imglink smalllogo
[file join $_wp(imagepath
) logo
$_wp(logodir
) small.gif
] border
=0 "alt=About Web Alpine"
231 cgi_imglink background
[file join $_wp(imagepath
) logo
$_wp(logodir
) back.gif
] border
=0 align
=top
232 cgi_imglink dot
[file join $_wp(imagepath
) dot2.gif
] border
=0 align
=top
233 cgi_imglink increas
[file join $_wp(imagepath
) increas4.gif
] border
=0 align
=absmiddle
234 cgi_imglink decreas
[file join $_wp(imagepath
) decreas4.gif
] border
=0 align
=absmiddle
235 cgi_imglink expand
[file join $_wp(imagepath
) b_plus.gif
] border
=0 "alt=Expand" height
=9 width
=9
236 cgi_imglink contract
[file join $_wp(imagepath
) b_minus.gif
] border
=0 "alt=Collapse" height
=9 width
=9
237 cgi_imglink fullhdr
[file join $_wp(imagepath
) hdr.gif
] border
=0 "alt=Full Header"
238 cgi_imglink nofullhdr
[file join $_wp(imagepath
) hdrnon.gif
] border
=0 "alt=Digested Header"
239 cgi_imglink bang
[file join $_wp(imagepath
) caution.gif
] border
=0 "alt=!"
240 cgi_imglink postmark
[file join $_wp(imagepath
) postmark.gif
] border
=0 "alt=New Mail"
241 cgi_imglink gtab
[file join $_wp(imagepath
) tabs gtab.gif
] border
=0 align
=top
242 cgi_imglink gdtab
[file join $_wp(imagepath
) tabs gdtab.gif
] border
=0 align
=top
243 cgi_imglink abtab
[file join $_wp(imagepath
) tabs abtab.gif
] border
=0 align
=top
244 cgi_imglink abdtab
[file join $_wp(imagepath
) tabs abdtab.gif
] border
=0 align
=top
245 cgi_imglink ctab
[file join $_wp(imagepath
) tabs ctab.gif
] border
=0 align
=top
246 cgi_imglink cdtab
[file join $_wp(imagepath
) tabs cdtab.gif
] border
=0 align
=top
247 cgi_imglink ftab
[file join $_wp(imagepath
) tabs ftab.gif
] border
=0 align
=top
248 cgi_imglink fdtab
[file join $_wp(imagepath
) tabs fdtab.gif
] border
=0 align
=top
249 cgi_imglink mltab
[file join $_wp(imagepath
) tabs mltab.gif
] border
=0 align
=top
250 cgi_imglink mldtab
[file join $_wp(imagepath
) tabs mldtab.gif
] border
=0 align
=top
251 cgi_imglink mvtab
[file join $_wp(imagepath
) tabs mvtab.gif
] border
=0 align
=top
252 cgi_imglink mvdtab
[file join $_wp(imagepath
) tabs mvdtab.gif
] border
=0 align
=top
253 cgi_imglink rtab
[file join $_wp(imagepath
) tabs rtab.gif
] border
=0 align
=top
254 cgi_imglink rdtab
[file join $_wp(imagepath
) tabs rdtab.gif
] border
=0 align
=top
258 cgi_link Admin
"Web Alpine Administrator" "mailto:$_wp(admin)"
259 cgi_link Start
"Web Alpine Home Page" "$_wp(serverpath)/session/greeting.tcl" target
=_top
261 # Internally referenced CGI directory root
262 cgi_root
$_wp(serverpath
)
265 # have cgi.tcl convert eols in muiltipart/form-data
266 set _cgi
(no_binary_upload
) 1
268 proc WPSocketName
{sessid
} {
271 return [file join $_wp(sockdir
) [format $_wp(sockpat
) $sessid]]
274 proc WPValidId
{{sessid
{}}} {
277 if {[string length
$sessid] == 0} {
280 # Session Handle: a bit reasonably random number. the format
281 # is convenient for pubcookie auth'd support
283 set rsrc
/dev
/urandom
284 set idbytelength
[expr {$_wp(sessidlen
) * 4}]
285 if {[file readable
$rsrc] && [catch {open $rsrc r
} fp
] == 0} {
287 for {set i
0} {$i < $idbytelength} {incr i
} {
288 if {$i && ($i % 4) == 0} {
292 if {[catch {read $fp 1} n
] == 0} {
294 set x
[expr ($x & 0xff)]
295 append rnum
[format {%02x
} $x]
302 if {[file exists
[WPSocketName
$rnum]]} {
312 # second choice for random numbers
313 if {[string length
$rnum] == 0} {
314 expr srand
([clock seconds
])
315 for {set i
0} {$i < $idbytelength} {incr i
4} {
316 if {$i && ($i % 4) == 0} {
320 append rnum
[format {%08x
} [expr int
((100000000 * rand
()))]]
324 # generate a session ID
325 set _wp
(sessid
) $rnum
327 set sessidparts
[split $sessid {@}]
328 switch [llength $sessidparts] {
330 set _wp
(sessid
) $sessid
333 if {[string compare
[string tolower
[lindex $sessidparts 1]] [string tolower
[info hostname
]]]} {
334 regexp {^
([a-zA-Z
]*://).
*} [cgi_root
] match proto
335 error [list redirect
"${proto}[lindex $sessidparts 1]:$env(SERVER_PORT)?$env(QUERY_STRING)"]
337 set _wp
(sessid
) [lindex $sessidparts 0]
341 error "Malformed Session ID: $sessid"
346 set _wp
(sockname
) [WPSocketName
$_wp(sessid
)]
348 if {[info exists _wp
(cumulative
)]} {
349 rename WPCmd WPCmd.orig
350 rename WPCmdTimed WPCmd
353 if {[info exists _wp
(hostcheck
)] && $_wp(hostcheck
) == 1 && ![info exists created
]
354 && [catch {WPCmd
set wp_client
} client
] == 0
355 && (([info exists env
(REMOTE_ADDR
)] && [string length
$env(REMOTE_ADDR
)] && [string compare
$client $env(REMOTE_ADDR
)])
356 ||
([info exists env
(REMOTE_HOST
)] && [string length
$env(REMOTE_HOST
)] && [string compare
$client $env(REMOTE_HOST
)]))} {
357 error "Request from unrecognized client"
369 if {[info exists _wp
(cleanup
)]} {
370 foreach item
$_wp(cleanup
) {
376 proc WPEval
{vars cmd
} {
379 if {$_wp(cmdtime
) ||
$_wp(evaltime
)} {
380 set _wp
(cumulative
) 0
384 set _wp
(vars
) [linsert $vars 0 [list sessid
"Missing Session ID"]]
388 if {$_wp(debug
) > 1} {
393 if {[catch {WPGetInputAndID sessid
}]} {
397 foreach item
$_wp(vars
) {
398 if {[catch {eval WPImport
$item} errstr
]} {
399 WPInfoPage
"Web Alpine Error" [font size
=+2 $errstr] "Please close this window."
404 # evaluate the given script
405 if {[catch {cgi_buffer
$_wp(cmd
)} result
]} {
409 if {[string index
$result 0] == "_"} {
410 switch -- [lindex $result 0] {
412 WPInfoPage
[lindex $result 1] [font size
=+2 [lindex $result 2]] [lindex $result 3]
415 switch -regexp -- [lindex $result 2] {
416 "[Ii]nactive [Ss]ession" {
420 if {[string length
[lindex $result 3]]} {
421 set remedy
[lindex $result 3]
423 set remedy
" Click your browser's Back button to return to previous page."
425 WPInfoPage
"[lindex $result 1] Error" [font size
=+2 [lindex $result 2]] \
426 "Please report this to the [cgi_link Admin].$remedy"
432 cgi_redirect
[lindex $result 1]
435 cgi_html
{ cgi_body
{} }
438 if {[string length
[lindex $result 1]] == 0} {
439 set result
"Indeterminate error"
442 WPInfoPage
"Web Alpine Error" [font size
=+2 [lindex $result 1]] "Please close this window."
445 if {[string length
$result]} {
446 WPInfoPage
"Web Alpine Error" [font size
=+2 "Eval Error: $result"] \
447 "Please complain to the [cgi_link Admin]. Click Back button to return to previous page."
449 WPInfoPage
"Web Alpine Error" [font size
=+2 "Indeterminate error response"] \
450 "Please complain to the [cgi_link Admin] and click Back button to return to previous page."
455 if {[regexp {[Ii
]nactive
[Ss
]ession
} $result]} {
458 WPInfoPage
"Web Alpine Error" [font size
=+2 "Error: $result"] \
459 "Please report this to the [cgi_link Admin]. Try clicking your browser's Back button to return to a working page."
463 catch {cgi_puts
$result}
471 if {[info exists _wp
(cumulative
)]} {
472 WPdebug
"Cumulative Eval: $_wp(cumulative)"
473 unset _wp
(cumulative
)
477 proc WPGetInputAndID
{_sessid
} {
479 upvar $_sessid sessid
481 # Import data and validate it
482 if {[catch {cgi_input
"sessid=8543949466398&"} result
]} {
483 WPInfoPage
"Web Alpine Error" [font size
=+2 $result] "Please close this window."
484 error "Cannot get CGI Input"
487 if {[catch {WPImport sessid
"Missing Session ID"} errstr
]} {
488 if {[regexp {.
*sessid.
*no such.
*} $errstr]} {
489 WPInactivePage
[list "Your browser may have failed to send the necessary <i>cookie</i> information. Please verify your browser configuration has cookies enabled."]
491 WPInfoPage
"Web Alpine Error" [font size
=+2 $errstr] "Please close this window."
494 error "Session ID Failure"
496 # initialization here
497 if {[catch {WPValidId
$sessid} result
]} {
498 if {[string compare
[lindex $result 0] redirect
]} {
499 WPInfoPage
"Web Alpine Error" [font size
=+2 "$result"] \
500 "Please complain to the [cgi_link Admin] and visit the [cgi_link Start] later."
503 cgi_redirect
[lindex $result 1]
507 error "Unrecoverable Error"
508 } elseif
{$_wp(sessid
) == 0} {
510 error "Inactive Session"
513 if {[catch {WPCmd
set serverroot
} serverroot
] == 0} {
519 proc WPCmdEval
{args
} {
526 return [WPSend
$_wp(sockname
) $args]
529 proc WPCmdTimed
{args
} {
532 set t
[lindex [time {set r
[WPSend
$_wp(sockname
) $args]}] 0]
533 incr _wp
(cumulative
) $t
536 WPdebug
"time $t : $args"
542 proc WPLoadCGIVar
{_var
} {
545 if {[catch {cgi_import_as
$_var var
} result
]
546 && [catch {WPCmd
set $_var} var
]
547 && [catch {cgi_import_cookie_as
$_var var
} result
]} {
548 error [list _action
"Import Cookie $_var" $result]
552 proc WPLoadCGIVarAs
{_var _varas
} {
555 if {[catch {cgi_import_as
$_var varas
} result
]
556 && [catch {WPCmd
set $_var} varas
]
557 && [catch {cgi_import_cookie_as
$_var varas
} result
]} {
562 proc WPImport
{valname
{errstring
""} {default 0}} {
565 if {[catch {cgi_import_as
$valname val
} result
]} {
566 if {[catch {WPCmd
set $valname} val
]} {
567 if {[catch {cgi_import_cookie_as
$valname val
} result
]} {
568 if {[string length
$errstring] > 0} {
569 error "$errstring: $result"
579 proc WPExportCookie
{name value
{scope
""}} {
582 cgi_cookie_set
$name=$value "path=[file join / $_wp(urlprefix) $scope]"
586 # handle dynamic sizing of images showing thread relationships
587 proc WPThreadImageLink
{t h
} {
590 return "<img src=\"[file join $_wp(imagepath) ${t}.gif]\" border=0 align=top height=${h} width=14>"
594 proc WPInactivePage
{{reasons
""}} {
600 WPInfoPage
"Inactive Session" \
601 "[font size=+2 "Web Alpine Session No Longer Active
"]" \
602 "There are several reasons why a session might become inactive.<ul><li>A bookmarked reference to a Web Alpine page.<li>Failed periodic page reload due to browser/system suspension associated with power saving mode, etc.${l}</ul><p>Please visit the [cgi_link Start] to start a new session."
605 proc WPInfoPage
{title exp1
{exp2
""} {imgurl
{}} {exp3
""}} {
613 cgi_stylesheet
[file join / $_wp(urlprefix
) $_wp(pubdir
) standard.css
]
617 cgi_table height
="20%" {
620 cgi_puts
[cgi_nbspace
]
626 cgi_table border
=0 width
=500 cellpadding
=3 {
628 cgi_table_data align
=center rowspan
=3 {
629 if {[string length
$imgurl]} {
630 cgi_put
[cgi_url
[cgi_imglink logo
] $imgurl]
632 cgi_put
[cgi_imglink logo
]
636 cgi_table_data rowspan
=3 {
647 if {[string length
$exp3]} {
649 cgi_table_data
"style=\"border: 1px solid red; background-color: pink\"" {
655 if {[string length
$exp2]} {
669 proc WPimg
{image {extension gif
}} {
672 return [file join $_wp(imagepath
) ${image}.
${extension
}]
675 proc WPCharValue
{c
} {
680 proc WPPercentQuote
{arg
{exclude
{}}} {
681 set t
"\[^0-9a-zA-Z_${exclude}\]"
682 if {[regsub -all $t $arg {[format "%%%.2X" [WPCharValue
"\\&"]]} subarg
]} {
683 set x
[subst $subarg]
691 regsub -all {([\\'
])} $l {\\\1} l
695 proc WPurl
{cmd cmdargs
text explanation args
} {
698 lappend urlargs
$text
700 if {[regexp "^java*" $cmd] == 0 && [string first .
$cmd] < 0} {
701 append urlargs
".tcl"
704 if {[string length
$cmdargs]} {
705 if {[set i
[string first
"?" $cmdargs]] >= 0} {
706 append urlargs
"[cgi_quote_url [string range $cmdargs 0 [expr {$i - 1}]]]?[cgi_quote_url [string range $cmdargs [incr i] end]]"
708 append urlargs
"?[cgi_quote_url $cmdargs]"
712 if {$_wp(statushelp
)} {
713 lappend urlargs
[WPmouseover
$explanation]
714 lappend urlargs
"onMouseOut=window.status=''"
717 return [eval "cgi_url $urlargs $args"]
720 proc WPMenuURL
{cmd cmdargs
text explanation args
} {
721 return [WPurl
$cmd $cmdargs $text $explanation class
=menubar
[join $args]]
724 proc WPGetTDFontSize
{{ih
24}} {
725 if {$ih <= 20 } {return 12}
726 if {$ih >= 30 } {return 24}
727 return [expr {$ih - 8}]
730 proc WPGetviewFontSize
{{ih
24}} {
731 if {$ih <= 20 } {return 8}
732 if {$ih >= 30 } {return 13}
733 return [expr {($ih / 2) - 2}]
736 proc WPIndexLineHeight
{{ih
0}} {
739 set ih
[WPCmd PEInfo indexheight
]
740 if {[string length
$ih] == 0 ||
$ih <= 0} {
741 set ih
$_wp(indexheight
)
744 return [expr {($ih < 20) ?
20 : $ih}]
747 proc WPStyleSheets
{{ih
0}} {
750 cgi_stylesheet
[file join / $_wp(urlprefix
) $_wp(pubdir
) standard.css
]
753 set ih
[WPIndexLineHeight
]
756 cgi_puts
"<style type='text/css'>\nTD { font-size: [WPGetTDFontSize $ih]px }\n.view {font-size: [WPGetviewFontSize $ih]pt }\n</style>"
760 proc WPStdScripts
{{ih
0}} {
763 set ih
[WPStyleSheets
$ih]
765 cgi_script language
="JavaScript" src
="[file join / $_wp(urlprefix) $_wp(pubdir) standard.js]" {}
766 cgi_script language
="JavaScript1.3" {cgi_put
"js_version = '1.3';"}
768 cgi_puts
"function getIndexHeight(){return $ih}"
772 proc WPStdHttpHdrs
{{ctype
{}} {expires
0}} {
775 # set date and expires headers the same to prevent caching
776 # Date: Tue, 15 Nov 1994 08:12:31 GMT
777 set doctime
[clock seconds
]
779 if {[string length
$ctype]} {
780 cgi_content_type
$ctype
785 cgi_puts
"Date: [clock format $doctime -gmt true -format "%a
, %d
%b
%Y
%H
:%M
:%S GMT
"]"
788 cgi_puts
"Cache-Control: no-cache"
789 cgi_puts
"Expires: [clock format [expr {$doctime - 31536000}] -gmt true -format "%a
, %d
%b
%Y
%H
:%M
:%S GMT
"]"
790 } elseif
{$expires > 0} {
791 cgi_puts
"Expires: [clock format [expr {$doctime + ($expires * 60)}] -gmt true -format "%a
, %d
%b
%Y
%H
:%M
:%S GMT
"]"
795 proc WPStdHtmlHdr
{pagetitle
{pagescript
""} {newmail
0}} {
804 cgi_title
"${nm}Web Alpine - $pagetitle"
805 # cgi_base "href=$_wp(serverpath)/"
806 if {[info exists _wp
(nocache
)]} {
807 cgi_http_equiv Pragma no-cache
810 # cgi_http_equiv Expires $_wp(docdate)
811 cgi_meta
"name=Web Alpine" content
=[clock format [file mtime
[info script
]] -format "%y%m%d/%H%M"]
812 if {[catch {WPCmd
set nojs
} nojs
] ||
$nojs != 1} {
813 cgi_script type
="text/javascript" language
="JavaScript" {
814 cgi_puts
"if(self != top) top.location.href = location.href;"
815 cgi_puts
"js_version = '1.0';"
819 cgi_put
"<link rel=\"icon\" href=\"[cgi_root]/favicon.ico\" type=\"image/x-icon\">"
820 cgi_put
"<link rel=\"shortcut icon\" href=\"[cgi_root]/favicon.ico\" type=\"image/x-icon\"> "
823 proc WPHtmlHdrReload
{pagescript
} {
826 if {[regexp {\?} $pagescript]} {
832 cgi_http_equiv Refresh
"$_wp(refresh); url=[cgi_root]/${pagescript}${c}reload=1"
835 proc WPNewMail
{reload
{viewpage msgview.tcl
}} {
837 if {[catch {WPCmd PEMailbox newmail
$reload} newmail
]} {
838 return -code error $newmail
843 if {[set msgsnew
[lindex $newmail 0]] > 0} {
844 if {[string length
$viewpage]} {
845 if {[string first
{?
} $viewpage] < 0} {
851 set newurl
"${viewpage}${delim}uid=[lindex $newmail 1]"
853 set newurl
[lindex $newmail 1]
856 set newicon
"postmark"
857 set newtext
[cgi_quote_html
[WPCmd PEMailbox newmailstatmsg
]]
859 if {[WPCmd PEInfo feature enable-newmail-sound
]} {
860 #set audio sounds/mail_msg.wav
861 set audio
/sounds
/ding.wav
863 set newsound
"<bgsound src=\"$audio\" loop=\"1\" volume=\"100\">"
865 set newsound
"<embed src=\"$audio\" autostart=\"true\" hidden width=0 height=0 loop=\"false\"><noembed><bgsound src=\"$audio\" loop=\"1\"></noembed>"
871 if {0 == [string length
$newtext]} {
872 set newtext
"You have $msgsnew new message[WPplural $msgsnew]"
875 lappend newref
[list $newtext $newicon $newurl $newsound]
878 if {[set deleted
[lindex $newmail 2]] > 0} {
879 set newtext
"$deleted Message[WPplural $deleted] removed from folder"
880 lappend newref
[list $newtext "" ""]
883 foreach statmsg
[WPStatusMsgs
] {
884 lappend newref
[list $statmsg "" ""]
885 WPCmd PEInfo statmsg
""
889 WPCmd PEMailbox newmailreset
895 proc WPStatusMsgs
{} {
898 if {[catch {WPCmd PEInfo statmsgs
} statmsgs
] == 0} {
899 foreach statmsg
$statmsgs {
900 if {[string length
$statmsg] > 0 && [string compare
$statmsg $lastmsg]} {
901 if {[regexp "^Pinerc \(.+\) NOT saved$" $statmsg]} {
902 lappend retmsgs
"Another Pine/WebPine session may be running. Settings cannot be saved."
904 lappend retmsgs
$statmsg
915 proc WPStatusIcon
{uid
{extension gif
} {statbits
""}} {
918 if {[string length
$statbits] == 0} {
919 set statbits
[WPCmd PEMessage
$uid statusbits
]
922 if {[string index
$statbits 0]} {
929 set fullalt
"Viewed "
932 if {[string index
$statbits 3]} {
934 set alt
"*[string range $alt 1 end]"
935 set fullaltend
", important message"
936 } elseif
{([string index
$statbits 4] ||
[string index
$statbits 5])} {
938 set alt
"+[string range $alt 1 end]"
939 set fullaltend
" message to you"
942 if {[string index
$statbits 2]} {
944 set alt
"[string range $alt 0 0]A"
945 append fullalt
", answered"
948 if {[string index
$statbits 1]} {
950 set alt
"[string range $alt 0 0]D"
951 append fullalt
", deleted"
954 if {[info exists fullaltend
]} {
955 append fullalt
$fullaltend
957 append fullalt
message
960 regsub -all { } $alt {\ 
;} alt
962 return [list [file join $_wp(imagepath
) $_wp(staticondir
) ${sicon
}.
${extension
}] i_
${uid
} $alt $fullalt]
965 proc WPStatusLabel
{uid
} {
968 set statbits
[WPCmd PEMessage
$uid statusbits
]
970 if {[string index
$statbits 0]} {
976 if {[string index
$statbits 3]} {
980 if {[string index
$statbits 1]} {
984 if {[string index
$statbits 2]} {
991 proc WPStatusImg
{uid
} {
992 set sicon
[WPStatusIcon
$uid]
993 return [cgi_img
[lindex $sicon 0] name
=[lindex $sicon 1] id
=[lindex $sicon 1] height
=16 width
=42 border
=0 alt
=[lindex $sicon 3]]
996 proc WPSessionState
{args
} {
997 switch [llength $args] {
1000 if {[catch {WPCmd PEInfo alpinestate
} state_list
] == 0} {
1001 array set state_array
$state_list
1002 if {[llength $args] == 1} {
1003 return $state_array([lindex $args 0])
1005 set state_array
([lindex $args 0]) [lindex $args 1]
1006 set state_list
[array get state_array
]
1007 if {[catch {WPCmd PEInfo alpinestate
$state_list} result
]} {
1008 error "Can't set session state : $result"
1012 error "Can't read session state"
1016 error "Unknown SessionState Parameters: $args"
1021 proc WPScriptVersion
{tag
{inc
0}} {
1022 if {[catch {WPCmd
set wp_script_version
} sv
]} {
1023 set versions
($tag) [expr int
((1000 * rand
()))]
1024 set sv
[array get versions
]
1025 catch {WPCmd
set wp_script_version
$sv}
1027 array set versions
$sv
1029 if {![info exists versions
($tag)]} {
1030 set versions
($tag) [expr int
((1000 * rand
()))]
1031 set sv
[array get versions
]
1032 catch {WPCmd
set wp_script_version
$sv}
1034 incr versions
($tag) $inc
1035 set sv
[array get versions
]
1036 catch {WPCmd
set wp_script_version
$sv}
1040 return $versions($tag)
1043 proc WPplural
{count
} {
1051 proc WPcomma
{number
{dot
,}} {
1054 while {[set n
[string length
$number]] > 3} {
1055 set x
"${dot}[string range $number [incr n -3] end]$x"
1056 set number
[string range
$number 0 [incr n
-1]]
1065 return [expr {[info exists env
(HTTP_USER_AGENT
)] == 1 && [string first MSIE
$env(HTTP_USER_AGENT
)] >= 0}]
1071 return [expr {[info exists env
(HTTP_USER_AGENT
)] && (([regexp {^Mozilla
/([0-9]).
[0-9]+} $env(HTTP_USER_AGENT
) match majorversion
] && $majorversion > 4) ||
([regexp {Opera
([0-9])\.
[0-9]+} $env(HTTP_USER_AGENT
) match majorversion
] && $majorversion > 5))}]
1074 proc WPdebug
{args
} {
1077 switch [lindex $args 0] {
1079 if {[regexp {^
([0-9])+$} [lindex $args 1]]} {
1080 WPSend
$_wp(sockname
) [subst {PEDebug level
[lindex $args 1]}]
1084 switch [lindex $args 1] {
1086 WPSend
$_wp(sockname
) [subst {ePEDebug imap
4}]
1089 WPSend
$_wp(sockname
) [subst {PEDebug imap
0}]
1094 WPSend
$_wp(sockname
) "PEDebug write [list [list [file tail [info script]]: [lrange $args 0 end]]]"
1099 proc WPdebugstack
{} {
1102 for {set n
[expr {[info level
] - 1}]} {$n > 0} {incr n
-1} {
1103 append stack
"$n) [info level $n]\n"
1109 ##############################################################
1110 # routines to improve integration with cgi.tcl
1111 ##############################################################
1113 # routine exposing some of cgi.tcl's innards.
1114 # Should be exported by cgi.tcl package.
1115 proc reset_cgi_state
{} {
1118 catch {unset _cgi
(http_head_in_progress
)}
1119 catch {unset _cgi
(http_head_done
)}
1120 catch {unset _cgi
(http_status_done
)}
1121 catch {unset _cgi
(html_in_progress
)}
1122 catch {unset _cgi
(head_in_progress
)}
1123 catch {unset _cgi
(head_done
)}
1124 catch {unset _cgi
(html_done
)}
1125 catch {unset _cgi
(head_suppress_tag
)}
1126 catch {unset _cgi
(body_in_progress
)}
1127 catch {unset _cgi
(tag_in_progress
)}
1128 catch {unset _cgi
(form_in_progress
)}
1129 catch {unset _cgi
(close_proc
)}
1131 if {[info exists _cgi
(returnIndex
)]} {
1132 while {[set _cgi
(returnIndex
)] > 0} {
1133 incr _cgi
(returnIndex
) -1
1135 rename cgi_puts
$_cgi(returnIndex
) cgi_puts
1140 ###############################################################
1141 # routines to process (and be called in) html template files
1142 ###############################################################
1144 proc html_readfile
{file} {
1145 set x
[open $file "r"]
1146 set result
[read $x]
1151 proc html_eval
{_vars_ _this_
} {
1152 foreach {_i_ _j_
} $_vars_ {
1153 if {$_i_ == "global"} {global $_j_} {set $_i_ $_j_}
1155 unset _vars_ _i_ _j_
1156 return [subst $_this_]
1159 proc html_loop
{varslist
text} {
1161 foreach {vars
} $varslist {
1162 append result
[html_eval
$vars $text]