Wapp

# Start up a listening socket.  Arrange to invoke wappInt-new-connection
# for each inbound HTTP connection.
#
#    port            Listen on this TCP port.  0 means to select a port
#                    that is not currently in use
#
#    wappmode        One of "scgi", "server", or "local".
#    wappmode        One of "scgi", "remote-scgi", "server", or "local".
#
#    fromip          If not {}, then reject all requests from IP addresses
#                    other than $fromip
#
proc wappInt-start-listener {port wappmode} {
  if {$wappmode=="scgi"} {
proc wappInt-start-listener {port wappmode fromip} {
  if {[string match *scgi $wappmode]} {
    set type SCGI
    set server [list wappInt-new-connection wappInt-scgi-readable $wappmode]
    set server [list wappInt-new-connection \
                wappInt-scgi-readable $wappmode $fromip]
  } else {
    set type HTTP
    set server [list wappInt-new-connection wappInt-http-readable $wappmode]
    set server [list wappInt-new-connection \
                wappInt-http-readable $wappmode $fromip]
  }
  if {$wappmode=="local"} {
  if {$wappmode=="local" || $wappmode=="scgi"} {
    set x [socket -server $server -myaddr 127.0.0.1 $port]
  } else {
    set x [socket -server $server $port]
  }
  set coninfo [chan configure $x -sockname]
  set port [lindex $coninfo 2]
  if {$wappmode=="local"} {
    wappInt-start-browser http://127.0.0.1:$port/
  } elseif {$fromip!=""} {
    puts "Listening for $type requests on TCP port $port from IP $fromip"
  } else {
    puts "Listening for $type requests on TCP port $port"
  }
}

# Start a web-browser and point it at $URL
#

  }
}

# This routine is a "socket -server" callback.  The $chan, $ip, and $port
# arguments are added by the socket command.
#
# Arrange to invoke $callback when content is available on the new socket.
# The $callback will process inbound HTTP or SCGI content.
# The $callback will process inbound HTTP or SCGI content.  Reject the
# request if $fromip is not an empty string and does not match $ip.
#
proc wappInt-new-connection {callback wappmode chan ip port} {
proc wappInt-new-connection {callback wappmode fromip chan ip port} {
  upvar #0 wappInt-$chan W
  if {$fromip!="" && ![string match $fromip $ip]} {
    close $chan
    return
  }
  set W [dict create REMOTE_ADDR $ip REMOTE_PORT $port WAPP_MODE $wappmode \
         .header {}]
  fconfigure $chan -blocking 0 -translation binary
  fileevent $chan readable [list $callback $chan]
}

# Close an input channel

  if {![dict exists $W .toread]} {
    # If the .toread key is not set, that means we are still reading
    # the header.
    #
    # An SGI header is short.  This implementation assumes the entire
    # header is available all at once.
    #
    dict set W .remove_addr [dict get $W REMOTE_ADDR]
    set req [read $chan 15]
    set n [string length $req]
    scan $req %d:%s len hdr
    incr len [string length "$len:,"]
    append hdr [read $chan [expr {$len-15}]]
    foreach {nm val} [split $hdr \000] {
      if {$nm==","} break
      dict set W $nm $val
    }
    set len 0
    if {[dict exists $W CONTENT_LENGTH]} {
      set len [dict get $W CONTENT_LENGTH]
    }
    if {$len>0} {
      # Still need to read the query content
      dict set W .toread $len
    } else {
      # There is no query content, so handle the request immediately
      dict set W SERVER_ADDR [dict get $W .remove_addr]
      set wapp $W
      wappInt-handle-request $chan 0
    }
  } else {
    # If .toread is set, that means we are reading the query content.
    # Continue reading until .toread reaches zero.
    set got [read $chan [dict get $W .toread]]
    dict append W CONTENT $got
    dict set W .toread [expr {[dict get $W .toread]-[string length $got]}]
    if {[dict get $W .toread]<=0} {
      # Handle the request as soon as all the query content is received
      dict set W SERVER_ADDR [dict get $W .remove_addr]
      set wapp $W
      wappInt-handle-request $chan 0
    }
  }
}

# Start up the wapp framework.  Parameters are a list passed as the
# single argument.
#
#    -server $PORT         Listen for HTTP requests on this TCP port $PORT
#
#    -local $PORT          Listen for HTTP requests on 127.0.0.1:$PORT
#
#    -scgi $PORT           Listen for SCGI requests on TCP port $PORT
#    -scgi $PORT           Listen for SCGI requests on 127.0.0.1:$PORT
#
#    -remote-scgi $PORT    Listen for SCGI requests on TCP port $PORT
#
#    -cgi                  Handle a single CGI request
#
# With no arguments, the behavior is called "auto".  In "auto" mode,
# if the GATEWAY_INTERFACE environment variable indicates CGI, then run
# as CGI.  Otherwise, start an HTTP server bound to the loopback address
# only, on an arbitrary TCP port, and automatically launch a web browser
# on that TCP port.
#
# Additional options:
#
#    -fromip GLOB         Reject any incoming request where the remote
#                         IP address does not match the GLOB pattern.  This
#                         value defaults to '127.0.0.1' for -local and -scgi.
#
#    -nowait              Do not wait in the event loop.  Return immediately
#                         after all event handlers are established.
#
#    -trace               "puts" each request URL as it is handled, for
#                         debugging
#
#    -lint                Run wapp-safety-check on the application instead
#                         of running the application itself
#
#    -Dvar=value          Set TCL global variable "var" to "value"
#
#
proc wapp-start {arglist} {
  global env
  set mode auto
  set port 0
  set nowait 0
  set fromip {}
  set n [llength $arglist]
  for {set i 0} {$i<$n} {incr i} {
    set term [lindex $arglist $i]
    if {[string match --* $term]} {set term [string range $term 1 end]}
    switch -glob -- $term {
      -server {
        incr i;
        set mode "server"
        set port [lindex $arglist $i]
      }
      -local {
        incr i;
        set mode "local"
        set fromip 127.0.0.1
        set port [lindex $arglist $i]
      }
      -scgi {
        incr i;
        set mode "scgi"
        set fromip 127.0.0.1
        set port [lindex $arglist $i]
      }
      -remote-scgi {
        incr i;
        set mode "remote-scgi"
        set port [lindex $arglist $i]
      }
      -cgi {
        set mode "cgi"
      }
      -fromip {
        incr i
        set fromip [lindex $arglist $i]
      }
      -nowait {
        set nowait 1
      }
      -trace {
        proc wappInt-trace {} {
          set q [wapp-param QUERY_STRING]
          set uri [wapp-param BASE_URL][wapp-param PATH_INFO]

        }
      }
      default {
        error "unknown option: $term"
      }
    }
  }
  if {($mode=="auto"
       && [info exists env(GATEWAY_INTERFACE)]
       && [string match CGI/1.* $env(GATEWAY_INTERFACE)])
    || $mode=="cgi"
  } {
  if {$mode=="auto"} {
    if {[info exists env(GATEWAY_INTERFACE)]
        && [string match CGI/1.* $env(GATEWAY_INTERFACE)]} {
      set mode cgi
    } else {
    wappInt-handle-cgi-request
    return
  }
  if {$mode=="scgi"} {
    wappInt-start-listener $port scgi
      set mode local
    }
  }
  if {$mode=="cgi"} {
    wappInt-handle-cgi-request
  } elseif {$mode=="server"} {
    wappInt-start-listener $port server
  } else {
    wappInt-start-listener $port local
    wappInt-start-listener $port $mode $fromip
  }
  if {!$nowait} {
    vwait ::forever
    if {!$nowait} {
      vwait ::forever
    }
  }
}

# Call this version 1.0
package provide wapp 1.0