##  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT       ##
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

set auto_path [linsert $auto_path 0 [file join [file dirname [info script]] ../..]]
package require WS::Utils
package require WS::Client

##
## Get Definition of the offered services
##
::WS::Client::GetAndParseWsdl http://localhost:8015/service/wsEchoExample/wsdl

set testString "This is a test"

##  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT       ##
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

set auto_path [linsert $auto_path 0 [file join [file dirname [info script]] ../..]]
package require WS::Server
package require WS::Utils
package require WS::Embeded
catch {console show}

##
## Define the service
##
::WS::Server::Service \
    -service wsEchoExample \
    -description  {Echo Example - Tcl Web Services} \

    return [list ComplexEchoResult [list echoBack $TestString echoTS $timeStamp]  ]
}

set ::errorInfo {}
set SocketHandle [::WS::Embeded::Listen 8015]
set ::errorInfo {}

proc x {} {
    close $::SocketHandle
    exit
}

puts stdout {Server started. Press x and Enter to stop}
flush stdout
fileevent stdin readable {set QuitNow 1}
vwait QuitNow



x

# Call redirect server
# 2015-11-09 Harald Oehlmann
# Start the redirect_server.tcl and the embedded echo sample to test.
set auto_path [linsert $auto_path 0 [file join [file dirname [info script]] ../..]]
package require WS::Utils
package require WS::Client
catch {console show}
::log::lvSuppressLE debug 0
::WS::Client::GetAndParseWsdl http://localhost:8014/service/wsEchoExample/wsdl

# Test tclws redirection
# 2015-11-09 by Harald Oehlmann
#
# If (set loop 1), infinite redirect is tested, otherwise one redirect.
# Start the embedded test server and use redirect_call to call.
#
set auto_path [linsert $auto_path 0 [file join [file dirname [info script]] ../..]]
catch {console show}
package require uri

proc ::Listen {port} {
	return [socket -server ::Accept $port]
}


proc ::Accept {sock ip clientport} {
    if {1 == [catch {
        gets $sock line
        set request {}
        while {[gets $sock temp] > 0 && ![eof $sock]} {
            if {[regexp {^([^:]*):(.*)$} $temp -> key data]} {
                dict set request header [string tolower $key] [string trim $data]
            }
        }
        if {[eof $sock]} {
            puts "Connection closed from $ip"
            return
        }
        if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
            puts  "Wrong request: $line"
            return
        }
        array set uri [::uri::split $url]
        if {[info exists ::loop]} {
            set uri(host) "localhost:8014"
        } else {
            set uri(host) "localhost:8015"
        }
        set url [eval ::uri::join [array get uri]]
        puts "Redirecting to $url"
        puts $sock "HTTP/1.1 301 Moved Permanently"
        puts $sock "Location: $url"
        puts $sock "Content-Type: text/html"
        puts $sock "Content-Length: 0\n\n"
        close $sock
    } Err]} {
        puts "Socket Error: $Err"
        return
    }
}

Listen 8014

    }
}

package require log
package require tdom 0.8
package require struct::set

package provide WS::Utils 2.3.10

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}

    ## 8.5 or later, so use {*} expansion
    ##
    proc ::WS::Utils::setAttr {node attrList} {
        $node setAttribute {*}$attrList
    }
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Utils::geturl_followRedirects
#
# Description : fetch via http following redirects.
#               May not be used as asynchronous call with -command option.
#
# Arguments :
#       url        - target document url
#       args       - additional argument list to http::geturl call
#
# Returns :     nothing
#
# Side-Effects :        Save final url in redirectArray to forward info to
#                       procedure "processImport".
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald 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  02/24/2011  G. Lester    Initial version
#  2.3.10  11/09/2015  H. Oehlmann  Allow only 5 redirects (loop protection)
#
###########################################################################
proc ::WS::Utils::geturl_followRedirects {url args} {
    ::log::log debug "[info level 0]"

    set initialUrl $url
    set finalUrl $url
    array set URI [::uri::split $url] ;# Need host info from here
    for {set loop 1} {$loop <=5} {incr loop} {
        if {[llength $args]} {
            ::log::log info [concat [list ::http::geturl $url] $args]
            set token [eval [list http::geturl $url] $args]
        } else {
            ::log::log info [list ::http::geturl $url]
            set token [::http::geturl $url]
        }
        set ncode [::http::ncode $token]
        puts **$ncode
        if {![string match {30[12378]} $ncode]} {
            ::log::log debug "initialUrl = $initialUrl, finalUrl = $finalUrl"
            if {![string equal $finalUrl {}]} {
                ::log::log debug "Getting initial URL directory"
                set lastPos [string last / $initialUrl]
                set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
                set lastPos [string last / $finalUrl]
                set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
                ::log::log debug "initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir"
                set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
            }
            return $token
        }
        # http code announces redirect (3xx)
        array set meta [set ${token}(meta)]
        if {![info exist meta(Location)]} {
            ::log::log debug "Redirect http code without Location"
            return $token
        }
        array set uri [::uri::split $meta(Location)]
        unset meta
        array unset meta
        ::http::cleanup $token
        if {[string equal $uri(host) {}]} {
            set uri(host) $URI(host)
        }
        # problem w/ relative versus absolute paths
        set url [eval ::uri::join [array get uri]]
        ::log::log debug "url = $url"
        set finalUrl $url
    }
    # > 5 redirects reached -> exit with error
    return -code error "http redirect limit exceeded"
}

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

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

package ifneeded WS::Embeded 2.3.0 [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]]