Webserver combined with bwise

by Theo Verelst

I adapted the main tclhttpd script, and the resource file, so that it can be started in combination with bwise, which allows interactive graphs which are driven by and generate pages for a webbrowser, an interesting combination.

First, lets load both applications together, the latest complete bwise at the moment can be gotten here: Bwise version 0.34, all in one file, 8.4 compatible, and you might want to add the latest procedure edit window from interactive command composer or the latest Automatically generate Bwise blocks from procedures page, which comes in handy when making networks with functions.

Now make the files httpd_bwise.tcl and httpd_bwise.rc from the below, checking for some of the things to customize for you setup, such as Docroot, which in my opinion would best be set up as pointing to a directory tree which has nothing but .html and text files in it, and certainly not all the demonstration scripts, especially when you're on the live internet. Some of them can be made vicious easily, no need to encourage the msscript like stuff, from experience thus far the tclhttpd like this can run fine and safe enough.

The Docroot definition in the resource or the httpd file is set up to point to c:/Docroot (I used windows mainly for this) which is where you could make a file index.html which will get read when you point you browser (of any kind or version) to:

   http://localhost:180

or equivalently, supposing you changed the PORT, for instance to take a free linux port (above 3000):

   http://your.machine.name:3000/index.html

or by directly using an IP address, either pointing to the local machine or to an explicit IP address, a local network address or local IP address, in these examples assuming you chose PORT 80, the standard http// port the browser choses by default:

http://127.0.0.1: local machine
http://uu.vv.xx.yy/: the actual IP address of the machine with server
http://192.168.0.1: the local network main machine address with the server
http://machinename.mshome.net: a local MS network machine

When you're testing, you could make a index.html file in the document root directory, with a list of local urls on you server you want to test or use.

Now the main thing we want to use for the example on this page is to generate pages, or what we want, and a convenient way to combine that with webbrowser links or hand typed urls and a bwise block or network is to make use of the Direct_url possibility of tclhttpd.

Lets make a procedure which returns a web page when it is called:

 proc urltest { {args} } {
   return "<html>Test<p>\n$args</html>"
 }

The html tags are needed to format the page right, more header can be generated by the server, this is enough to make a errorless page, which prints Test and then the content of the procedure argument. Calling the proc without arguments returns:

 <html>Test<p>
 </html>

which is a simple well formatted web page with the word Test.

By using the procedure Direct_url, we can tell the webserver to call our urltest procedure every time when a certain page, lets say test is called, and transfer the outcome of the procedure back to the browser which asked for the certain page:

 Direct_Url /test urltest

When we now type in the browser url line something like:

 http://localhost:180/test

our function gets called, and returns its web page, which we can than see.

We could make a file index.html and store it in the directory we set Docroot to in the bwise_httpd.rc file:

 <html>
 <a href="/test">test page</a>
 </html>

To get to our 'virtual' test page.

To refresh the page, the refresh button of the browser (I usually use netscape) should be ok, there are cases when you want to press enter in the url line again.

Now let's include bwise in the page making process, and try a just a little more interesting page. We make two blocks first to mark the begin and the end of the page generator chain, first a block with only an output (on the right side), which can be generated by

(a Database routines for in core recorded function call)

 newproc { } wwwreq {} args 40 {} {} 23.0 51.0

This bwise function generates a block on the canvas with any number of inputs on the left and outputs on the right which automatically gets a fitting size, which is called here with no block-associated function (first argument is empty, except for a space.

we make another block for the end of the bwise chain we build:

 newproc { } wwwrep in {} 40 {} {} 294 51

and make a function / procedure which returns the time:

 proc ourwebprocessing { {onearg {}} } {
   return "The local time of day is:[ clock format [clock seconds] -format {%H hours %M minutes and %S seconds}]"
 }

and a block to put it in, for which you could use the 'block' button on the new procs_window, or newproc with the right arguments, possibly also in that window's pro_arg editing line, or just direct scripting to call newproc with all the right arguments:

 newproc {set ourwebprocessing.out [ourwebprocessing ${ourwebprocessing.onearg}]} ourwebprocessing onearg out 40 {} {} 158 51

Now lets connect up out blocks with wires:

 connect wire16a wwwreq args ourwebprocessing onearg
 connect wire17a ourwebprocessing out wwwrep in

and voila:

To make this network run from request to reply, we adapt the urltest procedure:

 proc urltest { {args} } {
   # import only begin and end of chain vars
   global wwwreq.args wwwrep.in
   # for later use get the additional options from the url
   set wwwreq.args $args
   # here's where our little network actually starts running:
   net_funprop wwwreq
   # return the reply pin from the last block to the server
   return "<html>Test<p>\n${wwwrep.in}</html>"
 }

When we now call our webpage, or refresh it, bwise blocks will have their pins light up to indicate transfering of information, and the web page will display the result of the chain which is the time of day of the server.

The animation in bwise can be made to last a little longer for clarity on fast machines by including a

   after 300

right at the beginning of last the 'if $togglepinsel == 1} {' clause of the transfer procedure from bwise.

Note that all this can be done interactively, while running 'live'.

 #!/bin/sh
 #
 # Tcl HTTPD
 # Nov 2003 adapted by T Verelst theover@tiscali.nl
 #
 # 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.
 # ../lib       The script library that contains most of the TclHttpd
 #              implementation
 # ../tcllib    The Standard Tcl Library.  TclHttpd ships with a copy
 #              of this library because it depends on it.  If you already
 #              have copy installed TclHttpd will attempt to find it.
 #
 # 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: 10461,v 1.10 2006-08-30 18:00:17 jcw Exp $
 #
 # \
 exec tclsh8.3 "$0" ${1+"$@"}

 # on linux, this could generate an error
 console show

 ############
 # auto_path
 ############

 # Configure the auto_path so we can find the script library.
 # home is the directory containing this script

 set home [string trimright [file dirname [info script]] ./]
 set home [file join [pwd] $home]

 # Auto-detect the configuration
 # 1. Development - look for $home/../lib and $home/../../tcllib/modules
 # 2. Standalone install - look for $home/../lib/tclhttpd $home/tcllib
 # 3. Tcl package install - look for $tcl_library/../tclhttpd

 set v 3.4.1

 if {[file exist [file join $home ../lib/httpd.tcl]]} {
     # Cases 1 and 2
     set Config(lib) [file join $home ../lib]
 } elseif {[file exist [file join $home ../lib/tclhttpd$v]]} {
     # Standard package install (e.g., TclPro)
     # By going one level up, we make all Tcl packages available.
     set Config(lib) [file join $home ../lib]
 } else {
    # Hmm - see if Tcl can find it for us.
    tcl_findLibrary tclhttpd $v $v version.tcl TCL_HTTPD_LIBRARY Config(lib)
 }
 if {![info exist Config(lib)]} {
    error "Cannot find TclHttpd library in auto_path:\n[join $auto_path \n]"
 }
 # Put the library in front in case there is both the development
 # library and an installed library

 set auto_path [concat [list $Config(lib)] $auto_path]

 # Search around for the Standard Tcl Library
 # We used to require "tcllib", but that now causes complaints

 if {![catch {package require counter}]} {
    # Already available in environment
 } elseif {[file exist [file join $home ../tcllib]]} {
    lappend auto_path [file join $home ../tcllib]
 } else {
    # Look for the CVS development sources
    set cvs [lindex [lsort -decreasing \
        [glob -nocomplain [file join $home ../../tcllib*]]] 0]
    if {[file exist [file join $cvs modules]]} {
        lappend auto_path [file join $cvs modules]
    } elseif {[file exist [file join $cvs pkgIndex.tcl]]} {
        lappend auto_path $cvs
    } else {
        error "Cannot find Standard Tcl Library in auto_path:\n[join $auto_path \n]"
    }
 }

 set Config(home) $home
 unset home

 # Add operating-specific directories to the auto_path for
 # the binary extensions

 regsub -all { } $tcl_platform(os) {} tmp
 foreach dir [list \
        [file join $Config(lib) Binaries $tmp] \
        [file join $Config(lib) Binaries $tmp $tcl_platform(osVersion)] \
        ] {
    if {[file isdirectory $dir]} {
        lappend auto_path $dir
    }
 }
 unset tmp dir

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

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

 # set Config(docRoot) [file join [file dirname $Config(home)] htdocs]
 # TV I edited this to hardcoded, preferably use a seperate tree with
 # nothing else than .html files in it for good security:

 set Config(docRoot) c:/Docroot

 set Config(library) [file join [file dirname $Config(home)] htdocs/libtml]
 set Config(main) [file join $Config(home) httpdthread.tcl]
 set Config(debug) 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) httpd_bwise.rc]
 }

 # I edited out most stuff I considered potential safety hazard
 # for instance cgi and worse: tml files combined with uploads.
 # These seem harmless.

 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
 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.
 # TV rarely used these.

 package require cmdline
 array set Config [cmdline::getoptions argv [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}] \
    ] \
    "usage: httpd.tcl options:"]

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

 ###################
 # 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.

 # TV I got this to work, but you'll need to generate certificates for this
 puts [cget SS_CADIR],[cget CERTFILE]
    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 {load {} Tclx}           ;# From statically linked shell
 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_SetFile            [cget LogFile]$Config(port)_
 Log_FlushMinutes       [cget LogFlushMinutes]
 Log_Flush

 # Start up the user interface and event loop.
 # TV I put the counter window in a seperate window
 proc SrvUI_Init_bwise {title} {
    global Httpd Doc
    option add *font 9x15
    toplevel .serv
    wm title .serv $Httpd(name):$Httpd(port)
        set msgText "$title\n$Httpd(name):$Httpd(port)"
    if {[info exists Httpd(https_listen)]} {
        append msgText "\n$Httpd(name):$Httpd(https_port) (Secure Server)"
    }
    append msgText "\n$Doc(root)"
    message .serv.msg -text $msgText -aspect 1000
    grid .serv.msg -columnspan 2 -sticky news

    foreach {url label} {
            / "Home Page"
            } {
        label .serv.l$url -text $label
        label .serv.n$url -textvariable counterhit($url) -width 0
        grid .serv.l$url .serv.n$url -sticky w
        grid configure .serv.n$url -sticky e
    }
    foreach {counter label} {
            urlhits "URL Requests"
            urlreply "URL Replies"
            cgihits "CGI Hits"
            maphits "Image Map Hits"
            errors      "Errors"
            } {
        label .serv.l$counter -text $label
        label .serv.n$counter -textvariable [CountVarName $counter] -width 0
        grid .serv.l$counter .serv.n$counter -sticky w
        grid configure .serv.n$counter -sticky e
    }
    button .serv.quit -text "Server Quit" -command {Httpd_Shutdown}
    grid .serv.quit -columnspan 2
 }

 # open the adapted, seperate window
 if {[info exists tk_version]} {
    SrvUI_Init_bwise "Tcl HTTPD $Httpd(version)"
 }

 ####

 # In my case, this works I didn't analyse it
 Stderr $startup
 if {$Config(debug)} {
    if {[info commands "console"] == "console"} {
        console show
    } else {
        Stdin_Start "httpd % "
        Httpd_Shutdown
    }
 } else {
    vwait forever
 }

 # tclhttpd.rc
 #
 # #### Adapted Nov 2003 by T. Verelst ###
 # This is the default configuration file for TclHttpd
 #
 # Note - you should assume that all the paramters listed here
 # are required in one place or another.  If you want to "delete"
 # a parameter you should set the associated value to the
 # empty string, which is written either "" or {}
 #
 # This file is processed in a safe interpreter.  The only side
 # effects it has are through the Config command.  Given two arguments,
 # the Config command sets a parameter.  With a single argument,
 # it returns the value of that parameter.

 # Config parameters in all lower-case have a command line
 # argument alternative (see httpd.tcl)
 # You can specify a value on the command line to override
 # what is in this configuration file.

 # docRoot - the name of the file system directory containing
 # the root of your document tree.  This is conditional so you
 # can run from the source distribution or after doing "make install"

 # TV: Probably this is wrong for you:
 Config docRoot /cygdrive/c/Docroot

 # library - the name of the file system directory containing
 # custom code you want to graft into TclHttpd.

 # main - Main per-thread startup script.
 # The old way to customize the server was to modify this file directly.

 Config main            [file join [Config home] httpdthread.tcl]

 # uid - the server executes as the following user ID.
 # If you have TclX available, these can be user names.
 # If you use the simple "setuid" extension, this must be a number.

 Config uid             50

 # gid - the server executes as the following group ID.
 # If you are using .tml templates then the server will try
 # to cache corresponding .html files.  Put the server into
 # the group that has write permission to the htdocs area
 # so it can do this.  If it cannot write the cache files it
 # just has to process the template on every URL request.

 Config gid             50

 # host - the name of the server (i.e., www.yourcompany.com)
 # This should be fully qualified.

 Config host            [info hostname]
 # TV I used this hardcoded one:
 #Config host           82.168.209.239

 # https_host - the name of the server (i.e., www.yourcompany.com)
 # This should be fully qualified.

 Config https_host      [info hostname]
 # TV: same as above

 # port - the listening port for the server for HTTP requests.
 # The standard web port is 80.

 #TV: you can also fill in 80 for standard, this one is as additional server
 Config port            180

 # https_port - the listening port for the server for HTTPS requests.
 # The standard SSL port is 443.

 #Config https_port     8016
 Config https_port      10443

 # ipaddr - the IP address of the server's end of the HTTP socket.
 # Only specify this if you have a machine with several IP addresses
 # and you want the server to only listen on one IP address.
 # If this is the empty string, then it will listen on all
 # network interfaces for connections.

 Config ipaddr  {}

 # https_ipaddr - ditto, but for https (i.e., SSL) connections

 Config https_ipaddr    {}

 # webmaster - an email address for error mailings

 Config webmaster       youremail@yourprovider

 # secsPerMinute - The seconds-per-minute value used when creating the
 # time-based histograms on the /status page.  This should
 # be between 1 and 60, inclusive.

 Config secsPerMinute   60

 # threads - the maximum number of worker threads to create.
 # If 0, then no threads are ever used.

 Config threads         0

 #####################

 # The parameters below here are not settable via the command line

 # LogFile - the file used for standard logging informaation.
 # This is actually the prefix of the name.  The port and current date stamp
 # is append to this file, and it is rolled every night at midnight

 # TV: an existing dir for your logfiles
 Config LogFile [file join /tmp log ]

 # LogFlushMinutes - how frequently the log file is flushed to disk.
 # Use 0 to have each URL request cause a log flush.

 Config LogFlushMinutes 0

 # MaxFileDescriptors - the maximum number of file descriptors the
 # server can have open.  This impacts the number of simultaneous
 # client requests it can have open.

 Config MaxFileDescriptors      256

 #########################
 # SSL Configuration

 # SSL_REQUEST - should the server ask for certificates from clients?

 Config SSL_REQUEST     0

 # SSL_REQUIRE - should the server require certificates?

 Config SSL_REQUIRE     0

 # SSL_CADIR - the directory containing Certificate Authority
 # certificate files.  If you have only one such file, you can use
 # SSL_CAFILE described below.

 Config SSL_CADIR       [file join [file dirname [Config home]] certs]

 # SSL_CAFILE - the file containing the Certificate Authority
 # certificate.  If this is empty, then the directory specified by
 # SSL_CADIR is scanned for certificate files.

 Config SSL_CAFILE      ""

 # SSL_CERTFILE - The server's certificate.

 Config SSL_CERTFILE    [file join [Config SSL_CADIR] server.pem]

 # SSL_KEYFILE - The server's key file.  If this is empty,
 # then just use the SSL_CERTFILE

 Config SSL_KEYFILE     [file join [Config SSL_CADIR] skey.pem]

 # USE_SSL2 - Allow the use of SSL version 2
 # (You cannot get this with a "no patents" build of OpenSSL)

 Config USE_SSL2                1

 # USE_SSL3 - Allow the use of SSL version 3

 Config USE_SSL3                1

 # USE_TLS1 - ??

 Config USE_TLS1                0

 # SSL_CIPHERS - list of SSL ciphers to support.  If this is empty,
 # then all the ciphers supported by the SSL implementation are available.

 Config SSL_CIPHERS     {}

Note that you do need tclhttpd installed, these are just edited versions of the supplied httpd.tcl and httpd.rc files. Probably, you also need to take care of starting the httod_bwise.tcl from the tclhttpdx.x.x/bin directory, though I didn't try.