Tcl Library Source Code

    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    chan event $chan readable {}
    try {
      my request dispatch $datastate
      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan

    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method Dispatch {} {
    my variable chan


    try {

      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan

        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method dispatch {newsock datastate} {
    my variable reply_body reply_file reply_chan chan
    try {
      my request dispatch $datastate
      set chan $newsock
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line

      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }

        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method Dispatch {} {
    my variable reply_body reply_file reply_chan chan
    try {





      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }

    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {

    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]
    foreach {host pattern info} [my uri patterns] {

      if {![string match $host $vhost]} continue

      if {![string match $pattern $uri]} continue
      set buffer $data
      foreach {f v} $info {
        dict set buffer $f $v
      }
      return $buffer

    }
    return {}
  }

  Ensemble uri::patterns {} {
    my variable url_patterns url_stream
    if {![info exists url_stream]} {
      set url_stream {}
      foreach {host hostpat} $url_patterns {
        foreach {pattern info} $hostpat {
          lappend url_stream $host $pattern $info
        }
      }
    }
    return $url_stream
  }

  Ensemble uri::add args {
    my variable url_patterns url_stream
    unset -nocomplain url_stream
    switch [llength $args] {
      2 {
        set vhosts *
        lassign $args patterns info
      }
      3 {
        lassign $args vhosts patterns info
      }
      default {
        error "Usage: add_url ?vhosts? prefix info"
      }
    }
    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }















}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body

    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {
    my variable url_patterns
    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]

    foreach {host hostpat} $url_patterns {
      if {![string match $host $vhost]} continue
      foreach {pattern info} $hostpat {
        if {![string match $pattern $uri]} continue
        set buffer $data
        foreach {f v} $info {
          dict set buffer $f $v
        }
        return $buffer
      }
    }
    return {}
  }














  Ensemble uri::add {vhosts patterns info} {
    my variable url_patterns













    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }

  Ensemble uri::direct {vhosts patterns info body} {
    my variable url_patterns url_stream
    set body {}
    if {[dict exists $info superclass]} {
      append body \n "superclass {*}[dict get $info superclass]"
      dict unset info superclass
    }
    append body \n [list method content {} $body]
    set class [namespace current]::${vhosts}/${patterns}
    set class [string map $class {* %} $class]
    ::clay::define $class $body
    dict set info mixin content $class
    my uri add $vhosts $patterns $info
  }
}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body

      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method dispatch {newsock datastate} {
    try {
      my request dispatch $datastate
      my variable sock chan
      set chan $newsock
      chan configure $chan -translation {auto crlf} -buffering line
      # Initialize the reply
      my reset
      # Invoke the URL implementation.
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput

      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method Dispatch {} {


    my variable sock chan









    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput

  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    try {
      my request dispatch $datastate
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line














      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
















      my error 500 $err [dict get $errdat -errorinfo]
    } finally {
      my DoOutput
    }
  }







  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }




  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }
      dispatch {
        set request [my clay get dict/ request]
        foreach datastate $args {
          foreach {f v} $datastate {
            if {[string index $f end] eq "/"} {
              my clay merge $f $v
            } else {
              my clay set $f $v
            }
            if {$f eq "http"} {
              foreach {ff vf} $v {
                dict set request $ff $vf
              }
            }
          }
        }
        my Log_Dispatched
      }
      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}

  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get HTTP_REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan request
    set chan $newsock


    chan event $chan readable {}
    chan configure $chan -translation {auto crlf} -buffering line

    if {[dict exists $datastate mixin]} {
      set mixinmap [dict get $datastate mixin]
    } else {
      set mixinmap {}
    }
    foreach item [dict keys $datastate MIXIN_*] {
      set slot [string range $item 6 end]
      dict set mixinmap [string tolower $slot] [dict get $datastate $item]
    }
    my clay mixinmap {*}$mixinmap
    if {[dict exists $datastate delegate]} {
      my clay delegate {*}[dict get $datastate delegate]
    }
    my reset



    set request [my clay get dict/ request]
    foreach {f v} $datastate {
      if {[string index $f end] eq "/"} {
        my clay merge $f $v
      } else {
        my clay set $f $v
      }
      if {$f eq "http"} {
        foreach {ff vf} $v {
          dict set request $ff $vf
        }
      }
    }
    my Session_Load
    my Log_Dispatched
    if {[catch {my Dispatch} err errdat]} {
      my error 500 $err [dict get $errdat -errorinfo]

      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.
    my content
    my DoOutput
  }

  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }

  # Manage session data
  method Session_Load {} {}

  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }


















      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}

###
# Return data from an SCGI process
###







::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}

::clay::define ::httpd::reply.scgi {
  superclass ::httpd::reply

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}

  clay set reply_class ::httpd::reply.scgi

  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }


    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}
      catch {chan close $sock}
      return
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
      return
    }
  }
}

###
# Return data from an SCGI process
###
::clay::define ::httpd::protocol.scgi {

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}









###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}



  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]













      dict set reply mixin protocol ::httpd::protocol.scgi
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}









      catch {chan close $sock}
      return
    }
  }
}

      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }



































  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 line]
      set mimetxt [my HttpHeaders $sock]

      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]
      dict set query http HTTP_HOST {}
      dict set query http CONTENT_LENGTH 0
      foreach {f v} [my MimeParse $mimetxt] {
        set fld [string toupper [string map {- _} $f]]
        if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
          set qfld $fld
        } else {
          set qfld HTTP_$fld
        }
        dict set query http $qfld $v
      }
      dict set query UUID $uuid
      dict set query http UUID $uuid
      dict set query http REMOTE_ADDR     $ip
      dict set query http REMOTE_HOST     [my HostName $ip]
      dict set query http REQUEST_METHOD  [lindex $line 0]
      set uriinfo [::uri::split [lindex $line 1]]
      dict set query uriinfo $uriinfo
      dict set query http REQUEST_URI     [lindex $line 1]
      dict set query http REQUEST_PATH    [dict get $uriinfo path]
      dict set query http REQUEST_VERSION [lindex [split [lindex $line end] /] end]
      dict set query http DOCUMENT_ROOT   [my clay get server/ doc_root]
      dict set query http QUERY_STRING    [dict get $uriinfo query]
      dict set query http REQUEST_RAW     $line
      dict set query http SERVER_PORT     [my port_listening]
      dict set query http SERVER_NAME     [my clay get server/ name]
      dict set query http SERVER_PROTOCOL [my clay get server/ protocol]
      dict set query http SERVER_SOFTWARE [my clay get server/ string]
      # REMOTE_USER AUTH_TYPE
      # GATEWAY_INTERFACE
      # SERVER_HTTPS_PORT
      #SERVER_NAME
      #SERVER_SOFTWARE

      if {[string match 127.* $ip]} {
        dict set query http LOCALHOST [expr {[lindex [split [dict getnull $query HTTP_HOST] :] 0] eq "localhost"}]
      }
      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {
      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {




    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###

      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }

  method ServerHeaders {ip http_request mimetxt} {
    set result {}
    dict set result HTTP_HOST {}
    dict set result CONTENT_LENGTH 0
    foreach {f v} [my MimeParse $mimetxt] {
      set fld [string toupper [string map {- _} $f]]
      if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
        set qfld $fld
      } else {
        set qfld HTTP_$fld
      }
      dict set result $qfld $v
    }
    dict set result REMOTE_ADDR     $ip
    dict set result REMOTE_HOST     [my HostName $ip]
    dict set result REQUEST_METHOD  [lindex $http_request 0]
    set uriinfo [::uri::split [lindex $http_request 1]]
    dict set result uriinfo $uriinfo
    dict set result REQUEST_URI     [lindex $http_request 1]
    dict set result REQUEST_PATH    [dict get $uriinfo path]
    dict set result REQUEST_VERSION [lindex [split [lindex $http_request end] /] end]
    dict set result DOCUMENT_ROOT   [my clay get server/ doc_root]
    dict set result QUERY_STRING    [dict get $uriinfo query]
    dict set result REQUEST_RAW     $http_request
    dict set result SERVER_PORT     [my port_listening]
    dict set result SERVER_NAME     [my clay get server/ name]
    dict set result SERVER_PROTOCOL [my clay get server/ protocol]
    dict set result SERVER_SOFTWARE [my clay get server/ string]
    if {[string match 127.* $ip]} {
      dict set result LOCALHOST [expr {[lindex [split [dict getnull $result HTTP_HOST] :] 0] eq "localhost"}]
    }
    return $result
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 http_request]
      set mimetxt [my HttpHeaders $sock]
      dict set query UUID $uuid
      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]









      dict set query http [my ServerHeaders $ip $http_request $mimetxt]



























      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {
      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]




















      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {
    set reply [my Dispatch_Local $data]
    if {[dict size $reply]} {
      return $reply
    }
    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###

  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    try {
      my request dispatch $datastate
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line














      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
















      my error 500 $err [dict get $errdat -errorinfo]
    } finally {
      my DoOutput
    }
  }







  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }




  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }
      dispatch {
        set request [my clay get dict/ request]
        foreach datastate $args {
          foreach {f v} $datastate {
            if {[string index $f end] eq "/"} {
              my clay merge $f $v
            } else {
              my clay set $f $v
            }
            if {$f eq "http"} {
              foreach {ff vf} $v {
                dict set request $ff $vf
              }
            }
          }
        }
        my Log_Dispatched
      }
      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}
................................................................................
      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }



































  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 line]
      set mimetxt [my HttpHeaders $sock]

      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]
      dict set query http HTTP_HOST {}
      dict set query http CONTENT_LENGTH 0
      foreach {f v} [my MimeParse $mimetxt] {
        set fld [string toupper [string map {- _} $f]]
        if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
          set qfld $fld
        } else {
          set qfld HTTP_$fld
        }
        dict set query http $qfld $v
      }
      dict set query UUID $uuid
      dict set query http UUID $uuid
      dict set query http REMOTE_ADDR     $ip
      dict set query http REMOTE_HOST     [my HostName $ip]
      dict set query http REQUEST_METHOD  [lindex $line 0]
      set uriinfo [::uri::split [lindex $line 1]]
      dict set query uriinfo $uriinfo
      dict set query http REQUEST_URI     [lindex $line 1]
      dict set query http REQUEST_PATH    [dict get $uriinfo path]
      dict set query http REQUEST_VERSION [lindex [split [lindex $line end] /] end]
      dict set query http DOCUMENT_ROOT   [my clay get server/ doc_root]
      dict set query http QUERY_STRING    [dict get $uriinfo query]
      dict set query http REQUEST_RAW     $line
      dict set query http SERVER_PORT     [my port_listening]
      dict set query http SERVER_NAME     [my clay get server/ name]
      dict set query http SERVER_PROTOCOL [my clay get server/ protocol]
      dict set query http SERVER_SOFTWARE [my clay get server/ string]
      # REMOTE_USER AUTH_TYPE
      # GATEWAY_INTERFACE
      # SERVER_HTTPS_PORT
      #SERVER_NAME
      #SERVER_SOFTWARE

      if {[string match 127.* $ip]} {
        dict set query http LOCALHOST [expr {[lindex [split [dict getnull $query HTTP_HOST] :] 0] eq "localhost"}]
      }
      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {

      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
      return
    }
    if {[dict size $reply]==0} {
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {




    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###
................................................................................
    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    chan event $chan readable {}
    try {
      my request dispatch $datastate
      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan
................................................................................
        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method dispatch {newsock datastate} {
    my variable reply_body reply_file reply_chan chan
    try {
      my request dispatch $datastate
      set chan $newsock
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line

      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
................................................................................
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method dispatch {newsock datastate} {
    try {
      my request dispatch $datastate
      my variable sock chan
      set chan $newsock
      chan configure $chan -translation {auto crlf} -buffering line
      # Initialize the reply
      my reset
      # Invoke the URL implementation.
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
................................................................................
###
###
# START: scgi.tcl
###
###
# Return data from an SCGI process
###







::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}

::clay::define ::httpd::reply.scgi {
  superclass ::httpd::reply

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}

  clay set reply_class ::httpd::reply.scgi

  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }


    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}
      catch {chan close $sock}
      return
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
      return
    }
  }
}

###
................................................................................
    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {

    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]
    foreach {host pattern info} [my uri patterns] {

      if {![string match $host $vhost]} continue

      if {![string match $pattern $uri]} continue
      set buffer $data
      foreach {f v} $info {
        dict set buffer $f $v
      }
      return $buffer

    }
    return {}
  }

  Ensemble uri::patterns {} {
    my variable url_patterns url_stream
    if {![info exists url_stream]} {
      set url_stream {}
      foreach {host hostpat} $url_patterns {
        foreach {pattern info} $hostpat {
          lappend url_stream $host $pattern $info
        }
      }
    }
    return $url_stream
  }

  Ensemble uri::add args {
    my variable url_patterns url_stream
    unset -nocomplain url_stream
    switch [llength $args] {
      2 {
        set vhosts *
        lassign $args patterns info
      }
      3 {
        lassign $args vhosts patterns info
      }
      default {
        error "Usage: add_url ?vhosts? prefix info"
      }
    }
    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }















}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body

  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get HTTP_REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan request
    set chan $newsock


    chan event $chan readable {}
    chan configure $chan -translation {auto crlf} -buffering line

    if {[dict exists $datastate mixin]} {
      set mixinmap [dict get $datastate mixin]
    } else {
      set mixinmap {}
    }
    foreach item [dict keys $datastate MIXIN_*] {
      set slot [string range $item 6 end]
      dict set mixinmap [string tolower $slot] [dict get $datastate $item]
    }
    my clay mixinmap {*}$mixinmap
    if {[dict exists $datastate delegate]} {
      my clay delegate {*}[dict get $datastate delegate]
    }
    my reset



    set request [my clay get dict/ request]
    foreach {f v} $datastate {
      if {[string index $f end] eq "/"} {
        my clay merge $f $v
      } else {
        my clay set $f $v
      }
      if {$f eq "http"} {
        foreach {ff vf} $v {
          dict set request $ff $vf
        }
      }
    }
    my Session_Load
    my Log_Dispatched
    if {[catch {my Dispatch} err errdat]} {
      my error 500 $err [dict get $errdat -errorinfo]

      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.
    my content
    my DoOutput
  }

  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }

  # Manage session data
  method Session_Load {} {}

  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }


















      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}
................................................................................
      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }

  method ServerHeaders {ip http_request mimetxt} {
    set result {}
    dict set result HTTP_HOST {}
    dict set result CONTENT_LENGTH 0
    foreach {f v} [my MimeParse $mimetxt] {
      set fld [string toupper [string map {- _} $f]]
      if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
        set qfld $fld
      } else {
        set qfld HTTP_$fld
      }
      dict set result $qfld $v
    }
    dict set result REMOTE_ADDR     $ip
    dict set result REMOTE_HOST     [my HostName $ip]
    dict set result REQUEST_METHOD  [lindex $http_request 0]
    set uriinfo [::uri::split [lindex $http_request 1]]
    dict set result uriinfo $uriinfo
    dict set result REQUEST_URI     [lindex $http_request 1]
    dict set result REQUEST_PATH    [dict get $uriinfo path]
    dict set result REQUEST_VERSION [lindex [split [lindex $http_request end] /] end]
    dict set result DOCUMENT_ROOT   [my clay get server/ doc_root]
    dict set result QUERY_STRING    [dict get $uriinfo query]
    dict set result REQUEST_RAW     $http_request
    dict set result SERVER_PORT     [my port_listening]
    dict set result SERVER_NAME     [my clay get server/ name]
    dict set result SERVER_PROTOCOL [my clay get server/ protocol]
    dict set result SERVER_SOFTWARE [my clay get server/ string]
    if {[string match 127.* $ip]} {
      dict set result LOCALHOST [expr {[lindex [split [dict getnull $result HTTP_HOST] :] 0] eq "localhost"}]
    }
    return $result
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 http_request]
      set mimetxt [my HttpHeaders $sock]
      dict set query UUID $uuid
      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]









      dict set query http [my ServerHeaders $ip $http_request $mimetxt]



























      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {
      puts [dict get $errdat -errorinfo]
      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
      return
    }
    if {[dict size $reply]==0} {
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]




















      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {
    set reply [my Dispatch_Local $data]
    if {[dict size $reply]} {
      return $reply
    }
    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###
................................................................................
    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method Dispatch {} {
    my variable chan


    try {

      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan
................................................................................
        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method Dispatch {} {
    my variable reply_body reply_file reply_chan chan
    try {





      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
................................................................................
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method Dispatch {} {


    my variable sock chan









    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
................................................................................
###
###
# START: scgi.tcl
###
###
# Return data from an SCGI process
###
::clay::define ::httpd::protocol.scgi {

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}









###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}



  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]













      dict set reply mixin protocol ::httpd::protocol.scgi
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}









      catch {chan close $sock}
      return
    }
  }
}

###
................................................................................
    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {
    my variable url_patterns
    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]

    foreach {host hostpat} $url_patterns {
      if {![string match $host $vhost]} continue
      foreach {pattern info} $hostpat {
        if {![string match $pattern $uri]} continue
        set buffer $data
        foreach {f v} $info {
          dict set buffer $f $v
        }
        return $buffer
      }
    }
    return {}
  }














  Ensemble uri::add {vhosts patterns info} {
    my variable url_patterns













    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }

  Ensemble uri::direct {vhosts patterns info body} {
    my variable url_patterns url_stream
    set body {}
    if {[dict exists $info superclass]} {
      append body \n "superclass {*}[dict get $info superclass]"
      dict unset info superclass
    }
    append body \n [list method content {} $body]
    set class [namespace current]::${vhosts}/${patterns}
    set class [string map $class {* %} $class]
    ::clay::define $class $body
    dict set info mixin content $class
    my uri add $vhosts $patterns $info
  }
}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body

  }
}


clay::define ::httpd::server {
  method log args {}


  method TemplateSearch page {
    set doc_root [my clay get server/ doc_root]
    if {$doc_root ne {} && [file exists [file join $doc_root $page.tml]]} {
      return [::fileutil::cat [file join $doc_root $page.tml]]
    }
    if {$doc_root ne {} && [file exists [file join $doc_root $page.html]]} {
      return [::fileutil::cat [file join $doc_root $page.html]]
    }
    switch $page {
      redirect {
        return {404 Not Found}
      }
      internal_error {
        return {500 Server Internal Error}
      }
    }
  }

  ::DEBUG method debug args {
    puts stderr $args
  }
................................................................................
# Build the server
###
set DIR [file dirname [file normalize [info script]]]
set ::DEMOROOT $DIR

::httpd::server create TESTAPP port 10001
TESTAPP plugin dict_dispatch
TESTAPP uri add /     [list mixin {reply ::test::content.echo}]
TESTAPP uri add /echo [list mixin {reply ::test::content.echo}]
TESTAPP uri add /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTAPP uri add /time [list mixin {reply ::test::content.time}]
TESTAPP uri add /error [list mixin {replyy ::test::content.error}]

# Catch all
#TESTAPP uri add * [list mixin {reply httpd::content.echo}]

::DEBUG puts httpd-client-0001
test httpd-client-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
Content-Length: *

THIS IS MY CODE}
} {}


::DEBUG puts httpd-client-0002
test httpd-client-0002 {Do another echo request} {
set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THOUGH THERE ARE MANY LIKE IT}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
................................................................................
  method proxy_channel {} {
    return [::socket localhost [my clay get proxy_port]]
  }
}


::httpd::server create TESTPROXY port 10002
TESTAPP   uri add /proxy*     [list mixin {reply ::test::content.proxy} proxy_port [TESTPROXY port_listening]]
TESTPROXY plugin dict_dispatch
TESTPROXY uri add /     [list mixin {reply ::test::content.echo}]
TESTPROXY uri add /echo [list mixin {reply ::test::content.echo}]
TESTPROXY uri add /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTPROXY uri add /time [list mixin {reply ::test::content.time}]
TESTPROXY uri add /error [list mixin {reply ::test::content.error}]

::DEBUG puts httpd-proxy-0001
test httpd-proxy-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /proxy/echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
................................................................................
::httpd::test::compare $reply $checkreply
} {}

# -------------------------------------------------------------------------
# cgi
TESTAPP plugin local_memchan

TESTAPP uri add /cgi-bin* [list mixin {reply ::test::content.cgi} path $::DEMOROOT]

set fout [open [file join $DIR test.tcl] w]
puts $fout {#!/usr/bin/tclsh

puts stdout "Status: 200 OK"
if {$::env(CONTENT_LENGTH) > 0} {
  puts stdout "Content-Type: $::env(CONTENT_TYPE)"
................................................................................
  variable server_block {SCGI 1.0 SERVER_SOFTWARE {TclScgiServer/0.1}}
}

###
# Build the reply class
###
::clay::define ::scgi::test::reply {
  superclass ::httpd::reply.scgi

  method reset {} {
    my variable reply_body
    my reply replace [my HttpHeaders_Default]
    set reply_body {}
  }
}
................................................................................

  clay set reply_class ::scgi::test::reply
}

puts [list ::test::content.file [info commands ::test::content.file]]
scgi::test::app create TESTSCGI port 10003
TESTSCGI plugin dict_dispatch
TESTSCGI uri add /     [list mixin {reply ::test::content.echo}]
TESTSCGI uri add /echo [list mixin {reply ::test::content.echo}]
TESTSCGI uri add /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTSCGI uri add /time [list mixin {reply ::test::content.time}]
TESTSCGI uri add /error [list mixin {reply ::test::content.error}]

::DEBUG puts scgi-client-0001
test scgi-client-0001 {Do an echo request} {

set reply [::scgi::test::send 10003 {REQUEST_METHOD POST REQUEST_URI /echo} {THIS IS MY CODE}]
set checkreply {Status: 200 OK
Content-Type: text/plain

  }
}


clay::define ::httpd::server {
  method log args {}


  method TemplateSearch page {
    set doc_root [my clay get server/ doc_root]
    if {$doc_root ne {} && [file exists [file join $doc_root $page.tml]]} {
      return [::fileutil::cat [file join $doc_root $page.tml]]
    }
    if {$doc_root ne {} && [file exists [file join $doc_root $page.html]]} {
      return [::fileutil::cat [file join $doc_root $page.html]]
    }
    switch $page {
      redirect {
        return {404 Not Found}
      }
      internal_error {
        return {500 Server Internal Error\nTrace:\n$errorInfo}
      }
    }
  }

  ::DEBUG method debug args {
    puts stderr $args
  }
................................................................................
# Build the server
###
set DIR [file dirname [file normalize [info script]]]
set ::DEMOROOT $DIR

::httpd::server create TESTAPP port 10001
TESTAPP plugin dict_dispatch
TESTAPP uri add * /     [list mixin {reply ::test::content.echo}]
TESTAPP uri add * /echo [list mixin {reply ::test::content.echo}]
TESTAPP uri add * /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTAPP uri add * /time [list mixin {reply ::test::content.time}]
TESTAPP uri add * /error [list mixin {replyy ::test::content.error}]

# Catch all
#TESTAPP uri add * * [list mixin {reply httpd::content.echo}]

::DEBUG puts httpd-client-0001
test httpd-client-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
Content-Length: *

THIS IS MY CODE}
} {}


::DEBUG puts httpd-client-0002
test httpd-client-0002 {Do another echo request} {
set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THOUGH THERE ARE MANY LIKE IT}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
................................................................................
  method proxy_channel {} {
    return [::socket localhost [my clay get proxy_port]]
  }
}


::httpd::server create TESTPROXY port 10002
TESTAPP   uri add * /proxy*     [list mixin {reply ::test::content.proxy} proxy_port [TESTPROXY port_listening]]
TESTPROXY plugin dict_dispatch
TESTPROXY uri add * /     [list mixin {reply ::test::content.echo}]
TESTPROXY uri add * /echo [list mixin {reply ::test::content.echo}]
TESTPROXY uri add * /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTPROXY uri add * /time [list mixin {reply ::test::content.time}]
TESTPROXY uri add * /error [list mixin {reply ::test::content.error}]

::DEBUG puts httpd-proxy-0001
test httpd-proxy-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /proxy/echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
................................................................................
::httpd::test::compare $reply $checkreply
} {}

# -------------------------------------------------------------------------
# cgi
TESTAPP plugin local_memchan

TESTAPP uri add * /cgi-bin* [list mixin {reply ::test::content.cgi} path $::DEMOROOT]

set fout [open [file join $DIR test.tcl] w]
puts $fout {#!/usr/bin/tclsh

puts stdout "Status: 200 OK"
if {$::env(CONTENT_LENGTH) > 0} {
  puts stdout "Content-Type: $::env(CONTENT_TYPE)"
................................................................................
  variable server_block {SCGI 1.0 SERVER_SOFTWARE {TclScgiServer/0.1}}
}

###
# Build the reply class
###
::clay::define ::scgi::test::reply {
  superclass ::httpd::reply

  method reset {} {
    my variable reply_body
    my reply replace [my HttpHeaders_Default]
    set reply_body {}
  }
}
................................................................................

  clay set reply_class ::scgi::test::reply
}

puts [list ::test::content.file [info commands ::test::content.file]]
scgi::test::app create TESTSCGI port 10003
TESTSCGI plugin dict_dispatch
TESTSCGI uri add * /     [list mixin {reply ::test::content.echo}]
TESTSCGI uri add * /echo [list mixin {reply ::test::content.echo}]
TESTSCGI uri add * /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTSCGI uri add * /time [list mixin {reply ::test::content.time}]
TESTSCGI uri add * /error [list mixin {reply ::test::content.error}]

::DEBUG puts scgi-client-0001
test scgi-client-0001 {Do an echo request} {

set reply [::scgi::test::send 10003 {REQUEST_METHOD POST REQUEST_URI /echo} {THIS IS MY CODE}]
set checkreply {Status: 200 OK
Content-Type: text/plain