Wapp

# if tracing is enabled.
#
proc wappInt-trace {} {}

# 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".
#
proc wappInt-start-listener {port wappmode} {
  if {$wappmode=="scgi"} {
    set type SCGI
    set server [list wappInt-new-connection wappInt-scgi-readable $wappmode]
  } else {
    set type HTTP
    set server [list wappInt-new-connection wappInt-http-readable $wappmode]
  }
  if {$wappmode=="local"} {
    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/
  } else {
    puts "Listening for $type requests on TCP port $port"
  }
}

# Start a web-browser and point it at $URL
#
proc wappInt-start-browser {url} {
  global tcl_platform
  if {$tcl_platform(platform)=="windows"} {
    exec cmd /c start $url &
  } elseif {$tcl_platform(os)=="Darwin"} {
    exec open $url &
  } elseif {[catch {exec xdg-open $url}]} {
    exec firefox $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.
#
proc wappInt-new-connection {callback wappmode chan ip port} {
  upvar #0 wappInt-$chan W
  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
#
proc wappInt-close-channel {chan} {

  if {[dict exists $wapp CONTENT_LENGTH]} {
    set len [dict get $wapp CONTENT_LENGTH]
  }
  if {$len>0} {
    fconfigure stdin -translation binary
    dict set wapp CONTENT [read stdin $len]
  }
  dict set wapp WAPP_MODE cgi
  fconfigure stdout -translation binary
  wappInt-handle-request stdout 1
}

# Process new text received on an inbound SCGI request
#
proc wappInt-scgi-readable {chan} {

       && [string match CGI/1.* $env(GATEWAY_INTERFACE)])
    || $mode=="cgi"
  } {
    wappInt-handle-cgi-request
    return
  }
  if {$mode=="scgi"} {
    wappInt-start-listener $port scgi
  } elseif {$mode=="server"} {
    wappInt-start-listener $port server
  } else {
    wappInt-start-listener $port local
  }
  vwait ::forever
}

# Call this version 1.0
package provide wapp 1.0