##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

package require uri
package require base64
package require html


package provide WS::Embeded 2.3.0

namespace eval ::WS::Embeded {

    array set portInfo {}

#
# Description : Instruct the module to listen on a Port, security information.
#
# Arguments :
#       port     -- Port number to listen on
#       certfile -- Name of the certificate file
#       keyfile  -- Name of the key file
#       userpwds -- A list of username and passwords
#       realm    -- The security realm
#       logger   -- A logging routines for errors
#
# Returns :     socket handle
#
# Side-Effects :
#       None
#
# Exception Conditions : None

#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/28/2008  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Embeded::Listen {port {certfile {}} {keyfile {}} {userpwds {}} {realm {}} {logger {::WS::Embeded::logger}}} {
    variable portInfo
    variable portList

    lappend portList $port
    foreach key {port certfile keyfile userpwds realm logger} {
        set portInfo($port,$key) [set $key]
    }
    if {![info exists portInfo($port,handlers)]} {
        set portInfo($port,handlers) {}
    }
    foreach up $userpwds {
        lappend portInfo($port,auths) [base64::encode $up]

            -ssl2 1 \
            -ssl3 1 \
            -tls1 0 \
            -require 0 \
            -request 0
        set handle [::tls::socket -server [list ::WS::Embeded::accept $port] $port]
    } else {
        $portInfo($port,logger) [list socket -server [list ::WS::Embeded::accept $port] $port]
        set handle [socket -server [list ::WS::Embeded::accept $port] $port]
    }

    return $handle
}



    foreach var {type data code} {
        dict set dataArray(reply) $var [set $var]
    }
    return;
}


###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Embeded::Start
#
# Description : Start listening on all ports (i.e. enter the event loop).
#
# Arguments : None
#
# Returns :   Value that event loop was exited with.
#
# Side-Effects :
#       None
#
# Exception Conditions : None
#
# Pre-requisite Conditions :
#        ::WS::Embeded::Listen should have been called for one or more port.
#
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/28/2008  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Embeded::Start {} {
    variable forever

    set forever 0
    vwait ::WS::Embeded::forever
    return $forever
}


###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Embeded::Stop
#
# Description : Exit dispatching request.
#
# Arguments :
#       value -- Value that ::WS::Embedded::Start should return,
#
# Returns :     Nothing
#
# Side-Effects :
#       None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/28/2008  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Embeded::Stop {{value 1}} {
    vairable forever

    set forever $value
    vwait ::WS::Embeded::forever
    return $forever
}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Embeded::logger
#
# Description : Stub for a logger.
#
# Arguments :
#       args            - not used
#
# Returns :
#       Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>END PRIVATE<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/28/2008  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Embeded::logger {args} {
    puts stdout $args
    puts stdout $::errorInfo
    flush stdout
}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<

###########################################################################
proc ::WS::Embeded::checkauth {port sock ip auth} {
    variable portInfo

    if {[info exists portInfo($port,auths)] && [llength $portInfo($port,auths)] && [lsearch -exact $portInfo($port,auths) $auth]==-1} {
        set realm $portInfo($port,realm)
        respond $sock 401 Unauthorized "WWW-Authenticate: Basic realm=\"$realm\"\n"
        $portInfo($port,logger) "Unauthorized from $ip"
        return -code error
    }
}


###########################################################################
#

#
###########################################################################
proc ::WS::Embeded::handler {port sock ip reqstring auth} {
    variable portInfo
    upvar #0 ::WS::Embeded::Httpd$sock req

    if {[catch {checkauth $port $sock $ip $auth}]} {
        $portInfo($port,logger) {Auth Failed}
        return;
    }

    set ::errorInfo {}
    array set req $reqstring
    #foreach var {type data code} {
    #    dict set req(reply) $var [set $var]
    #}
    set path "/[string trim $req(path) /]"
    if {[dict exists $portInfo($port,handlers) $path]} {
        set cmd [dict get $portInfo($port,handlers) $path]
        lappend cmd $sock {}
        #puts "Calling {$cmd}"
        if {[catch {eval $cmd} msg]} {
            $portInfo($port,logger) [list 404 b $msg]
            respond $sock 404 Error $msg
        } else {
            set type [dict get $req(reply) type]
            set encoding [lindex [split [lindex [split $type {;}] 1] {=}] 1]
            if {[string equal $type {}]} {
                set encoding utf-8
                append type {; charset=UTF-8}
            }
            set data [encoding convertto $encoding [dict get $req(reply) data]]
            set reply "HTTP/1.0 [dict get $req(reply) code] ???\n"
            append reply "Content-Type: $type\n"
            append reply "Connection: close\n"
            append reply "Content-length: [string length $data]\n"
            chan configure $sock -translation crlf
            puts $sock $reply
            chan configure $sock -translation binary
            puts -nonewline $sock $rdata
            $portInfo($port,logger) ok
        }
    } else {
        $portInfo($port,logger) {404 Error}
        respond $sock 404 Error "Error"
    }

    return;
}



#
#
###########################################################################
proc ::WS::Embeded::accept {port sock ip clientport} {
    variable portInfo

    upvar #0 ::WS::Embeded::Httpd$sock query
    $portInfo($port,logger) "Receviced request on $port for $ip:$clientport"

    array unset query reply
    chan configure $sock -translation crlf
    if {[catch {
        gets $sock line
        $portInfo($port,logger) "Request is: $line"
        set auth {}
        set request {}
        while {[gets $sock temp] > 0 && ![eof $sock]} {
            lassign [split $temp :] key data
            dict set request header [string tolower $key] [string trim $data]
        }

        if {[eof $sock]} {
            $portInfo($port,logger)  "Connection closed from $ip"


        }




        foreach {method url version} $line { break }





        switch -exact -- $method {
            POST {
                ##
                ## This is all broken and needs to be fixed
                ##
                set data ""
                if {[dict exists $request header transfer-encoding]

                #parray query
                handler $port $sock $ip [array get query] $auth
            }
            GET {
                handler $port $sock $ip [uri::split $url] $auth
            }
            default {

                $portInfo($port,logger)  "Unsupported method '$method' from $ip"
            }
        }
    } msg]} {
        $portInfo($port,logger)  "Error: $msg"

        $portInfo($port,logger)  "Error Info: $::errorInfo"
    }

    catch {flush $sock}
    catch {close $sock}
    return;
}

    variable serviceArr
    variable procInfo
    variable mode

    ::log::log debug "Defining Service as $args"

    array set defaults {
        -host           localhost
        -description    {}
        -checkheader    {::WS::Server::ok}
        -inheaders      {}
        -outheaders     {}
        -intransform    {}
        -outtransform   {}
        -htmlhead       {TclHttpd Based Web Services}
        -author         {}
        -description    {}
        -mode           {tclhttpd}
        -ports          {80}
        -traceEnabled   {Y}
        -docFormat      {text}
        -stylesheet     {}
    }
    array set defaults $args
    if {[string equal $defaults(-mode) channel]} {
        set defaults(-ports) {stdin stdout}
        array set defaults $args
    }
    set requiredList {-host -service}
    set missingList {}
    foreach opt $requiredList {
        if {![info exists defaults($opt)]} {
            lappend missingList $opt
        }
    }
    if {[llength $missingList]} {
        return \
            -code error \
            -errorcode [list WSSERVER MISSREQARG $missingList] \
            "Missing required arguments '[join $missingList {,}]'"
    }
    set service $defaults(-service)
    if {![info exists defaults(-prefix)]} {
        set defaults(-prefix) /service/$service
    }

















    set defaults(-uri) $service
    namespace eval ::$service {}
    set serviceArr($service) [array get defaults]
    if {![dict exists $procInfo $service operationList]} {
        dict set procInfo $service operationList {}
    }
    set mode $defaults(-mode)

                    "text/html; charset=UTF-8" \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            embedded {
                ::WS::Embeded::ReturnData \
                    $sock \
                    "text/xml; charset=UTF-8" \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            channel {
                ::WS::Channel::ReturnData \
                    $sock \
                    text/html \

    ##
    append msg [::html::end]
    switch -exact -- $mode {
        tclhttpd {
            ::Httpd_ReturnData $sock "text/html; charset=UTF-8" $msg 200
        }
        embedded {
            ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $msg 200
        }
        channel {
            ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $msg 200
        }
        rivet {
            headers numeric 200
            headers type text/html
            puts $msg
        }
        aolserver {

# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded WS::Client 2.3.0  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Server 2.3.0  [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.3.0  [list source [file join $dir Utilities.tcl]]

package ifneeded WS::Embeded 2.1.3 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::AOLserver 2.0.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.0.0 [list source [file join $dir ChannelServer.tcl]]

package ifneeded WS::Wub 2.2.1 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.0.0 [list source [file join $dir WubServer.tcl]]

package ifneeded WS::CheckAndBuild 0.0.3 [list source [file join $dir CheckAndBuild.tcl]]