#!/usr/bin/env tclsh
# Wibble - a pure-Tcl Web server.
# Code: https://chiselapp.com/user/andy/repository/wibble/timeline
# Discussion: http://wiki.tcl.tk/23626
# Copyright 2009-2014 Andy Goth.  mailto/andrew.m.goth/at/gmail/dot/com
# Available under the Tcl/Tk license.  http://tcl.tk/software/tcltk/license.html

package require Tcl 8.6


# Define the wibble namespace.
namespace eval ::wibble {
    variable zonehandlers
}

# ============================== zone handlers ================================

        # Wait for an event.  Maintain each feed's list of suspended coroutines.
        foreach fid $fids {
            dict set feeds $fid suspended $coro $filters
        }
        set result [list [yield]]
        if {[lindex $result 0 0] eq "exception"} {
            set code 7
        } elseif {![llength [lindex $result 0]]} {
            set result {}
        }
        foreach fid $fids {
            if {[dict exists $feeds $fid]} {
                dict unset feeds $fid suspended $coro
            }
        }

    # Receive and parse the first line.  Normalize the path.
    regexp {^\s*(\S*)\s+(\S*)\s+(\S*)} [getline] _ method uri protocol
    regexp {^([^?]*)(\?.*)?$} $uri _ path query
    regsub -all {(?:/|^)\.(?=/|$)} [dehex $path] / path
    while {[regsub {(?:/[^/]*/+|^[^/]*/+|^)\.\.(?=/|$)} $path "" path]} {}
    regsub -all {//+} /$path / path
    set protocol [string toupper $protocol]

    # Start building the request structure.
    set request [dict create socket $chan peerhost $peerhost peerport $peerport\
        port $port rawtime [clock seconds] time [clock format [clock seconds]]\
        method $method uri $uri path $path protocol $protocol rawheader {}]

    # Parse the query string.

    # Return 501 as default response.
    dict create status 501 header {content-type {"" text/plain charset utf-8}}\
        content "not implemented: [dict get $request uri]\n"
}

# Default send handler: send the response to the client using HTTP.
proc ::wibble::defaultsend {socket request response} {
    # Determine if the connection is persistent.
    set persist [expr {
        [dict get $request protocol] >= "http/1.1"
     && ![string equal -nocase [dict getnull $request header connection] close]
    }]

    # Get the content channel and/or size.
    set size 0
    if {[dict exists $response contentfile]} {
        set size [file size [dict get $response contentfile]]
        if {[dict get $request method] ne "HEAD"} {
            set file [open [dict get $response contentfile]]
            cleanup close_content_file [list chan close $file]

        }
        if {$end eq "" || $end >= $size || $end < $begin} {
            set end [expr {$size - 1}]
        }
        dict set response header content-range "bytes $begin-$end/$size"
    }
    dict set response header content-length [expr {$end - $begin + 1}]

    # Add connection: close if this is not a persistent connection.
    if {!$persist} {
        dict set response header connection close
    }

    # Send the response header to the client.
    chan puts $socket "[dict get $request protocol] [dict get $response status]"
    chan puts $socket [enheader [dict get $response header]]\n

    # If requested, send the response content to the client.
    if {[dict get $request method] ne "HEAD"} {
        chan configure $socket -translation binary
        if {[info exists file]} {
            # Asynchronously send response content from a channel.

    }
    append message "\nerrorinfo: [dict get $options -errorinfo]"
    append message "\n*** INTERNAL SERVER ERROR (END #$errorcount) ***"
    log $message
    if {![dict exists $response nonhttp] && $socket ne ""} {
        catch {
            chan configure $socket -translation crlf
            chan puts $socket\
                "[dict get $request protocol] 500 Internal Server Error\
                \ncontent-type: text/plain;charset=utf-8\
                \ncontent-length: [string length $message]\
                \nconnection: close\n"

            chan configure $socket -translation lf -encoding utf-8
            chan puts $socket $message
        }
    }
}

# Wibble has been loaded successfully.
package provide wibble 0.4

# =============================== example code ================================

# Demonstrate Wibble if being run directly.
if {$argv0 eq [info script]} {
    # Guess the root directory.
    set root [file normalize [file dirname [info script]]]