Version 6 of minimal tclhttpd

Updated 2003-10-25 05:33:54

Consensus on the list http://sourceforge.net/mailarchive/forum.php?forum_id=3850 seems to be that httpdthread.tcl can be used to modify the available modules without core changes which might impact performance. Certainly, you can specify which mainline to source instead of httpdthread.tcl using the command line -main command. I've added the necessary NOOP procs to httpdthread.tcl to facilitate customised tclhttpd with minimal functionality, but I note that redir isn't handled by the original patchset, so I haven't added it to the CVS.

Tclhttpd Core Someone on the tkchat suggested that it might be a better idea to build up from a minimal tclhttpd than to cut down the full tclhttpd. To that end, good documentation for tclhttpd low-level functions would help. The main powerhouse of tclhttpd is in lib/{httpd,url}.tcl, and these would be good basis for a cut down tclhttpd derivative.

US 6. Oct. 2003

I need a fairly simple http server just to serve plain files. So I reduced the tclhttpd server to load only the following packages:

 auth.tcl
 config.tcl
 counter.tcl
 direct.tcl
 doc.tcl
 httpd.tcl
 log.tcl
 logstd.tcl
 mtype.tcl
 url.tcl
 utils.tcl
 version.tcl

It turned out, that tclhttpd doesn't run correctly without cgi.tcl, dirlist.tcl and redirect.tcl. Two simple patches to doc.tcl and url.tcl solve this problem:

CMcC I like this idea - a minimal tclhttpd. I think, though, that it might be better to define default NOOP procs for some of the procs you're commenting out, so that there's no impost on full tclhttpd installations.

US I don't comment them out, I just check their existance. Full installations should work as before.

CMcC interspersed comments and alternative suggestions through these patches

 *** /usr/local/src/tclhttpd3.4.2/lib/doc.tcl   2002-09-15 22:59:35.000000000 +0200
 --- doc.tcl    2003-10-06 14:23:57.000000000 +0200
 ***************
 *** 624,630 ****
       if {![DocFallback $prefix $path $suffix $sock]} {
         # Couldn't find anything.
         # check for cgi script in the middle of the path
 !      Cgi_Domain $prefix $directory $sock $suffix
       }
   }

 --- 624,634 ----
       if {![DocFallback $prefix $path $suffix $sock]} {
         # Couldn't find anything.
         # check for cgi script in the middle of the path
 !         if {[string compare [info command Cgi_Domain] "Cgi_Domain"] == 0} {
 !          Cgi_Domain $prefix $directory $sock $suffix
 !         } else {
 !          Doc_NotFound $sock
 !         }
       }
   }

This could as easily be achieved with the following code instead of

 package require httpd::cgi                ;# Standard CGI
 Cgi_Directory                        /cgi-bin

in bin/httpdthread.tcl

 proc Cgi_Domain {virtual directory sock suffix} {
        Doc_NotFound $sock
        return
 }

With the advantage of not requiring mainline code mods or runtime tests.

 ***************
 *** 910,916 ****
         }
         return [DocHandle $prefix $newest $suffix $sock]
       }
 !     if {[Dir_ListingIsHidden]} {
           # Direcotry listings are hidden, so give the not-found page.
           return [Doc_NotFound $sock]
       }
 --- 914,920 ----
         }
         return [DocHandle $prefix $newest $suffix $sock]
       }
 !     if {[string compare [info commands Dir_ListingIsHidden] "Dir_ListingIsHidden"] || [Dir_ListingIsHidden]} {
           # Direcotry listings are hidden, so give the not-found page.
           return [Doc_NotFound $sock]
       }

Similarly, replace bin/httpdthread.tcl

 package require httpd::dirlist                ;# Directory listings

with

 proc Dir_ListingIsHidden {} {
    return 1
 }

so no directory listing functionality will be provided.

 *** /usr/local/src/tclhttpd3.4.2/lib/url.tcl   2002-08-31 02:06:43.000000000 +0200
 --- url.tcl    2003-10-06 13:28:02.000000000 +0200
 ***************
 *** 57,63 ****
         # to match the /cgi-bin prefix
         regsub -all /+ $url / url

 !      if {![regexp ^($Url(prefixset))(.*) $url x prefix suffix] ||
                 ([string length $suffix] && ![string match /* $suffix])} {

             # Fall back and assume it is under the root
 --- 57,64 ----
         # to match the /cgi-bin prefix
         regsub -all /+ $url / url

 !      if {![info exist Url(prefixset)] ||
 !                 ![regexp ^($Url(prefixset))(.*) $url x prefix suffix] ||
                 ([string length $suffix] && ![string match /* $suffix])} {

             # Fall back and assume it is under the root

The above mod therefore shouldn't be necessary.