#!/usr/bin/tclsh8.6
# -*- tcl -*-
# Tcl HTTPD
#
# This is the main script for an HTTP server. 
# To test out of the box, do
# tclsh httpd.tcl -debug 1
# or
# wish httpd.tcl -debug 1
#
# For a quick spin, just pass the appropriate settings via the command line.
# For fully custom operation, see the notes in README_custom.
#
# A note about the code structure:
# httpd.tcl	This file, which is the main startup script.  It does
#		command line processing, sets up the auto_path, and
#		loads tclhttpd.rc and httpdthread.tcl.  This file also opens
#		the server listening sockets and does setuid, if possible.
# tclhttpd.rc	This has configuration settings like port and host.
#		It is sourced one time by the server during start up
#		before command line arguments are processed.
# httpdthread.tcl	This has the bulk of the initialization code.  It is
#		split out into its own file because it is loaded by
#		by each thread: the main thread and any worker threads
#		created by the "-threads N" command line argument.
#
# TclHttpd now requires Tcl 8.0 or higher because it depends on some
#	modules in the Standard Tcl Library (tcllib) that use namespaces.
#	In practice, some of the modules in tcllib may depend on
#	new string commands introduced in Tcl 8.2 and 8.3.  However,
#	the server core only depends on the base64 and ncgi packages
#	that may/should be/are compatible with Tcl 8.0
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Scriptics Corporation
# Copyright (c) 2001-2002 Panasas
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: httpd.tcl,v 1.55 2004/05/19 05:44:28 welch Exp $
#
# Adopted to Alt Linux by Sergey Bolshakov <sbolshakov@altlinux.ru>

set Config(lib) /usr/share/tcl

# Search around for the Standard Tcl Library
# We used to require "tcllib", but that now causes complaints
# Tcllib 1.6 has inconsistencies with md5 1.4.3 and 2.0.0,
# and requiring 1.0 cures later conflicts with 2.0

if {[catch {package require ncgi}]} {
    error "Cannot find Standard Tcl Library in auto_path:\n[join $auto_path \n]"
}

##############
# Config file
##############

# Load the configuration file into the Config array
# First, we preload a couple of defaults

set Config(home) /etc/tclhttpd
set Config(library) /usr/share/site-tclhttpd
set Config(debug) 0
set Config(compat) 0

# The configuration bootstrap goes like this:
# 1) Look on the command line for a -config rcfile name argument
# 2) Load this configuration file via the config module
# 3) Process the rest of the command line arguments so the user
#       can override the settings in the rc file with them.

set ix [lsearch $argv -config]
if {$ix >= 0} {
    incr ix
    set Config(config) [lindex $argv $ix]
} else {
    set Config(config) [file join $Config(home) config]
}

package require httpd 1.6
package require httpd::version		;# For Version proc
package require httpd::utils		;# For Stderr
package require httpd::counter		;# For Count

package require httpd::config		;# for config::init
config::init $Config(config) Config

if {[file isdirectory $Config(config).d]} {
    foreach cf [glob -nocomplain -type f $Config(config).d/*] {
	if {[string match *.rpm* $cf]} continue
	config::init $cf Config
    }
}

namespace import config::cget

# The Config array now reflects the info in the configuration file

#########################
# command line arguments
#########################

# Override config file settings with command line arguments.
# The CommandLineOptions global is known to some of the
# web pages that document the server.

package require cmdline
set CommandLineOptions [list \
        [list virtual.arg      [cget virtual]      {Virtual host config list}] \
        [list config.arg       [cget config]       {Configuration File}] \
        [list main.arg         [cget main]         {Per-Thread Tcl script}] \
        [list docRoot.arg      [cget docRoot]      {Root directory for documents}] \
        [list port.arg         [cget port]         {Port number server is to listen on}] \
        [list host.arg         [cget host]         {Server name, should be fully qualified}] \
        [list ipaddr.arg       [cget ipaddr]       {Interface server should bind to}] \
        [list https_port.arg   [cget https_port]   {SSL Port number}] \
        [list https_host.arg   [cget https_host]   {SSL Server name, should be fully qualified}] \
        [list https_ipaddr.arg [cget https_ipaddr] {Interface SSL server should bind to}] \
        [list webmaster.arg    [cget webmaster]    {E-mail address for errors}] \
        [list uid.arg          [cget uid]          {User Id that server runs under}] \
        [list gid.arg          [cget gid]          {Group Id for caching templates}] \
        [list secs.arg         [cget secsPerMinute] {Seconds per "minute" for time-based histograms}] \
        [list threads.arg      [cget threads]      {Number of worker threads (zero for non-threaded)}] \
        [list library.arg      [cget library]      {Directory list where custom packages and auto loads are}] \
        [list debug.arg	       0	        {If true, start interactive command loop}] \
        [list compat.arg       3.3	        {version compatibility to maintain}] \
        [list gui.arg           [cget gui]      {flag for launching the user interface}] \
        [list mail.arg           [cget MailServer]      {Mail Servers for sending email from tclhttpd}] \
    ]

if {[catch {
  array set Config [cmdline::getoptions argv $CommandLineOptions \
    "usage: httpd.tcl options:"]
} err]} {
  Stderr $err
  exit 1
}

if {[string length $Config(library)]} {
    lappend auto_path $Config(library)
}

if {$Config(debug)} {
    puts stderr "auto_path:\n[join $auto_path \n]"
    if {[catch {package require httpd::stdin}]} {
	puts "No command loop available"
	set Config(debug) 0
    }
}

if {$Config(compat)} {
    if {[catch {package require httpd::compat}]} {
	puts stderr "tclhttpd$Config(compat) compatibility mode failed."
    } else {
	# Messages here just confuse people
    }
}

###################
# Start the server
###################

Httpd_Init
#Counter_Init $Config(secs)

# Open the listening sockets
Httpd_Server $Config(port) $Config(host) $Config(ipaddr)
append startup "httpd started on port $Config(port)\n"

if {![catch {package require tls}]} {

    # Secure server startup, which depends on the TLS extension.
    # Tls doesn't provide good error messages in these cases,
    # so we check ourselves that we have the right certificates in place.

    if {[catch {
	if {![file exists [cget SSL_CADIR]] && ![file exists [cget SSL_CAFILE]]} {
	    return -code error "No CA directory \"[cget SSL_CADIR]\" nor a CA file \"[cget SSL_CAFILE]\""
	}
	if {![file exists [cget SSL_CERTFILE]]} {
	    return -code error "Certificate  \"[cget SSL_CERTFILE]\" not found"
	}

	tls::init -request [cget SSL_REQUEST] \
		-require [cget SSL_REQUIRE] \
		-ssl2 [cget USE_SSL2] \
		-ssl3 [cget USE_SSL3] \
		-tls1 [cget USE_TLS1] \
		-cipher [cget SSL_CIPHERS] \
		-cadir [cget SSL_CADIR] \
		-cafile [cget SSL_CAFILE] \
		-certfile [cget SSL_CERTFILE] \
		-keyfile [cget SSL_KEYFILE]

	Httpd_SecureServer $Config(https_port) $Config(https_host) $Config(https_ipaddr)
	append startup "secure httpd started on SSL port $Config(https_port)\n"
    } err]} {
	append startup "SSL startup failed: $err"
    }
}

# Try to increase file descriptor limits

if [catch {
    package require limit
    set Config(limit) [cget MaxFileDescriptors]
    limit $Config(limit)
} err] {
    Stderr $err
    set Config(limit) default
}
Stderr "Running with $Config(limit) file descriptor limit"

# Try to change UID to tclhttpd so we can write template caches

# Try to get TclX, if present
catch {package require Tclx}	;# From dynamically linked DLL
catch {package require setuid}	;# TclHttpd extension

if {"[info command id]" == "id"} {

    # Emulate TclHttpd C extension with TclX commands
    # Setting the group before setting the user is necessary.

    proc setuid {uid gid} {
	id groupid $gid
	id userid $uid
    }
}
if ![catch {
    setuid $Config(uid) $Config(gid)
}] {
    Stderr "Running as user $Config(uid) group $Config(gid)"
}

# Initialize worker thread pool, if requested

if {$Config(threads) > 0} {
    package require Thread		;# C extension
    package require httpd::threadmgr		;# Tcl layer on top
    Stderr "Threads enabled"
    Thread_Init $Config(threads)
} else {
    # Stub out Thread_Respond so threadmgr isn't required
    proc Thread_Respond {args} {return 0}
    proc Thread_Enabled {} {return 0}
}

##################################
# Main application initialization
##################################

foreach {hostNames file} $Config(virtual) {
    Httpd_VirtualHosts $hostNames $file
}

if {[catch {source $Config(main)} message]} then {
    global errorInfo
    set error "Error processing main startup script \"[file nativename $Config(main)]\"."
    append error "\n$errorInfo"
    error $error
}

# The main thread owns the log

Log_CompressProg	[cget CompressProg]
Log_SetFile		[cget LogFile]$Config(port)_
Log_FlushMinutes	[cget LogFlushMinutes]
Log_Flush

# Start up the user interface and event loop.

if {[info exists tk_version] && $Config(gui)} {
    package require httpd::srvui
    SrvUI_Init "Tcl HTTPD $Httpd(version)"
}
Stderr $startup
if {$Config(debug)} {
    if {[info commands "console"] == "console"} {
	console show
    } else {
	Stdin_Start "httpd % "
	Httpd_Shutdown
    }
} else {
    vwait forever
}
