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 5# 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 9# 10# http://www.apache.org/licenses/LICENSE-2.0 11# 12# ======================================================================== 13 14encoding system "utf-8" 15 16set _wp(appname) Alpine 17set _wp(admin) admin@sample-domain.edu 18set _wp(helpdesk) admin@sample-domain.edu 19set _wp(comments) help@sample-domain.edu 20 21# List of userid's allowed to request the monitor script output 22set _wp(monitors) {} 23 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 26set _wp(urlprefix) webmail 27 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 35set _wp(fileroot) /srv/www/Webalpine/web 36 37 38set _wp(tmpdir) /tmp 39 40# NOTE: Make SURE tclsh and alpine.tcl symlinks in this directory 41set _wp(cgipath) [file join $_wp(fileroot) cgi] 42 43# CGI scripts implementing U/I, session cookie scope 44set _wp(appdir) alpine 45 46# UI versions 47set _wp(ui1dir) 1.0 48set _wp(ui2dir) 2.0 49 50# place for CGI scripts not requiring session-key 51set _wp(pubdir) pub 52 53# place for binaries referenced by the CGI scripts 54set _wp(bin) [file join $_wp(fileroot) bin] 55set _wp(servlet) alpined 56set _wp(pc_servlet) pc_alpined 57set _wp(pldap) alpineldap 58 59# place for config files referenced by the CGI scripts 60set _wp(confdir) [file join $_wp(fileroot) config] 61set _wp(conffile) pine.conf 62set _wp(defconf) $_wp(conffile) 63 64# place for library files used by CGI scripts 65set _wp(lib) [file join $_wp(fileroot) lib] 66 67# directory used temporarily to stage attached and detached files 68# this directory is owned by wwwrun:www 69set _wp(detachpath) [file join $_wp(fileroot) detach] 70 71set _wp(imagepath) [file join / $_wp(urlprefix) images] 72 73set _wp(buttonpath) [file join $_wp(imagepath) buttons silver] 74 75set _wp(staticondir) env 76 77set _wp(servername) [info hostname] 78 79# MUST specify SSL/TLS connection 80set _wp(serverport) {} 81set _wp(serverpath) https://[file join [join [eval list $_wp(servername) $_wp(serverport)] :] $_wp(urlprefix)] 82 83# MAY specify a plaintext connection (comment out if plain support undesired) 84set _wp(plainport) {} 85set _wp(plainservpath) http://[file join [join [eval list $_wp(servername) $_wp(plainport)] :] $_wp(urlprefix)] 86 87# url of faq page(s) available from initial greeting page 88#set _wp(faq) "http://www.yourserver/faqs/alpine.html" 89 90# url of informational page accessible from initial greeting page 91set _wp(releaseblurb) "$_wp(plainservpath)/alpine/help/release.html" 92 93# url of previous version server to be accessible from initial greeting page 94#set _wp(oldserverpath) "https://previous.version.server.edu:444/" 95 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" 98set _wp(sessidlen) 6 99 100# Where and what format the alpined comm socket should take 101set _wp(sockdir) $_wp(tmpdir) 102set _wp(sockpat) wp%s 103 104# skin settings 105set _wp(bordercolor) #FEFAC9 106set _wp(menucolor) #3E2E6D 107set _wp(dialogcolor) #FEFAC9 108set _wp(titlecolor) #000000 109set _wp(logodir) alpine 110 111# various timerouts, dimensions and feature settings 112set _wp(refresh) 600 113set _wp(timeout) 900 114set _wp(autodraft) 300 115set _wp(logoutpause) 60 116set _wp(indexlines) 20 117set _wp(indexlinesmax) 50 118set _wp(indexheight) 24 119set _wp(navheight) 28 120set _wp(width) 80 121set _wp(titleheight) 34 122set _wp(titlesep) 4 123set _wp(config) remote_pinerc 124set _wp(motd) motd 125set _wp(save_cache_max) 6 126set _wp(fldr_cache_max) 20 127set _wp(fldr_cache_def) 3 128set _wp(statushelp) 0 129set _wp(imgbuttons) 0 130set _wp(keybindings) 1 131set _wp(dictionary) 0 132set _wp(debug) 0 133set _wp(cmdtime) 0 134set _wp(evaltime) 0 135set _wp(menuargs) {width="112" nowrap valign=top} 136set _wp(ispell) /usr/local/bin/ispell 137 138# Yahoo! User Interface Library location 139set _wp(yui) $_wp(serverpath)/$_wp(appdir)/$_wp(ui2dir)/lib/yui 140#set _wp(yui) "http://yui.yahooapis.com/2.7.0" 141 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/" 146 147# limit uploads to 1 file at a time, maximum 20MB. 148set _wp(uplim_files) 1 149set _wp(uplim_bytes) 20000000 150 151# verify sessid from consistent REMOTE_ADDR (set to 0 for proxying clusters) 152set _wp(hostcheck) 0 153 154# set to list of domains for which ssl is NOT required 155#set _wp(ssl_safe_domains) {} 156 157# set to list of address blocks or ranges for which ssl is NOT required 158#set _wp(ssl_safe_addrs) {} 159 160# set this value to zero to turn OFF ssl by default 161set _wp(ssl_default) 1 162 163# allow connecting user to specify imap server on greeting page 164set _wp(flexserver) 1 165 166# make sure tmp files and such are ours alone to read/write 167catch {exec umask 044} 168 169#fix up indexheight so it isn't too high or too low 170set _wp(indexheight) [expr {$_wp(indexheight) <= 20 ? 20 : $_wp(indexheight) >= 30 ? 30 : $_wp(indexheight)}] 171 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" 176 177# external mail filter config link 178#set _wp(filter_link) http://delivery-filter.sample-domain.edu/filter/config 179 180# external vacation config link 181#set _wp(vacation_link) http://vacation.sample-domain.edu/vacation/config 182 183# 184# Nickname server bindings. If not present, prompt for the 185# destination of the default pinerc location. 186# 187set _wp(hosts) { 188 { 189 Gmail 190 imap.gmail.com/ssl 191 $_wp(confdir)/gmail.conf 192 } 193 { 194 GMX 195 imap.gmx.com/ssl 196 $_wp(confdir)/gmx.conf 197 } 198 { 199 Deskmail 200 $User.deskmail.washington.edu/ssl 201 $_wp(confdir)/conf.deskmail 202 } 203} 204 205# Everybody inherits the cgi, comm packages 206lappend auto_path $_wp(lib) 207 208package require cgi 209package require WPComm 210 211# Recipient of bad news bubbling up from cgi.tcl... 212cgi_admin_mail_addr $_wp(admin) 213 214cgi_sendmail {} 215 216#cgi_mail_relay localhost 217cgi_mail_relay smtpserver.sample-domain.edu 218 219# set permissions for owner-only handling 220cgi_tmpfile_permissions 0640 221 222#set upload limits 223cgi_file_limit $_wp(uplim_files) $_wp(uplim_bytes) 224 225# universal body tag parameters 226cgi_body_args link=#0000FF vlink=#000080 alink=#FF0000 marginwidth=0 marginheight=0 topmargin=0 leftmargin=0 227 228# Common Images Image definitions 229cgi_imglink logo [file join $_wp(imagepath) logo $_wp(logodir) big.gif] border=0 "alt=Web Alpine" 230cgi_imglink smalllogo [file join $_wp(imagepath) logo $_wp(logodir) small.gif] border=0 "alt=About Web Alpine" 231cgi_imglink background [file join $_wp(imagepath) logo $_wp(logodir) back.gif] border=0 align=top 232cgi_imglink dot [file join $_wp(imagepath) dot2.gif] border=0 align=top 233cgi_imglink increas [file join $_wp(imagepath) increas4.gif] border=0 align=absmiddle 234cgi_imglink decreas [file join $_wp(imagepath) decreas4.gif] border=0 align=absmiddle 235cgi_imglink expand [file join $_wp(imagepath) b_plus.gif] border=0 "alt=Expand" height=9 width=9 236cgi_imglink contract [file join $_wp(imagepath) b_minus.gif] border=0 "alt=Collapse" height=9 width=9 237cgi_imglink fullhdr [file join $_wp(imagepath) hdr.gif] border=0 "alt=Full Header" 238cgi_imglink nofullhdr [file join $_wp(imagepath) hdrnon.gif] border=0 "alt=Digested Header" 239cgi_imglink bang [file join $_wp(imagepath) caution.gif] border=0 "alt=!" 240cgi_imglink postmark [file join $_wp(imagepath) postmark.gif] border=0 "alt=New Mail" 241cgi_imglink gtab [file join $_wp(imagepath) tabs gtab.gif] border=0 align=top 242cgi_imglink gdtab [file join $_wp(imagepath) tabs gdtab.gif] border=0 align=top 243cgi_imglink abtab [file join $_wp(imagepath) tabs abtab.gif] border=0 align=top 244cgi_imglink abdtab [file join $_wp(imagepath) tabs abdtab.gif] border=0 align=top 245cgi_imglink ctab [file join $_wp(imagepath) tabs ctab.gif] border=0 align=top 246cgi_imglink cdtab [file join $_wp(imagepath) tabs cdtab.gif] border=0 align=top 247cgi_imglink ftab [file join $_wp(imagepath) tabs ftab.gif] border=0 align=top 248cgi_imglink fdtab [file join $_wp(imagepath) tabs fdtab.gif] border=0 align=top 249cgi_imglink mltab [file join $_wp(imagepath) tabs mltab.gif] border=0 align=top 250cgi_imglink mldtab [file join $_wp(imagepath) tabs mldtab.gif] border=0 align=top 251cgi_imglink mvtab [file join $_wp(imagepath) tabs mvtab.gif] border=0 align=top 252cgi_imglink mvdtab [file join $_wp(imagepath) tabs mvdtab.gif] border=0 align=top 253cgi_imglink rtab [file join $_wp(imagepath) tabs rtab.gif] border=0 align=top 254cgi_imglink rdtab [file join $_wp(imagepath) tabs rdtab.gif] border=0 align=top 255 256 257# Link definitions 258cgi_link Admin "Web Alpine Administrator" "mailto:$_wp(admin)" 259cgi_link Start "Web Alpine Home Page" "$_wp(serverpath)/session/greeting.tcl" target=_top 260 261# Internally referenced CGI directory root 262cgi_root $_wp(serverpath) 263cgi_suffix .tcl 264 265# have cgi.tcl convert eols in muiltipart/form-data 266set _cgi(no_binary_upload) 1 267 268proc WPSocketName {sessid} { 269 global _wp 270 271 return [file join $_wp(sockdir) [format $_wp(sockpat) $sessid]] 272} 273 274proc WPValidId {{sessid {}}} { 275 global _wp env 276 277 if {[string length $sessid] == 0} { 278 set created 1 279 280 # Session Handle: a bit reasonably random number. the format 281 # is convenient for pubcookie auth'd support 282 set rnum {} 283 set rsrc /dev/urandom 284 set idbytelength [expr {$_wp(sessidlen) * 4}] 285 if {[file readable $rsrc] && [catch {open $rsrc r} fp] == 0} { 286 while {1} { 287 for {set i 0} {$i < $idbytelength} {incr i} { 288 if {$i && ($i % 4) == 0} { 289 append rnum "." 290 } 291 292 if {[catch {read $fp 1} n] == 0} { 293 binary scan $n c x 294 set x [expr ($x & 0xff)] 295 append rnum [format {%02x} $x] 296 } else { 297 set rnum {} 298 break 299 } 300 } 301 302 if {[file exists [WPSocketName $rnum]]} { 303 set rnum {} 304 } else { 305 break 306 } 307 } 308 309 close $fp 310 } 311 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} { 317 append rnum "." 318 } 319 320 append rnum [format {%08x} [expr int((100000000 * rand()))]] 321 } 322 } 323 324 # generate a session ID 325 set _wp(sessid) $rnum 326 } else { 327 set sessidparts [split $sessid {@}] 328 switch [llength $sessidparts] { 329 1 { 330 set _wp(sessid) $sessid 331 } 332 2 { 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)"] 336 } else { 337 set _wp(sessid) [lindex $sessidparts 0] 338 } 339 } 340 default { 341 error "Malformed Session ID: $sessid" 342 } 343 } 344 } 345 346 set _wp(sockname) [WPSocketName $_wp(sessid)] 347 348 if {[info exists _wp(cumulative)]} { 349 rename WPCmd WPCmd.orig 350 rename WPCmdTimed WPCmd 351 } 352 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" 358 } 359} 360 361proc WPAbort {} { 362 WPCleanup 363 cgi_exit 364} 365 366proc WPCleanup {} { 367 global _wp 368 369 if {[info exists _wp(cleanup)]} { 370 foreach item $_wp(cleanup) { 371 catch {eval $item} 372 } 373 } 374} 375 376proc WPEval {vars cmd} { 377 global _wp 378 379 if {$_wp(cmdtime) || $_wp(evaltime)} { 380 set _wp(cumulative) 0 381 } 382 383 set _wp(cmd) $cmd 384 set _wp(vars) [linsert $vars 0 [list sessid "Missing Session ID"]] 385 386 uplevel 1 { 387 cgi_eval { 388 if {$_wp(debug) > 1} { 389 cgi_debug -on 390 } 391 392 # Session id? 393 if {[catch {WPGetInputAndID sessid}]} { 394 return 395 } 396 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." 400 return 401 } 402 } 403 404 # evaluate the given script 405 if {[catch {cgi_buffer $_wp(cmd)} result]} { 406 407 reset_cgi_state 408 409 if {[string index $result 0] == "_"} { 410 switch -- [lindex $result 0] { 411 _info { 412 WPInfoPage [lindex $result 1] [font size=+2 [lindex $result 2]] [lindex $result 3] 413 } 414 _action { 415 switch -regexp -- [lindex $result 2] { 416 "[Ii]nactive [Ss]ession" { 417 WPInactivePage 418 } 419 default { 420 if {[string length [lindex $result 3]]} { 421 set remedy [lindex $result 3] 422 } else { 423 set remedy " Click your browser's Back button to return to previous page." 424 } 425 WPInfoPage "[lindex $result 1] Error" [font size=+2 [lindex $result 2]] \ 426 "Please report this to the [cgi_link Admin].$remedy" 427 } 428 } 429 } 430 _redirect { 431 cgi_http_head { 432 cgi_redirect [lindex $result 1] 433 } 434 435 cgi_html { cgi_body {} } 436 } 437 _close { 438 if {[string length [lindex $result 1]] == 0} { 439 set result "Indeterminate error" 440 } 441 442 WPInfoPage "Web Alpine Error" [font size=+2 [lindex $result 1]] "Please close this window." 443 } 444 default { 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." 448 } else { 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." 451 } 452 } 453 } 454 } else { 455 if {[regexp {[Ii]nactive [Ss]ession} $result]} { 456 WPInactivePage 457 } else { 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." 460 } 461 } 462 } else { 463 catch {cgi_puts $result} 464 } 465 } 466 } 467 468 # cleanup here 469 WPCleanup 470 471 if {[info exists _wp(cumulative)]} { 472 WPdebug "Cumulative Eval: $_wp(cumulative)" 473 unset _wp(cumulative) 474 } 475} 476 477proc WPGetInputAndID {_sessid} { 478 global _wp 479 upvar $_sessid sessid 480 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" 485 } 486 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."] 490 } else { 491 WPInfoPage "Web Alpine Error" [font size=+2 $errstr] "Please close this window." 492 } 493 494 error "Session ID Failure" 495 } else { 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." 501 } else { 502 cgi_http_head { 503 cgi_redirect [lindex $result 1] 504 } 505 } 506 507 error "Unrecoverable Error" 508 } elseif {$_wp(sessid) == 0} { 509 WPInactivePage 510 error "Inactive Session" 511 } 512 513 if {[catch {WPCmd set serverroot} serverroot] == 0} { 514 cgi_root $serverroot 515 } 516 } 517} 518 519proc WPCmdEval {args} { 520 return [eval $args] 521} 522 523proc WPCmd {args} { 524 global _wp 525 526 return [WPSend $_wp(sockname) $args] 527} 528 529proc WPCmdTimed {args} { 530 global _wp 531 532 set t [lindex [time {set r [WPSend $_wp(sockname) $args]}] 0] 533 incr _wp(cumulative) $t 534 535 if {$_wp(cmdtime)} { 536 WPdebug "time $t : $args" 537 } 538 539 return $r 540} 541 542proc WPLoadCGIVar {_var} { 543 upvar $_var var 544 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] 549 } 550} 551 552proc WPLoadCGIVarAs {_var _varas} { 553 upvar $_varas varas 554 555 if {[catch {cgi_import_as $_var varas} result] 556 && [catch {WPCmd set $_var} varas] 557 && [catch {cgi_import_cookie_as $_var varas} result]} { 558 set varas "" 559 } 560} 561 562proc WPImport {valname {errstring ""} {default 0}} { 563 upvar $valname val 564 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" 570 } else { 571 set val $default 572 } 573 } 574 } 575 } 576} 577 578 579proc WPExportCookie {name value {scope ""}} { 580 global _wp 581 582 cgi_cookie_set $name=$value "path=[file join / $_wp(urlprefix) $scope]" 583} 584 585 586# handle dynamic sizing of images showing thread relationships 587proc WPThreadImageLink {t h} { 588 global _wp 589 590 return "<img src=\"[file join $_wp(imagepath) ${t}.gif]\" border=0 align=top height=${h} width=14>" 591} 592 593 594proc WPInactivePage {{reasons ""}} { 595 set l {} 596 foreach r $reasons { 597 append l "<li>$r" 598 } 599 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." 603} 604 605proc WPInfoPage {title exp1 {exp2 ""} {imgurl {}} {exp3 ""}} { 606 global _wp 607 608 catch { 609 610 cgi_html { 611 cgi_head { 612 cgi_title $title 613 cgi_stylesheet [file join / $_wp(urlprefix) $_wp(pubdir) standard.css] 614 } 615 616 cgi_body { 617 cgi_table height="20%" { 618 cgi_table_row { 619 cgi_table_data { 620 cgi_puts [cgi_nbspace] 621 } 622 } 623 } 624 625 cgi_center { 626 cgi_table border=0 width=500 cellpadding=3 { 627 cgi_table_row { 628 cgi_table_data align=center rowspan=3 { 629 if {[string length $imgurl]} { 630 cgi_put [cgi_url [cgi_imglink logo] $imgurl] 631 } else { 632 cgi_put [cgi_imglink logo] 633 } 634 } 635 636 cgi_table_data rowspan=3 { 637 cgi_put [nbspace] 638 cgi_put [nbspace] 639 } 640 641 cgi_table_data { 642 cgi_puts $exp1 643 } 644 645 } 646 647 if {[string length $exp3]} { 648 cgi_table_row { 649 cgi_table_data "style=\"border: 1px solid red; background-color: pink\"" { 650 cgi_puts $exp3 651 } 652 } 653 } 654 655 if {[string length $exp2]} { 656 cgi_table_row { 657 cgi_table_data { 658 cgi_puts $exp2 659 } 660 } 661 } 662 } 663 } 664 } 665 } 666 } 667} 668 669proc WPimg {image {extension gif}} { 670 global _wp 671 672 return [file join $_wp(imagepath) ${image}.${extension}] 673} 674 675proc WPCharValue {c} { 676 scan "$c" %c n 677 return $n 678} 679 680proc 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] 684 return $x 685 } else { 686 return $arg 687 } 688} 689 690proc WPJSQuote {l} { 691 regsub -all {([\\'])} $l {\\\1} l 692 return $l 693} 694 695proc WPurl {cmd cmdargs text explanation args} { 696 global _wp 697 698 lappend urlargs $text 699 lappend urlargs $cmd 700 if {[regexp "^java*" $cmd] == 0 && [string first . $cmd] < 0} { 701 append urlargs ".tcl" 702 } 703 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]]" 707 } else { 708 append urlargs "?[cgi_quote_url $cmdargs]" 709 } 710 } 711 712 if {$_wp(statushelp)} { 713 lappend urlargs [WPmouseover $explanation] 714 lappend urlargs "onMouseOut=window.status=''" 715 } 716 717 return [eval "cgi_url $urlargs $args"] 718} 719 720proc WPMenuURL {cmd cmdargs text explanation args} { 721 return [WPurl $cmd $cmdargs $text $explanation class=menubar [join $args]] 722} 723 724proc WPGetTDFontSize {{ih 24}} { 725 if {$ih <= 20 } {return 12} 726 if {$ih >= 30 } {return 24} 727 return [expr {$ih - 8}] 728} 729 730proc WPGetviewFontSize {{ih 24}} { 731 if {$ih <= 20 } {return 8} 732 if {$ih >= 30 } {return 13} 733 return [expr {($ih / 2) - 2}] 734} 735 736proc WPIndexLineHeight {{ih 0}} { 737 global _wp 738 739 set ih [WPCmd PEInfo indexheight] 740 if {[string length $ih] == 0 || $ih <= 0} { 741 set ih $_wp(indexheight) 742 } 743 744 return [expr {($ih < 20) ? 20 : $ih}] 745} 746 747proc WPStyleSheets {{ih 0}} { 748 global _wp 749 750 cgi_stylesheet [file join / $_wp(urlprefix) $_wp(pubdir) standard.css] 751 752 if {$ih <= 0} { 753 set ih [WPIndexLineHeight] 754 } 755 756 cgi_puts "<style type='text/css'>\nTD { font-size: [WPGetTDFontSize $ih]px }\n.view {font-size: [WPGetviewFontSize $ih]pt }\n</style>" 757 return $ih 758} 759 760proc WPStdScripts {{ih 0}} { 761 global _wp 762 763 set ih [WPStyleSheets $ih] 764 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';"} 767 cgi_javascript { 768 cgi_puts "function getIndexHeight(){return $ih}" 769 } 770} 771 772proc WPStdHttpHdrs {{ctype {}} {expires 0}} { 773 global _wp 774 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] 778 779 if {[string length $ctype]} { 780 cgi_content_type $ctype 781 } else { 782 cgi_content_type 783 } 784 785 cgi_puts "Date: [clock format $doctime -gmt true -format "%a, %d %b %Y %H:%M:%S GMT"]" 786 if {$expires == 0} { 787 set _wp(nocache) 1 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"]" 792 } 793} 794 795proc WPStdHtmlHdr {pagetitle {pagescript ""} {newmail 0}} { 796 global _wp 797 798 if {0 && $newmail} { 799 set nm "* " 800 } else { 801 set nm "" 802 } 803 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 808 } 809 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';" 816 } 817 } 818 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\"> " 821} 822 823proc WPHtmlHdrReload {pagescript} { 824 global _wp 825 826 if {[regexp {\?} $pagescript]} { 827 set c "&" 828 } else { 829 set c "?" 830 } 831 832 cgi_http_equiv Refresh "$_wp(refresh); url=[cgi_root]/${pagescript}${c}reload=1" 833} 834 835proc WPNewMail {reload {viewpage msgview.tcl}} { 836 837 if {[catch {WPCmd PEMailbox newmail $reload} newmail]} { 838 return -code error $newmail 839 } 840 841 set newref "" 842 843 if {[set msgsnew [lindex $newmail 0]] > 0} { 844 if {[string length $viewpage]} { 845 if {[string first {?} $viewpage] < 0} { 846 set delim ? 847 } else { 848 set delim & 849 } 850 851 set newurl "${viewpage}${delim}uid=[lindex $newmail 1]" 852 } else { 853 set newurl [lindex $newmail 1] 854 } 855 856 set newicon "postmark" 857 set newtext [cgi_quote_html [WPCmd PEMailbox newmailstatmsg]] 858 859 if {[WPCmd PEInfo feature enable-newmail-sound]} { 860 #set audio sounds/mail_msg.wav 861 set audio /sounds/ding.wav 862 if {[isIE]} { 863 set newsound "<bgsound src=\"$audio\" loop=\"1\" volume=\"100\">" 864 } else { 865 set newsound "<embed src=\"$audio\" autostart=\"true\" hidden width=0 height=0 loop=\"false\"><noembed><bgsound src=\"$audio\" loop=\"1\"></noembed>" 866 } 867 } else { 868 set newsound {} 869 } 870 871 if {0 == [string length $newtext]} { 872 set newtext "You have $msgsnew new message[WPplural $msgsnew]" 873 } 874 875 lappend newref [list $newtext $newicon $newurl $newsound] 876 } 877 878 if {[set deleted [lindex $newmail 2]] > 0} { 879 set newtext "$deleted Message[WPplural $deleted] removed from folder" 880 lappend newref [list $newtext "" ""] 881 } 882 883 foreach statmsg [WPStatusMsgs] { 884 lappend newref [list $statmsg "" ""] 885 WPCmd PEInfo statmsg "" 886 } 887 888 if {!$reload} { 889 WPCmd PEMailbox newmailreset 890 } 891 892 return $newref 893} 894 895proc WPStatusMsgs {} { 896 set retmsgs "" 897 set lastmsg "" 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." 903 } else { 904 lappend retmsgs $statmsg 905 } 906 907 set lastmsg $statmsg 908 } 909 } 910 } 911 912 return $retmsgs 913} 914 915proc WPStatusIcon {uid {extension gif} {statbits ""}} { 916 global _wp 917 918 if {[string length $statbits] == 0} { 919 set statbits [WPCmd PEMessage $uid statusbits] 920 } 921 922 if {[string index $statbits 0]} { 923 append sicon "new" 924 set alt " N" 925 set fullalt "New " 926 } else { 927 append sicon "read" 928 set alt " " 929 set fullalt "Viewed " 930 } 931 932 if {[string index $statbits 3]} { 933 append sicon "imp" 934 set alt "*[string range $alt 1 end]" 935 set fullaltend ", important message" 936 } elseif {([string index $statbits 4] || [string index $statbits 5])} { 937 append sicon "you" 938 set alt "+[string range $alt 1 end]" 939 set fullaltend " message to you" 940 } 941 942 if {[string index $statbits 2]} { 943 append sicon "ans" 944 set alt "[string range $alt 0 0]A" 945 append fullalt ", answered" 946 } 947 948 if {[string index $statbits 1]} { 949 append sicon "del" 950 set alt "[string range $alt 0 0]D" 951 append fullalt ", deleted" 952 } 953 954 if {[info exists fullaltend]} { 955 append fullalt $fullaltend 956 } else { 957 append fullalt message 958 } 959 960 regsub -all { } $alt {\ } alt 961 962 return [list [file join $_wp(imagepath) $_wp(staticondir) ${sicon}.${extension}] i_${uid} $alt $fullalt] 963} 964 965proc WPStatusLabel {uid} { 966 global _wp 967 968 set statbits [WPCmd PEMessage $uid statusbits] 969 970 if {[string index $statbits 0]} { 971 set sl new 972 } else { 973 set sl read 974 } 975 976 if {[string index $statbits 3]} { 977 set sl important 978 } 979 980 if {[string index $statbits 1]} { 981 set sl deleted 982 } 983 984 if {[string index $statbits 2]} { 985 set sl answered 986 } 987 988 return $sl 989} 990 991proc 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]] 994} 995 996proc WPSessionState {args} { 997 switch [llength $args] { 998 1 - 999 2 { 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]) 1004 } else { 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" 1009 } 1010 } 1011 } else { 1012 error "Can't read session state" 1013 } 1014 } 1015 default { 1016 error "Unknown SessionState Parameters: $args" 1017 } 1018 } 1019} 1020 1021proc 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} 1026 } else { 1027 array set versions $sv 1028 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} 1033 } elseif {$inc} { 1034 incr versions($tag) $inc 1035 set sv [array get versions] 1036 catch {WPCmd set wp_script_version $sv} 1037 } 1038 } 1039 1040 return $versions($tag) 1041} 1042 1043proc WPplural {count} { 1044 if {$count > 1} { 1045 return "s" 1046 } 1047 1048 return "" 1049} 1050 1051proc WPcomma {number {dot ,}} { 1052 set x "" 1053 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]] 1057 } 1058 1059 return "$number$x" 1060} 1061 1062proc isIE {} { 1063 global env 1064 1065 return [expr {[info exists env(HTTP_USER_AGENT)] == 1 && [string first MSIE $env(HTTP_USER_AGENT)] >= 0}] 1066} 1067 1068proc isW3C {} { 1069 global env 1070 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))}] 1072} 1073 1074proc WPdebug {args} { 1075 global _wp 1076 1077 switch [lindex $args 0] { 1078 level { 1079 if {[regexp {^([0-9])+$} [lindex $args 1]]} { 1080 WPSend $_wp(sockname) [subst {PEDebug level [lindex $args 1]}] 1081 } 1082 } 1083 imap { 1084 switch [lindex $args 1] { 1085 on { 1086 WPSend $_wp(sockname) [subst {ePEDebug imap 4}] 1087 } 1088 off { 1089 WPSend $_wp(sockname) [subst {PEDebug imap 0}] 1090 } 1091 } 1092 } 1093 default { 1094 WPSend $_wp(sockname) "PEDebug write [list [list [file tail [info script]]: [lrange $args 0 end]]]" 1095 } 1096 } 1097} 1098 1099proc WPdebugstack {} { 1100 set stack {} 1101 1102 for {set n [expr {[info level] - 1}]} {$n > 0} {incr n -1} { 1103 append stack "$n) [info level $n]\n" 1104 } 1105 return $stack 1106} 1107 1108 1109############################################################## 1110# routines to improve integration with cgi.tcl 1111############################################################## 1112 1113# routine exposing some of cgi.tcl's innards. 1114# Should be exported by cgi.tcl package. 1115proc reset_cgi_state {} { 1116 global _cgi 1117 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)} 1130 1131 if {[info exists _cgi(returnIndex)]} { 1132 while {[set _cgi(returnIndex)] > 0} { 1133 incr _cgi(returnIndex) -1 1134 rename cgi_puts "" 1135 rename cgi_puts$_cgi(returnIndex) cgi_puts 1136 } 1137 } 1138} 1139 1140############################################################### 1141# routines to process (and be called in) html template files 1142############################################################### 1143 1144proc html_readfile {file} { 1145 set x [open $file "r"] 1146 set result [read $x] 1147 close $x 1148 return $result 1149} 1150 1151proc html_eval {_vars_ _this_} { 1152 foreach {_i_ _j_} $_vars_ { 1153 if {$_i_ == "global"} {global $_j_} {set $_i_ $_j_} 1154 } 1155 unset _vars_ _i_ _j_ 1156 return [subst $_this_] 1157} 1158 1159proc html_loop {varslist text} { 1160 set result "" 1161 foreach {vars} $varslist { 1162 append result [html_eval $vars $text] 1163 } 1164 return $result 1165} 1166
