examples/echo-tcl

   1 #!./tclsh
   2 #
   3 #  echo-tcl --
   4 #
   5 #       Produce a page containing all FastCGI inputs
   6 #
   7 # Copyright (c) 1996 Open Market, Inc.
   8 #
   9 # See the file "LICENSE.TERMS" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12 #  $Id: echo-tcl,v 1.1 1997/09/16 15:36:28 stanleyg Exp $
  13 #
  14
  15 proc printEnv {label envArrayName} {
  16     upvar $envArrayName envArray
  17     puts "$label:<br>\n<pre>"
  18     foreach name [lsort [array names envArray]] {
  19         puts "$name=$envArray($name)"
  20     }
  21     puts "</pre><p>"
  22 }
  23
  24 foreach name [array names env] {
  25     set initialEnv($name) $env($name)
  26 }
  27 set count 0
  28 while {[FCGI_Accept] >= 0 } {
  29     incr count
  30     puts -nonewline "Content-type: text/html\r\n\r\n"
  31     puts "<title>FastCGI echo (Tcl)</title>"
  32     puts "<h1>FastCGI echo (Tcl)</h1>"
  33     puts "Request number $count <p>"
  34     if [info exists env(CONTENT_LENGTH)] {
  35         set len $env(CONTENT_LENGTH)
  36     } else {
  37         set len 0
  38     }
  39     if {$len == 0} {
  40         puts "No data from standard input.<p>"
  41     } else {
  42         puts "Standard input:<br>\n<pre>"
  43         for {set i 0} {$i < $len} {incr i} {
  44             set ch [read stdin 1]
  45             if {$ch == ""} {
  46                 puts -nonewline "Error: Not enough bytes received "
  47                 puts "on standard input<p>"
  48                 break
  49             }
  50             puts -nonewline $ch
  51         }
  52         puts "\n</pre><p>"
  53     }
  54     printEnv "Request environment" env
  55     printEnv "Initial environment" initialEnv
  56 }