path: root/web/config/alpine.tcl

# Web Alpine Config options
# $Id: alpine.tcl 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $
# ========================================================================
# Copyright 2006-2008 University of Washington
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# ========================================================================

encoding system "utf-8"

set _wp(appname)	Alpine
set _wp(admin)		admin@sample-domain.edu
set _wp(helpdesk)	admin@sample-domain.edu
set _wp(comments)	help@sample-domain.edu

# List of userid's allowed to request the monitor script output
set _wp(monitors)	{}

# directory prefix web server uses for web alpine page requests
# Note: set to {} if DocumentRoot set to the root of web alpine cgi scripts
set _wp(urlprefix)	webmail

# file system path to CGI application files
# directory containing web alpine application scripts and supporting tools
# The htdocs/ directory is located at /srv/www/htdocs. Here we copy the
# web directory to /srv/www/Webalpine/web using "tar cf" followed by
# "tar xf" which preserves symbolic links
# Original configuration:
#set _wp(fileroot)	/usr/local/libexec/alpine
set _wp(fileroot)	/srv/www/Webalpine/web


set _wp(tmpdir)		/tmp

# NOTE: Make SURE tclsh and alpine.tcl symlinks in this directory
set _wp(cgipath)	[file join $_wp(fileroot) cgi]

# CGI scripts implementing U/I, session cookie scope
set _wp(appdir)		alpine

# UI versions
set _wp(ui1dir)		1.0
set _wp(ui2dir)		2.0

# place for CGI scripts not requiring session-key
set _wp(pubdir)		pub

# place for binaries referenced by the CGI scripts
set _wp(bin)		[file join $_wp(fileroot) bin]
set _wp(servlet)	alpined
set _wp(pc_servlet)	pc_alpined
set _wp(pldap)          alpineldap

# place for config files referenced by the CGI scripts
set _wp(confdir)	[file join $_wp(fileroot) config]
set _wp(conffile)	pine.conf
set _wp(defconf)	$_wp(conffile)

# place for library files used by CGI scripts
set _wp(lib)		[file join $_wp(fileroot) lib]

# directory used temporarily to stage attatched and detached files
# this directory is owned by wwwrun:www
set _wp(detachpath)	[file join $_wp(fileroot) detach]

set _wp(imagepath)	[file join / $_wp(urlprefix) images]

set _wp(buttonpath)	[file join $_wp(imagepath) buttons silver]

set _wp(staticondir)	env

set _wp(servername)	[info hostname]

# MUST specify SSL/TLS connection
set _wp(serverport)	{}
set _wp(serverpath)	https://[file join [join [eval list $_wp(servername) $_wp(serverport)] :] $_wp(urlprefix)]

# MAY specify a plaintext connection (comment out if plain support undesired)
set _wp(plainport)	{}
set _wp(plainservpath)	http://[file join [join [eval list $_wp(servername) $_wp(plainport)] :] $_wp(urlprefix)]

# url of faq page(s) available from initial greeting page
#set _wp(faq)		"http://www.yourserver/faqs/alpine.html"

# url of informational page accessible from initial greeting page
set _wp(releaseblurb)	"$_wp(plainservpath)/alpine/help/release.html"

# url of previous version server to be accessible from initial greeting page
#set _wp(oldserverpath)	"https://previous.version.server.edu:444/"

# session id length: make sure the integer count below matches what's built
# into the pubcookie: "src/pubcookie/wp_uidmapper_lib.h:#define WP_KEY_LEN 6"
set _wp(sessidlen)	6

# Where and what format the alpined comm socket should take
set _wp(sockdir)	$_wp(tmpdir)
set _wp(sockpat)	wp%s

# skin settings
set _wp(bordercolor)	#FEFAC9
set _wp(menucolor)	#3E2E6D
set _wp(dialogcolor)	#FEFAC9
set _wp(titlecolor)	#000000
set _wp(logodir)	alpine

# various timerouts, dimensions and feature settings
set _wp(refresh)	600
set _wp(timeout)	900
set _wp(autodraft)	300
set _wp(logoutpause)	60
set _wp(indexlines)	20
set _wp(indexlinesmax)	50
set _wp(indexheight)	24
set _wp(navheight)	28
set _wp(width)		80
set _wp(titleheight)	34
set _wp(titlesep)	4
set _wp(config)		remote_pinerc
set _wp(motd)		motd
set _wp(save_cache_max)	6
set _wp(fldr_cache_max)	20
set _wp(fldr_cache_def)	3
set _wp(statushelp)	0
set _wp(imgbuttons)	0
set _wp(keybindings)	1
set _wp(dictionary)	0
set _wp(debug)		0
set _wp(cmdtime)	0
set _wp(evaltime)	0
set _wp(menuargs)	{width="112" nowrap valign=top}
set _wp(ispell)		/usr/local/bin/ispell

# Yahoo! User Interface Library location
set _wp(yui)		$_wp(serverpath)/$_wp(appdir)/$_wp(ui2dir)/lib/yui
#set _wp(yui)		"http://yui.yahooapis.com/2.7.0"

# usage reporter - input: username as first command line argument
#                  output: space separated integers usage and total
#set _wp(usage)		$_wp(bin)/usage.tcl
#set _wp(usage_link)	"https://uwnetid.washington.edu/disk/"

# limit uploads to 1 file at a time, maximum 20MB.
set _wp(uplim_files)	1
set _wp(uplim_bytes)	20000000

# verify sessid from consistent REMOTE_ADDR (set to 0 for proxying clusters)
set _wp(hostcheck)	0

# set to list of domains for which ssl is NOT required
#set _wp(ssl_safe_domains)	{}

# set to list of address blocks or ranges for which ssl is NOT required
#set _wp(ssl_safe_addrs)		{}

# set this value to zero to turn OFF ssl by default
set _wp(ssl_default)	1

# allow connecting user to specify imap server on greeting page
set	_wp(flexserver)	1

# make sure tmp files and such are ours alone to read/write
catch {exec umask 044}

#fix up indexheight so it isn't too high or too low
set _wp(indexheight) [expr {$_wp(indexheight) <= 20 ? 20 : $_wp(indexheight) >= 30 ? 30 : $_wp(indexheight)}]

# SPAM reporting facility, if set "Report Spam" button appears at top of View Page
#set _wp(spamaddr)	spamaddr@sample-domain.edu
#set _wp(spamfolder)	junk-mail
#set _wp(spamsubj)	"ATTACHED SPAM"

# external mail filter config link
#set _wp(filter_link)	http://delivery-filter.sample-domain.edu/filter/config

# external vacation config link
#set _wp(vacation_link)	http://vacation.sample-domain.edu/vacation/config

#
# Nickname server bindings.  If not present, prompt for the
# destination of the default pinerc location.
#
set _wp(hosts) {
    {
      Gmail
      imap.gmail.com/ssl
      $_wp(confdir)/gmail.conf
    }
    {
      GMX
      imap.gmx.com/ssl
      $_wp(confdir)/gmx.conf
    }
    {
      Deskmail
      $User.deskmail.washington.edu/ssl
      $_wp(confdir)/conf.deskmail
    }
}

# Everybody inherits the cgi, comm packages
lappend auto_path $_wp(lib)

package require cgi
package require WPComm

# Recipient of bad news bubbling up from cgi.tcl...
cgi_admin_mail_addr $_wp(admin)

cgi_sendmail {}

#cgi_mail_relay localhost
cgi_mail_relay smtpserver.sample-domain.edu

# set permissions for owner-only handling
cgi_tmpfile_permissions 0640

#set upload limits
cgi_file_limit $_wp(uplim_files) $_wp(uplim_bytes)

# universal body tag parameters
cgi_body_args link=#0000FF vlink=#000080 alink=#FF0000 marginwidth=0 marginheight=0 topmargin=0 leftmargin=0

# Common Images Image definitions
cgi_imglink logo		[file join $_wp(imagepath) logo $_wp(logodir) big.gif]	border=0	"alt=Web Alpine"
cgi_imglink smalllogo		[file join $_wp(imagepath) logo $_wp(logodir) small.gif]	border=0	"alt=About Web Alpine"
cgi_imglink background		[file join $_wp(imagepath) logo $_wp(logodir) back.gif]		border=0	align=top
cgi_imglink dot			[file join $_wp(imagepath) dot2.gif]		border=0	align=top
cgi_imglink increas		[file join $_wp(imagepath) increas4.gif]	border=0	align=absmiddle
cgi_imglink decreas		[file join $_wp(imagepath) decreas4.gif]	border=0	align=absmiddle
cgi_imglink expand		[file join $_wp(imagepath) b_plus.gif]	border=0	"alt=Expand"	height=9 width=9
cgi_imglink contract		[file join $_wp(imagepath) b_minus.gif]	border=0	"alt=Collapse"	height=9 width=9
cgi_imglink fullhdr		[file join $_wp(imagepath) hdr.gif]		border=0	"alt=Full Header"
cgi_imglink nofullhdr		[file join $_wp(imagepath) hdrnon.gif]	border=0	"alt=Digested Header"
cgi_imglink bang		[file join $_wp(imagepath) caution.gif]	border=0	"alt=!"
cgi_imglink postmark		[file join $_wp(imagepath) postmark.gif]	border=0	"alt=New Mail"
cgi_imglink gtab		[file join $_wp(imagepath) tabs gtab.gif]	border=0	align=top
cgi_imglink gdtab		[file join $_wp(imagepath) tabs gdtab.gif]	border=0	align=top
cgi_imglink abtab		[file join $_wp(imagepath) tabs abtab.gif]	border=0	align=top
cgi_imglink abdtab		[file join $_wp(imagepath) tabs abdtab.gif]	border=0	align=top
cgi_imglink ctab		[file join $_wp(imagepath) tabs ctab.gif]	border=0	align=top
cgi_imglink cdtab		[file join $_wp(imagepath) tabs cdtab.gif]	border=0	align=top
cgi_imglink ftab		[file join $_wp(imagepath) tabs ftab.gif]	border=0	align=top
cgi_imglink fdtab		[file join $_wp(imagepath) tabs fdtab.gif]	border=0	align=top
cgi_imglink mltab		[file join $_wp(imagepath) tabs mltab.gif]	border=0	align=top
cgi_imglink mldtab		[file join $_wp(imagepath) tabs mldtab.gif]	border=0	align=top
cgi_imglink mvtab		[file join $_wp(imagepath) tabs mvtab.gif]	border=0	align=top
cgi_imglink mvdtab		[file join $_wp(imagepath) tabs mvdtab.gif]	border=0	align=top
cgi_imglink rtab		[file join $_wp(imagepath) tabs rtab.gif]	border=0	align=top
cgi_imglink rdtab		[file join $_wp(imagepath) tabs rdtab.gif]	border=0	align=top


# Link definitions
cgi_link Admin "Web Alpine Administrator" "mailto:$_wp(admin)"
cgi_link Start "Web Alpine Home Page" "$_wp(serverpath)/session/greeting.tcl" target=_top

# Internally referenced CGI directory root
cgi_root $_wp(serverpath)
cgi_suffix .tcl

# have cgi.tcl convert eols in muiltipart/form-data
set _cgi(no_binary_upload) 1

proc WPSocketName {sessid} {
  global _wp

  return [file join $_wp(sockdir) [format $_wp(sockpat) $sessid]]
}

proc WPValidId {{sessid {}}} {
    global _wp env

    if {[string length $sessid] == 0} {
      set created 1

      # Session Handle: a bit reasonably random number.  the format
      # is convenient for pubcookie auth'd support
      set rnum {}
      set rsrc /dev/urandom
      set idbytelength [expr {$_wp(sessidlen) * 4}]
      if {[file readable $rsrc] && [catch {open $rsrc r} fp] == 0} {
	while {1} {
	  for {set i 0} {$i < $idbytelength} {incr i} {
	    if {$i && ($i % 4) == 0} {
	      append rnum "."
	    }

	    if {[catch {read $fp 1} n] == 0} {
	      binary scan $n c x
	      set x [expr ($x & 0xff)]
	      append rnum [format {%02x} $x]
	    } else {
	      set rnum {}
	      break
	    }
	  }

	  if {[file exists [WPSocketName $rnum]]} {
	    set rnum {}
	  } else {
	    break
	  }
	}

	close $fp
      }

      # second choice for random numbers
      if {[string length $rnum] == 0} {
	expr srand([clock seconds])
	for {set i 0} {$i < $idbytelength} {incr i 4} {
	  if {$i && ($i % 4) == 0} {
	    append rnum "."
	  }

	  append rnum [format {%08x} [expr int((100000000 * rand()))]]
	}
      }

      # generate a session ID
      set _wp(sessid) $rnum
    } else {
      set sessidparts [split $sessid {@}]
      switch [llength $sessidparts] {
	1 {
	  set _wp(sessid) $sessid
	}
	2 {
	  if {[string compare [string tolower [lindex $sessidparts 1]] [string tolower [info hostname]]]} {
	    regexp {^([a-zA-Z]*://).*} [cgi_root] match proto
	    error [list redirect "${proto}[lindex $sessidparts 1]:$env(SERVER_PORT)?$env(QUERY_STRING)"]
	  } else {
	    set _wp(sessid) [lindex $sessidparts 0]
	  }
	}
	default {
	  error "Malformed Session ID: $sessid"
	}
      }
    }

    set _wp(sockname) [WPSocketName $_wp(sessid)]

    if {[info exists _wp(cumulative)]} {
      rename WPCmd WPCmd.orig
      rename WPCmdTimed WPCmd
    }

    if {[info exists _wp(hostcheck)] && $_wp(hostcheck) == 1 && ![info exists created]
	&& [catch {WPCmd set wp_client} client] == 0
	&& (([info exists env(REMOTE_ADDR)] && [string length $env(REMOTE_ADDR)] && [string compare $client $env(REMOTE_ADDR)])
	    || ([info exists env(REMOTE_HOST)] && [string length $env(REMOTE_HOST)] && [string compare $client $env(REMOTE_HOST)]))} {
      error "Request from unrecognized client"
    }
}

proc WPAbort {} {
    WPCleanup
    cgi_exit
}

proc WPCleanup {} {
    global _wp

    if {[info exists _wp(cleanup)]} {
	foreach item $_wp(cleanup) {
	    catch {eval $item}
	}
    }
}

proc WPEval {vars cmd} {
    global _wp

    if {$_wp(cmdtime) || $_wp(evaltime)} {
	set _wp(cumulative) 0
    }

    set _wp(cmd) $cmd
    set _wp(vars) [linsert $vars 0 [list sessid "Missing Session ID"]]

    uplevel 1 {
      cgi_eval {
	if {$_wp(debug) > 1} {
	    cgi_debug -on
	}

	# Session id?
	if {[catch {WPGetInputAndID sessid}]} {
	  return
	}

	foreach item $_wp(vars) {
	  if {[catch {eval WPImport $item} errstr]} {
	    WPInfoPage "Web Alpine Error" [font size=+2 $errstr] "Please close this window."
	    return
	  }
	}

	# evaluate the given script
	if {[catch {cgi_buffer $_wp(cmd)} result]} {

	    reset_cgi_state

	    if {[string index $result 0] == "_"} {
	      switch -- [lindex $result 0] {
		_info {
		  WPInfoPage [lindex $result 1] [font size=+2 [lindex $result 2]] [lindex $result 3]
		}
		_action {
		  switch -regexp -- [lindex $result 2] {
		    "[Ii]nactive [Ss]ession" {
		      WPInactivePage
		    }
		    default {
		      if {[string length [lindex $result 3]]} {
			set remedy [lindex $result 3]
		      } else {
			set remedy "   Click your browser's Back button to return to previous page."
		      }
		      WPInfoPage "[lindex $result 1] Error" [font size=+2 [lindex $result 2]] \
			  "Please report this to the [cgi_link Admin].$remedy"
		    }
		  }
		}
		_redirect {
		  cgi_http_head {
		    cgi_redirect [lindex $result 1]
		  }

		  cgi_html { cgi_body {} }
		}
		_close {
		  if {[string length [lindex $result 1]] == 0} {
		    set result "Indeterminate error"
		  }

		  WPInfoPage "Web Alpine Error" [font size=+2 [lindex $result 1]] "Please close this window."
		}
		default {
		  if {[string length $result]} {
		    WPInfoPage "Web Alpine Error" [font size=+2 "Eval Error: $result"] \
			"Please complain to the [cgi_link Admin].   Click Back button to return to previous page."
		  } else {
		    WPInfoPage "Web Alpine Error" [font size=+2 "Indeterminate error response"] \
			"Please complain to the [cgi_link Admin] and click Back button to return to previous page."
		  }
		}
	      }
	    } else {
	      if {[regexp {[Ii]nactive [Ss]ession} $result]} {
		WPInactivePage
	      } else {
		WPInfoPage "Web Alpine Error" [font size=+2 "Error: $result"] \
		    "Please report this to the [cgi_link Admin]. Try clicking your browser's Back button to return to a working page."
	      }
	    }
	} else {
	    catch {cgi_puts $result}
	}
    }
  }

    # cleanup here
    WPCleanup

    if {[info exists _wp(cumulative)]} {
      WPdebug "Cumulative Eval: $_wp(cumulative)"
      unset _wp(cumulative)
    }
}

proc WPGetInputAndID {_sessid} {
  global _wp
  upvar $_sessid sessid

  # Import data and validate it
  if {[catch {cgi_input "sessid=8543949466398&"} result]} {
    WPInfoPage "Web Alpine Error" [font size=+2 $result] "Please close this window."
    error "Cannot get CGI Input"
  }

  if {[catch {WPImport sessid "Missing Session ID"} errstr]} {
    if {[regexp {.*sessid.*no such.*} $errstr]} {
      WPInactivePage [list "Your browser may have failed to send the necessary <i>cookie</i> information.  Please verify your browser configuration has cookies enabled."]
    } else {
      WPInfoPage "Web Alpine Error" [font size=+2 $errstr] "Please close this window."
    }

    error "Session ID Failure"
  } else {
    # initialization here
    if {[catch {WPValidId $sessid} result]} {
      if {[string compare [lindex $result 0] redirect]} {
	WPInfoPage "Web Alpine Error" [font size=+2 "$result"] \
	    "Please complain to the [cgi_link Admin] and visit the [cgi_link Start] later."
      } else {
	cgi_http_head {
	  cgi_redirect [lindex $result 1]
	}
      }

      error "Unrecoverable Error"
    } elseif {$_wp(sessid) == 0} {
      WPInactivePage
      error "Inactive Session"
    }

    if {[catch {WPCmd set serverroot} serverroot] == 0} {
      cgi_root $serverroot
    }
  }
}

proc WPCmdEval {args} {
  return [eval $args]
}

proc WPCmd {args} {
  global _wp

  return [WPSend $_wp(sockname) $args]
}

proc WPCmdTimed {args} {
  global _wp

  set t [lindex [time {set r [WPSend $_wp(sockname) $args]}] 0]
  incr _wp(cumulative) $t

  if {$_wp(cmdtime)} {
    WPdebug "time $t : $args"
  }

  return $r
}

proc WPLoadCGIVar {_var} {
  upvar $_var var

  if {[catch {cgi_import_as $_var var} result]
      && [catch {WPCmd set $_var} var]
      && [catch {cgi_import_cookie_as $_var var} result]} {
    error [list _action "Import Cookie $_var" $result]
  }
}

proc WPLoadCGIVarAs {_var _varas} {
    upvar $_varas varas

  if {[catch {cgi_import_as $_var varas} result]
      && [catch {WPCmd set $_var} varas]
      && [catch {cgi_import_cookie_as $_var varas} result]} {
    set varas ""
  }
}

proc WPImport {valname {errstring ""} {default 0}} {
    upvar $valname val

    if {[catch {cgi_import_as $valname val} result]} {
      if {[catch {WPCmd set $valname} val]} {
	if {[catch {cgi_import_cookie_as $valname val} result]} {
	  if {[string length $errstring] > 0} {
	    error "$errstring: $result"
	  } else {
	    set val $default
	  }
	}
      }
    }
}


proc WPExportCookie {name value {scope ""}} {
    global _wp

    cgi_cookie_set $name=$value "path=[file join / $_wp(urlprefix) $scope]"
}


# handle dynamic sizing of images showing thread relationships 
proc WPThreadImageLink {t h} {
    global _wp

    return "<img src=\"[file join $_wp(imagepath) ${t}.gif]\" border=0 align=top height=${h} width=14>"
}


proc WPInactivePage {{reasons ""}} {
  set l {}
  foreach r $reasons {
    append l "<li>$r"
  }

  WPInfoPage "Inactive Session" \
	"[font size=+2 "Web Alpine Session No Longer Active"]" \
      "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."
}

proc WPInfoPage {title exp1 {exp2 ""} {imgurl {}} {exp3 ""}} {
  global _wp

  catch {

    cgi_html {
      cgi_head {
	cgi_title $title
	cgi_stylesheet [file join / $_wp(urlprefix) $_wp(pubdir) standard.css]
      }

      cgi_body {
	cgi_table height="20%" {
	  cgi_table_row {
	    cgi_table_data {
	      cgi_puts [cgi_nbspace]
	    }
	  }
	}

	cgi_center {
	  cgi_table border=0 width=500 cellpadding=3 {
	    cgi_table_row {
	      cgi_table_data align=center rowspan=3 {
		if {[string length $imgurl]} {
		  cgi_put [cgi_url [cgi_imglink logo] $imgurl]
		} else {
		  cgi_put [cgi_imglink logo]
		}
	      }

	      cgi_table_data rowspan=3 {
		cgi_put [nbspace]
		cgi_put [nbspace]
	      }

	      cgi_table_data {
		cgi_puts $exp1
	      }

	    }

	    if {[string length $exp3]} {
	      cgi_table_row {
		cgi_table_data "style=\"border: 1px solid red; background-color: pink\"" {
		  cgi_puts $exp3
		}
	      }
	    }

	    if {[string length $exp2]} {
	      cgi_table_row {
		cgi_table_data {
		  cgi_puts $exp2
		}
	      }
	    }
	  }
	}
      }
    }
  }
}

proc WPimg {image {extension gif}} {
    global _wp

    return [file join $_wp(imagepath) ${image}.${extension}]
}

proc WPCharValue {c} {
  scan "$c" %c n
  return $n
}

proc WPPercentQuote {arg {exclude {}}} {
  set t "\[^0-9a-zA-Z_${exclude}\]"
  if {[regsub -all $t $arg {[format "%%%.2X" [WPCharValue "\\&"]]} subarg]} {
    set x [subst $subarg]
    return $x
  } else {
    return $arg
  }
}

proc WPJSQuote {l} {
  regsub -all {([\\'])} $l {\\\1} l
  return $l
}

proc WPurl {cmd cmdargs text explanation args} {
    global _wp

    lappend urlargs $text
    lappend urlargs $cmd
    if {[regexp "^java*" $cmd] == 0 && [string first . $cmd] < 0} {
	append urlargs ".tcl"
    }

    if {[string length $cmdargs]} {
	if {[set i [string first "?" $cmdargs]] >= 0} {
	    append urlargs "[cgi_quote_url [string range $cmdargs 0 [expr {$i - 1}]]]?[cgi_quote_url [string range $cmdargs [incr i] end]]"
	} else {
	    append urlargs "?[cgi_quote_url $cmdargs]"
	}
    }

    if {$_wp(statushelp)} {
	lappend urlargs [WPmouseover $explanation]
	lappend urlargs "onMouseOut=window.status=''"
    }

    return [eval "cgi_url $urlargs $args"]
}

proc WPMenuURL {cmd cmdargs text explanation args} {
    return [WPurl $cmd $cmdargs $text $explanation class=menubar [join $args]]
}

proc WPGetTDFontSize {{ih 24}} {
    if {$ih <= 20 } {return 12}
    if {$ih >= 30 } {return 24}
    return [expr {$ih - 8}]
}
  
proc WPGetviewFontSize {{ih 24}} {
    if {$ih <= 20 } {return 8}
    if {$ih >= 30 } {return 13}
    return [expr {($ih / 2) - 2}]
}

proc WPIndexLineHeight {{ih 0}} {
  global _wp

  set ih [WPCmd PEInfo indexheight]
  if {[string length $ih] == 0 ||  $ih <= 0} {
    set ih $_wp(indexheight)
  }

  return [expr {($ih < 20) ? 20 : $ih}]
}

proc WPStyleSheets {{ih 0}} {
  global _wp

  cgi_stylesheet [file join / $_wp(urlprefix) $_wp(pubdir) standard.css]

  if {$ih <= 0} {
    set ih [WPIndexLineHeight]
  }

  cgi_puts "<style type='text/css'>\nTD { font-size: [WPGetTDFontSize $ih]px }\n.view {font-size: [WPGetviewFontSize $ih]pt }\n</style>"
  return $ih
}

proc WPStdScripts {{ih 0}} {
    global _wp

    set ih [WPStyleSheets $ih]

    cgi_script language="JavaScript" src="[file join / $_wp(urlprefix) $_wp(pubdir) standard.js]" {}
    cgi_script language="JavaScript1.3" {cgi_put "js_version = '1.3';"}
    cgi_javascript {
	cgi_puts "function getIndexHeight(){return $ih}"
    }
}

proc WPStdHttpHdrs {{ctype {}} {expires 0}} {
    global _wp

    # set date and expires headers the same to prevent caching
    # Date: Tue, 15 Nov 1994 08:12:31 GMT
    set doctime [clock seconds]

    if {[string length $ctype]} {
      cgi_content_type $ctype
    } else {
      cgi_content_type
    }

    cgi_puts "Date: [clock format $doctime -gmt true -format "%a, %d %b %Y %H:%M:%S GMT"]"
    if {$expires == 0} {
      set _wp(nocache) 1
      cgi_puts "Cache-Control: no-cache"
      cgi_puts "Expires: [clock format [expr {$doctime - 31536000}] -gmt true -format "%a, %d %b %Y %H:%M:%S GMT"]"
    } elseif {$expires > 0} {
      cgi_puts "Expires: [clock format [expr {$doctime + ($expires * 60)}] -gmt true -format "%a, %d %b %Y %H:%M:%S GMT"]"
    }
}

proc WPStdHtmlHdr {pagetitle {pagescript ""} {newmail 0}} {
    global _wp

    if {0 && $newmail} {
      set nm "* "
    } else {
      set nm ""
    }

    cgi_title "${nm}Web Alpine - $pagetitle"
    # cgi_base "href=$_wp(serverpath)/"
    if {[info exists _wp(nocache)]} {
      cgi_http_equiv Pragma no-cache
    }

    # cgi_http_equiv Expires $_wp(docdate)
    cgi_meta "name=Web Alpine" content=[clock format [file mtime [info script]] -format "%y%m%d/%H%M"]
    if {[catch {WPCmd set nojs} nojs] || $nojs != 1} {
      cgi_script  type="text/javascript" language="JavaScript" {
	cgi_puts "if(self != top) top.location.href = location.href;"
	cgi_puts "js_version = '1.0';"
      }
    }

    cgi_put  "<link rel=\"icon\" href=\"[cgi_root]/favicon.ico\" type=\"image/x-icon\">"
    cgi_put  "<link rel=\"shortcut icon\" href=\"[cgi_root]/favicon.ico\" type=\"image/x-icon\"> "
}

proc WPHtmlHdrReload {pagescript} {
  global _wp

  if {[regexp {\?} $pagescript]} {
    set c "&"
  } else {
    set c "?"
  }

  cgi_http_equiv Refresh "$_wp(refresh); url=[cgi_root]/${pagescript}${c}reload=1"
}

proc WPNewMail {reload {viewpage msgview.tcl}} {

    if {[catch {WPCmd PEMailbox newmail $reload} newmail]} {
	return -code error $newmail
    }

    set newref ""

    if {[set msgsnew [lindex $newmail 0]] > 0} {
      if {[string length $viewpage]} {
	if {[string first {?} $viewpage] < 0} {
	  set delim ?
	} else {
	  set delim &
	}

	set newurl "${viewpage}${delim}uid=[lindex $newmail 1]"
      } else {
	set newurl [lindex $newmail 1]
      }

      set newicon "postmark"
      set newtext [cgi_quote_html [WPCmd PEMailbox newmailstatmsg]]

      if {[WPCmd PEInfo feature enable-newmail-sound]} {
        #set audio sounds/mail_msg.wav
	set audio /sounds/ding.wav
	if {[isIE]} {
	  set newsound "<bgsound src=\"$audio\" loop=\"1\" volume=\"100\">"
	} else {
	  set newsound "<embed src=\"$audio\" autostart=\"true\" hidden width=0 height=0 loop=\"false\"><noembed><bgsound src=\"$audio\" loop=\"1\"></noembed>"
	}
      } else {
	set newsound {}
      }

      if {0 == [string length $newtext]} {
	set newtext "You have $msgsnew new message[WPplural $msgsnew]"
      }

      lappend newref [list $newtext $newicon $newurl $newsound]
    }

    if {[set deleted [lindex $newmail 2]] > 0} {
	set newtext "$deleted Message[WPplural $deleted] removed from folder"
	lappend newref [list $newtext "" ""]
    }

    foreach statmsg [WPStatusMsgs] {
      lappend newref [list $statmsg "" ""]
      WPCmd PEInfo statmsg ""
    }

    if {!$reload} {
	WPCmd PEMailbox newmailreset
    }

    return $newref
}

proc WPStatusMsgs {} {
  set retmsgs ""
  set lastmsg ""
  if {[catch {WPCmd PEInfo statmsgs} statmsgs] == 0} {
    foreach statmsg $statmsgs {
      if {[string length $statmsg] > 0 && [string compare $statmsg $lastmsg]} {
	if {[regexp "^Pinerc \(.+\) NOT saved$" $statmsg]} {
	  lappend retmsgs "Another Pine/WebPine session may be running.  Settings cannot be saved."
	} else {
	  lappend retmsgs $statmsg
	}

	set lastmsg $statmsg
      }
    }
  }

  return $retmsgs
}

proc WPStatusIcon {uid {extension gif} {statbits ""}} {
  global _wp

  if {[string length $statbits] == 0} {
    set statbits [WPCmd PEMessage $uid statusbits]
  }

  if {[string index $statbits 0]} {
    append sicon "new"
    set alt " N"
    set fullalt "New "
  } else {
    append sicon "read"
    set alt "  "
    set fullalt "Viewed "
  }

  if {[string index $statbits 3]} {
    append sicon "imp"
    set alt "*[string range $alt 1 end]"
    set fullaltend ", important message"
  } elseif {([string index $statbits 4] || [string index $statbits 5])} {
    append sicon "you"
    set alt "+[string range $alt 1 end]"
    set fullaltend " message to you"
  }

  if {[string index $statbits 2]} {
    append sicon "ans"
    set alt "[string range $alt 0 0]A"
    append fullalt ", answered"
  }

  if {[string index $statbits 1]} {
    append sicon "del"
    set alt "[string range $alt 0 0]D"
    append fullalt ", deleted"
  }

  if {[info exists fullaltend]} {
    append fullalt $fullaltend
  } else {
    append fullalt message
  }

  regsub -all { } $alt {\&nbsp;} alt

  return [list [file join $_wp(imagepath) $_wp(staticondir) ${sicon}.${extension}] i_${uid} $alt $fullalt]
}

proc WPStatusLabel {uid} {
    global _wp

    set statbits [WPCmd PEMessage $uid statusbits]

    if {[string index $statbits 0]} {
      set sl new
    } else {
      set sl read
    }

    if {[string index $statbits 3]} {
      set sl important
    }

    if {[string index $statbits 1]} {
      set sl deleted
    }

    if {[string index $statbits 2]} {
      set sl answered
    }

    return $sl
}

proc WPStatusImg {uid} {
    set sicon [WPStatusIcon $uid]
    return [cgi_img [lindex $sicon 0] name=[lindex $sicon 1] id=[lindex $sicon 1] height=16 width=42 border=0 alt=[lindex $sicon 3]]
}

proc WPSessionState {args} {
  switch [llength $args] {
    1 -
    2 {
      if {[catch {WPCmd PEInfo alpinestate} state_list] == 0} {
	array set state_array $state_list
	if {[llength $args] == 1} {
	  return $state_array([lindex $args 0])
	} else {
	  set state_array([lindex $args 0]) [lindex $args 1]
	  set state_list [array get state_array]
	  if {[catch {WPCmd PEInfo alpinestate $state_list} result]} {
	    error "Can't set session state : $result"
	  }
	}
      } else {
	error "Can't read session state"
      }
    }
    default {
      error "Unknown SessionState Parameters: $args"
    }
  }
}

proc WPScriptVersion {tag {inc 0}} {
  if {[catch {WPCmd set wp_script_version} sv]} {
    set versions($tag) [expr int((1000 * rand()))]
    set sv [array get versions]
    catch {WPCmd set wp_script_version $sv}
  } else {
    array set versions $sv

    if {![info exists versions($tag)]} {
      set versions($tag) [expr int((1000 * rand()))]
      set sv [array get versions]
      catch {WPCmd set wp_script_version $sv}
    } elseif {$inc} {
      incr versions($tag) $inc
      set sv [array get versions]
      catch {WPCmd set wp_script_version $sv}
    }
  }

  return $versions($tag)
}

proc WPplural {count} {
    if {$count > 1} {
	return "s"
    }

    return ""
}

proc WPcomma {number {dot ,}} {
    set x ""

    while {[set n [string length $number]] > 3} {
	set x "${dot}[string range $number [incr n -3] end]$x"
	set number [string range $number 0 [incr n -1]]
    }

    return "$number$x"
}

proc isIE {} {
  global env

  return [expr {[info exists env(HTTP_USER_AGENT)] == 1 && [string first MSIE $env(HTTP_USER_AGENT)] >= 0}]
}

proc isW3C {} {
  global env

  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))}]
}

proc WPdebug {args} {
    global _wp

    switch [lindex $args 0] {
      level {
	if {[regexp {^([0-9])+$} [lindex $args 1]]} {
	  WPSend $_wp(sockname) [subst {PEDebug level [lindex $args 1]}]
	}
      }
      imap {
	switch [lindex $args 1] {
	  on {
	    WPSend $_wp(sockname) [subst {ePEDebug imap 4}]
	  }
	  off {
	    WPSend $_wp(sockname) [subst {PEDebug imap 0}]
	  }
	}
      }
      default {
	WPSend $_wp(sockname) "PEDebug write [list [list [file tail [info script]]: [lrange $args 0 end]]]"
      }
    }
}

proc WPdebugstack {} {
    set stack {}

    for {set n [expr {[info level] - 1}]} {$n > 0} {incr n -1} {
	append stack "$n) [info level $n]\n"
    }
    return $stack
}


##############################################################
# routines to improve integration with cgi.tcl
##############################################################

# routine exposing some of cgi.tcl's innards.
# Should be exported by cgi.tcl package.
proc reset_cgi_state {} {
  global _cgi

  catch {unset _cgi(http_head_in_progress)}
  catch {unset _cgi(http_head_done)}
  catch {unset _cgi(http_status_done)}
  catch {unset _cgi(html_in_progress)}
  catch {unset _cgi(head_in_progress)}
  catch {unset _cgi(head_done)}
  catch {unset _cgi(html_done)}
  catch {unset _cgi(head_suppress_tag)}
  catch {unset _cgi(body_in_progress)}
  catch {unset _cgi(tag_in_progress)}
  catch {unset _cgi(form_in_progress)}
  catch {unset _cgi(close_proc)}

  if {[info exists _cgi(returnIndex)]} {
    while {[set _cgi(returnIndex)] > 0} {
      incr _cgi(returnIndex) -1
      rename cgi_puts ""
      rename cgi_puts$_cgi(returnIndex) cgi_puts
    }
  }
}

###############################################################
# routines to process (and be called in) html template files
###############################################################

proc html_readfile {file} {
    set x [open $file "r"]
    set result [read $x]
    close $x
    return $result
}

proc html_eval {_vars_ _this_} {
    foreach {_i_ _j_} $_vars_ {
	if {$_i_ == "global"} {global $_j_} {set $_i_ $_j_}
    }
    unset _vars_ _i_ _j_
    return [subst $_this_]
}

proc html_loop {varslist text} {
    set result ""
    foreach {vars} $varslist {
	append result [html_eval $vars $text]
    }
    return $result
}