Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Partial fix of Embedded code. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
fb1d392a79b2ba6a916ba077cdfb547a |
| User & Date: | gerald 2012-01-03 02:05:50 |
Context
| 2012-01-06 03:54 | Fixes to Embedded Server mode/package and to Utils package. check-in: 468f6b66dc user: gerald tags: trunk, Release_2.1.3 | |
| 2012-01-03 02:05 | Partial fix of Embedded code. check-in: fb1d392a79 user: gerald tags: trunk | |
| 2011-12-29 17:06 | Correction to version number typo and undefined funtion in utils. check-in: 118f3fb5b0 user: gerald tags: trunk, Release_2.1.2 | |
Changes
Changes to Embedded.tcl.
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 ... 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 ... 212 213 214 215 216 217 218 219 220 221 222 223 224 225 ... 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 ... 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 |
## ## ############################################################################### package require uri package require base64 package require html package provide WS::Embeded 2.0.0 namespace eval ::WS::Embeded { array set portInfo {} set portList [list] set forever {} ................................................................................ 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]] } if {$certfile ne ""} { package require tls ::tls::init \ -certfile $certfile \ ................................................................................ -ssl2 1 \ -ssl3 1 \ -tls1 0 \ -require 0 \ -request 0 ::tls::socket -server [list ::WS::Embeded::accept $port] $port } else { socket -server [list ::WS::Embeded::accept $port] $port } } ########################################################################### # ................................................................................ # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 03/28/2008 G.Lester Initial version # # ########################################################################### proc ::WS::Embeded::logger {args} { puts $args puts $::errorInfo } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. ................................................................................ # 1 03/28/2008 G.Lester Initial version # # ########################################################################### proc ::WS::Embeded::accept {port sock ip clientport} { variable portInfo if {[catch { gets $sock line set auth "" for {set c 0} {[gets $sock temp]>=0 && $temp ne "\r" && $temp ne ""} {incr c} { regexp {Authorization: Basic ([^\r\n]+)} $temp -- auth if {$c == 30} { $portInfo($port,logger) "Too many lines from $ip" } } if {[eof $sock]} { $portInfo($port,logger) "Connection closed from $ip" } foreach {method url version} $line { break } switch -exact $method { GET { handler $port $sock $ip [uri::split $url] $auth } default { $portInfo($port,logger) "Unsupported method '$method' from $ip" } } } msg]} { $portInfo($port,logger) "Error: $msg" } catch {flush $sock} catch {close $sock} return; } |
| | > | | > > > > | | > > > > > > > > > > > > > > > > > > |
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 ... 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 ... 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 ... 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 ... 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 |
## ## ############################################################################### package require uri package require base64 package require html package provide WS::Embeded 2.1.0 namespace eval ::WS::Embeded { array set portInfo {} set portList [list] set forever {} ................................................................................ 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] } if {$certfile ne ""} { package require tls ::tls::init \ -certfile $certfile \ ................................................................................ -ssl2 1 \ -ssl3 1 \ -tls1 0 \ -require 0 \ -request 0 ::tls::socket -server [list ::WS::Embeded::accept $port] $port } else { $portInfo($port,logger) [list socket -server [list ::WS::Embeded::accept $port] $port] socket -server [list ::WS::Embeded::accept $port] $port } } ########################################################################### # ................................................................................ # 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. ................................................................................ # 1 03/28/2008 G.Lester Initial version # # ########################################################################### proc ::WS::Embeded::accept {port sock ip clientport} { variable portInfo $portInfo($port,logger) "Receviced request on $port for $ip:$clientport" if {[catch { gets $sock line $portInfo($port,logger) "Request is: $line" set auth {} for {set c 0} {[gets $sock temp]>=0 && $temp ne "\r" && $temp ne ""} {incr c} { regexp {Authorization: Basic ([^\r\n]+)} $temp -- auth if {$c == 30} { $portInfo($port,logger) "Too many lines from $ip" } } 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 ## upvar #0 ::WS::Embeded::Httpd$sock query set query(data) {} parray query fconfigure $sock -blocking 0 while 1 { set cnt [gets $sock line] puts stdout $line puts stdout "Cnt = $cnt. Eof = [eof $sock]" flush stdout lappend query(data) $line } handler $port $sock $ip [uri::split $url] $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; } |
Changes to Examples/Echo/CallEchoWebService.tcl.
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
## 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. ##
## ##
###############################################################################
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"
set inputs [list TestString $testString]
##
## Call synchronously
##
puts stdout "Calling SimpleEcho via DoCalls!"
set results [::WS::Client::DoCall wsEchoExample SimpleEcho $inputs]
puts stdout "\t Received: {$results}"
puts stdout "Calling ComplexEcho via DoCalls!"
set results [::WS::Client::DoCall wsEchoExample ComplexEcho $inputs]
puts stdout "\t Received: {$results}"
|
> | > |
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
## 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. ## ## ## ############################################################################### package require WS::Utils 2.1.2 package require WS::Client 2.1.2 ## ## Get Definition of the offered services ## ::WS::Client::GetAndParseWsdl http://localhost:8015/service/wsEchoExample/wsdl set testString "This is a test" set inputs [list TestString $testString] ## ## Call synchronously ## puts stdout "Calling SimpleEcho via DoCalls!" ::log::lvSuppressLE debug 0 set results [::WS::Client::DoCall wsEchoExample SimpleEcho $inputs] puts stdout "\t Received: {$results}" puts stdout "Calling ComplexEcho via DoCalls!" set results [::WS::Client::DoCall wsEchoExample ComplexEcho $inputs] puts stdout "\t Received: {$results}" |
Added Examples/Echo/EchoEmbeddedService.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 |
############################################################################### ## ## ## Copyright (c) 2006, Visiprise Software, Inc ## ## All rights reserved. ## ## ## ## Redistribution and use in source and binary forms, with or without ## ## modification, are permitted provided that the following conditions ## ## are met: ## ## ## ## * Redistributions of source code must retain the above copyright ## ## notice, this list of conditions and the following disclaimer. ## ## * Redistributions in binary form must reproduce the above ## ## copyright notice, this list of conditions and the following ## ## disclaimer in the documentation and/or other materials provided ## ## with the distribution. ## ## * Neither the name of the Visiprise Software, Inc nor the names ## ## of its contributors may be used to endorse or promote products ## ## derived from this software without specific prior written ## ## permission. ## ## ## ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ## ## "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ## ## LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS ## ## FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ## ## COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, ## ## INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, ## ## BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; ## ## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER ## ## 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. ## ## ## ############################################################################### package require WS::Server 2.1.2 package require WS::Utils 2.1.2 package require WS::Embeded 2.0.0 ## ## Define the service ## ::WS::Server::Service \ -service wsEchoExample \ -description {Echo Example - Tcl Web Services} \ -host localhost:8015 \ -mode embedded \ -ports [list 8015] ## ## Define any special types ## ::WS::Utils::ServiceTypeDef Server wsEchoExample echoReply { echoBack {type string} echoTS {type dateTime} } ## ## Define the operations available ## ::WS::Server::ServiceProc \ wsEchoExample \ {SimpleEcho {type string comment {Requested Echo}}} \ { TestString {type string comment {The text to echo back}} } \ {Echo a string back} { return [list SimpleEchoResult $TestString] } ::WS::Server::ServiceProc \ wsEchoExample \ {ComplexEcho {type echoReply comment {Requested Echo -- text and timestamp}}} \ { TestString {type string comment {The text to echo back}} } \ {Echo a string and a timestamp back} { set timeStamp [clock format [clock seconds] -format {%Y-%m-%dT%H:%M:%SZ} -gmt yes] return [list ComplexEchoResult [list echoBack $TestString echoTS $timeStamp] ] } set ::errorInfo {} ::WS::Embeded::Listen 8015 set ::errorInfo {} puts stdout {Starting event loop} flush stdout ::WS::Embeded::Start puts stdout {Exited event loop} flush stdout |
Changes to Utilities.tcl.
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
....
4084
4085
4086
4087
4088
4089
4090
4091
|
set tmpInfo [GetServiceTypeDef $mode $service [string trimright $itemType {()}]]
if {[dict exists $tmpInfo xns]} {
set itemXns [dict get $tmpInfo xns]
} else {
set itemXns $xns
}
set attrList {}
if {![string equal $itemXns $xns]} {
if {[string equal $mode Client]} {
lappend attrList xmlns [::WS::Client::GetNameSpace $service $itemXns]
} else {
lappend attrList xmlns [::WS::Server::GetNameSpace $service $itemXns]
}
}
foreach key [dict keys $itemDef] {
if {[lsearch -exact $standardAttributes $key] == -1} {
lappend attrList $key [dict get $itemDef $key]
::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
}
}
................................................................................
}
# problem w/ relative versus absolute paths
set url [eval ::uri::join [array get uri]]
::log::log debug "url = $url"
set finalUrl $url
}
}
|
>
|
|
|
|
<
>
>
<
|
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
....
4086
4087
4088
4089
4090
4091
4092
|
set tmpInfo [GetServiceTypeDef $mode $service [string trimright $itemType {()}]]
if {[dict exists $tmpInfo xns]} {
set itemXns [dict get $tmpInfo xns]
} else {
set itemXns $xns
}
set attrList {}
::log::log debug [list string equal $itemXns $xns]
if {![string equal $itemXns $xns]} {
#if {[string equal $mode Client]} {
# lappend attrList xmlns [::WS::Client::GetNameSpace $service $itemXns]
#} else {
# lappend attrList xmlns [::WS::Server::GetNameSpace $service $itemXns]
#}
set xns $itemXns
}
foreach key [dict keys $itemDef] {
if {[lsearch -exact $standardAttributes $key] == -1} {
lappend attrList $key [dict get $itemDef $key]
::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
}
}
................................................................................
}
# problem w/ relative versus absolute paths
set url [eval ::uri::join [array get uri]]
::log::log debug "url = $url"
set finalUrl $url
}
}
|
Changes to docs/Embedded Web Service.html.
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
<A name=Stop></A>
<H2>Stop Listening for Requests</H2>
<P><B>Procedure Name : <I>::WS::Embeded::Start</I></B> </P>
<P><B>Description</B> : Stop listening on all ports (i.e. enter the event loop). </P>
<P><B>Arguments</B> :</P>
<PRE>
value -- Value that ::WS::Embedded::Start should return
</PRE>
<P><B>Returns</B> : Nothing </P>
<P><B>Side-Effects</B> : Nothing</P>
<P><B>Exception Conditions</B> : None </P>
<P><B>Pre-requisite Conditions</B> : </P>
<ul>
<p>::WS::Embeded::Start should have been called.</p>
</ul>
</BODY>
</HTML>
|
| |
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
<A name=Stop></A>
<H2>Stop Listening for Requests</H2>
<P><B>Procedure Name : <I>::WS::Embeded::Start</I></B> </P>
<P><B>Description</B> : Stop listening on all ports (i.e. enter the event loop). </P>
<P><B>Arguments</B> :</P>
<PRE>
value -- Value that ::WS::Embedded::Stop should return
</PRE>
<P><B>Returns</B> : Nothing </P>
<P><B>Side-Effects</B> : Nothing</P>
<P><B>Exception Conditions</B> : None </P>
<P><B>Pre-requisite Conditions</B> : </P>
<ul>
<p>::WS::Embeded::Start should have been called.</p>
</ul>
</BODY>
</HTML>
|