Check-in [80103f4d61]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Also use logsubst for the server side
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 80103f4d610c8fa25a97e8bbb471828400082412e02b06853ffce1623604f74a
User & Date: oehhar 2018-06-13 07:47:20
Context
2018-06-13 07:57
Change version numbers of changed files to 2.6.0 check-in: fc8e965f20 user: oehhar tags: trunk, Release_2.6.0
2018-06-13 07:47
Also use logsubst for the server side check-in: 80103f4d61 user: oehhar tags: trunk
2018-05-28 11:16
Add support to translate distant namespace prefixes in attribute values or text values to local correspondances, required for abstract types. Ticket [584bfb77]: client.tcl 2.5.1, utilities.tcl 2.4.2 check-in: e406ab9e21 user: oehhar tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

    37     37   ##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
    38     38   ##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
    39     39   ##  POSSIBILITY OF SUCH DAMAGE.                                              ##
    40     40   ##                                                                           ##
    41     41   ###############################################################################
    42     42   
    43     43   package require Tcl 8.4
    44         -package require WS::Utils 2.4 ; # dict, lassign
           44  +package require WS::Utils 2.4 ; # dict, lassign, logsubst
    45     45   package require tdom 0.8
    46     46   package require http 2
    47     47   package require log
    48     48   package require uri
    49     49   
    50     50   package provide WS::Client 2.5.1
    51     51   

Changes to Embedded.tcl.

    40     40   }
    41     41   
    42     42   package require uri
    43     43   package require base64
    44     44   package require html
    45     45   package require log
    46     46   
    47         -package provide WS::Embeded 2.4.0
           47  +# Emulate the log::logsubst command introduced in log 1.4
           48  +if {![llength [info command ::log::logsubst]]} {
           49  +	proc ::log::logsubst {level text} {
           50  +		if {[::log::lvIsSuppressed $level]} {
           51  +			return
           52  +		}
           53  +		::log::log $level [uplevel 1 [list subst $text]]
           54  +	}
           55  +}
           56  +
           57  +package provide WS::Embeded 2.4.1
    48     58   
    49     59   namespace eval ::WS::Embeded {
    50     60   
    51     61       array set portInfo {}
    52     62   
    53     63       set portList [list]
    54     64       set forever {}
................................................................................
   221    231               -ssl2 1 \
   222    232               -ssl3 1 \
   223    233               -tls1 0 \
   224    234               -require 0 \
   225    235               -request 0
   226    236           set handle [::tls::socket -server [list ::WS::Embeded::accept $port] $port]
   227    237       } else {
   228         -        ::log::log debug [list socket -server [list ::WS::Embeded::accept $port] $port]
          238  +        ::log::logsubst debug {socket -server [list ::WS::Embeded::accept $port] $port}
   229    239           set handle [socket -server [list ::WS::Embeded::accept $port] $port]
   230    240       }
   231    241   
   232    242       return $handle
   233    243   }
   234    244   
   235    245   
................................................................................
   429    439   ###########################################################################
   430    440   proc ::WS::Embeded::checkauth {port sock ip auth} {
   431    441       variable portInfo
   432    442   
   433    443       if {[info exists portInfo($port,auths)] && [llength $portInfo($port,auths)] && [lsearch -exact $portInfo($port,auths) $auth]==-1} {
   434    444           set realm $portInfo($port,realm)
   435    445           respond $sock 401 "" "WWW-Authenticate: Basic realm=\"$realm\"\n"
   436         -        ::log::log warning "Unauthorized from $ip"
          446  +        ::log::logsubst warning {Unauthorized from $ip}
   437    447           return -code error
   438    448       }
   439    449   }
   440    450   
   441    451   
   442    452   ###########################################################################
   443    453   #
................................................................................
   570    580   #
   571    581   #
   572    582   ###########################################################################
   573    583   proc ::WS::Embeded::accept {port sock ip clientport} {
   574    584       variable portInfo
   575    585   
   576    586       upvar #0 ::WS::Embeded::Httpd$sock query
   577         -    ::log::log info "Receviced request on $port for $ip:$clientport"
          587  +    ::log::logsubst info {Receviced request on $port for $ip:$clientport}
   578    588   
   579    589       array unset query reply
   580    590       chan configure $sock -translation crlf
   581    591       if {1 == [catch {
   582    592           gets $sock line
   583         -        ::log::log debug "Request is: $line"
          593  +        ::log::logsubst debug {Request is: $line}
   584    594           set auth {}
   585    595           set request {}
   586    596           while {[gets $sock temp] > 0 && ![eof $sock]} {
   587    597               if {[regexp {^([^:]*):(.*)$} $temp -> key data]} {
   588    598                   dict set request header [string tolower $key] [string trim $data]
   589    599               }
   590    600           }
   591    601           if {[eof $sock]} {
   592         -            ::log::log warning  "Connection closed from $ip"
          602  +            ::log::logsubst warning  {Connection closed from $ip}
   593    603               return
   594    604           }
   595    605           if {[dict exists $request header authorization]} {
   596    606               regexp -nocase {^basic +([^ ]+)$}\
   597    607                   [dict get $request header authorization] -> auth
   598    608           }
   599    609           if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
   600         -            ::log::log warning  "Wrong request: $line"
          610  +            ::log::logsubst warning  {Wrong request: $line}
   601    611               return
   602    612           }
   603    613           switch -exact -- $method {
   604    614               POST {
   605    615                   ##
   606    616                   ## This is all broken and needs to be fixed
   607    617                   ##
................................................................................
   627    637                   #parray query
   628    638                   handler $port $sock $ip [array get query] $auth
   629    639               }
   630    640               GET {
   631    641                   handler $port $sock $ip [uri::split $url] $auth
   632    642               }
   633    643               default {
   634         -                ::log::log warning "Unsupported method '$method' from $ip"
          644  +                ::log::logsubst warning {Unsupported method '$method' from $ip}
   635    645                   respond $sock 501 "Method not implemented"
   636    646               }
   637    647           }
   638    648       } msg]} {
   639    649           ::log::log error "Error: $msg"
   640    650           # catch this against an eventual closed socket
   641    651           catch {respond $sock 500 "Server Error"}
   642    652       }
   643    653   
   644    654       catch {flush $sock}
   645    655       catch {close $sock}
   646    656       return
   647    657   }

Changes to ServerSide.tcl.

    40     40   
    41     41   package require Tcl 8.4
    42     42   package require WS::Utils 2.4 ; # provides dict
    43     43   package require html
    44     44   package require log
    45     45   package require tdom
    46     46   
    47         -package provide WS::Server 2.4.0
           47  +package provide WS::Server 2.4.1
    48     48   
    49     49   namespace eval ::WS::Server {
    50     50       array set ::WS::Server::serviceArr {}
    51     51       set ::WS::Server::procInfo {}
    52     52       set ::WS::Server::mode {}
    53     53   }
    54     54   
................................................................................
   160    160   #
   161    161   ###########################################################################
   162    162   proc ::WS::Server::Service {args} {
   163    163       variable serviceArr
   164    164       variable procInfo
   165    165       variable mode
   166    166   
   167         -    ::log::log debug "Defining Service as $args"
          167  +    ::log::logsubst debug {Defining Service as $args}
   168    168   
   169    169       array set defaults {
   170    170           -description    {}
   171    171           -checkheader    {::WS::Server::ok}
   172    172           -inheaders      {}
   173    173           -outheaders     {}
   174    174           -intransform    {}
................................................................................
   234    234       set mode $defaults(-mode)
   235    235   
   236    236       ##
   237    237       ## Install wsdl doc
   238    238       ##
   239    239       interp alias {} ::WS::Server::generateInfo_${service} \
   240    240                    {} ::WS::Server::generateInfo ${service}
   241         -    ::log::log debug "Installing Generate info for $service at $defaults(-prefix)"
          241  +    ::log::logsubst debug {Installing Generate info for $service at $defaults(-prefix)}
   242    242       switch -exact -- $mode {
   243    243           embedded {
   244    244               package require WS::Embeded 2.1.3
   245    245               foreach port $defaults(-ports) {
   246    246                   ::WS::Embeded::AddHandler $port $defaults(-prefix) ::WS::Server::generateInfo_${service}
   247    247               }
   248    248           }
................................................................................
   310    310   
   311    311   
   312    312       ##
   313    313       ## Install wsdl
   314    314       ##
   315    315       interp alias {} ::WS::Server::generateWsdl_${service} \
   316    316                    {} ::WS::Server::generateWsdl ${service}
   317         -    ::log::log debug "Installing GenerateWsdl info for $service at $defaults(-prefix)/wsdl"
          317  +    ::log::logsubst debug {Installing GenerateWsdl info for $service at $defaults(-prefix)/wsdl}
   318    318       switch -exact -- $mode {
   319    319           embedded {
   320    320               foreach port $defaults(-ports) {
   321    321                   ::WS::Embeded::AddHandler $port $defaults(-prefix)/wsdl ::WS::Server::generateWsdl_${service}
   322    322               }
   323    323           }
   324    324           channel {
................................................................................
   335    335       }
   336    336   
   337    337       ##
   338    338       ## Install operations
   339    339       ##
   340    340       interp alias {} ::WS::Server::callOperation_${service} \
   341    341                    {} ::WS::Server::callOperation ${service}
   342         -    ::log::log debug "Installing callOperation info for $service at $defaults(-prefix)/op"
          342  +    ::log::logsubst debug {Installing callOperation info for $service at $defaults(-prefix)/op}
   343    343       switch -exact -- $mode {
   344    344           embedded {
   345    345               foreach port $defaults(-ports) {
   346    346                   ::WS::Embeded::AddHandler $port $defaults(-prefix)/op ::WS::Server::callOperation_${service}
   347    347               }
   348    348           }
   349    349           channel {
................................................................................
   417    417   #
   418    418   #
   419    419   ###########################################################################
   420    420   proc ::WS::Server::ServiceProc {service nameInfo arglist documentation body} {
   421    421       variable procInfo
   422    422   
   423    423       set name [lindex $nameInfo 0]
   424         -    ::log::log debug "Defining operation $name for $service"
          424  +    ::log::logsubst debug {Defining operation $name for $service}
   425    425       set argOrder {}
   426         -    ::log::log debug "\targs are {$arglist}"
          426  +    ::log::logsubst debug {\targs are {$arglist}}
   427    427       foreach {arg data} $arglist {
   428    428           lappend argOrder $arg
   429    429       }
   430    430       if {![dict exists $procInfo $service op$name argList]} {
   431    431           set tmpList [dict get $procInfo $service operationList]
   432    432           lappend tmpList $name
   433    433           dict set procInfo $service operationList $tmpList
................................................................................
   490    490   proc ::WS::Server::GetWsdl {serviceName {urlPrefix ""}} {
   491    491       variable serviceArr
   492    492       variable procInfo
   493    493   
   494    494       array set serviceData $serviceArr($serviceName)
   495    495   
   496    496       set operList [lsort -dictionary [dict get $procInfo $serviceName operationList]]
   497         -    ::log::log debug "Generating WSDL for $serviceName"
          497  +    ::log::logsubst debug {Generating WSDL for $serviceName}
   498    498       if {![info exists serviceArr($serviceName)]} {
   499    499           set msg "Unknown service '$serviceName'"
   500    500           ::return \
   501    501               -code error \
   502    502               -errorCode [list WS SERVER UNKSERV $serviceName] \
   503    503               $msg
   504    504       }
................................................................................
   710    710       variable serviceArr
   711    711       variable procInfo
   712    712       variable mode
   713    713   
   714    714       array set serviceData $serviceArr($serviceName)
   715    715   
   716    716       set operList [lsort -dictionary [dict get $procInfo $serviceName operationList]]
   717         -    ::log::log debug "Generating WSDL for $serviceName on $sock with {$args}"
          717  +    ::log::logsubst debug {Generating WSDL for $serviceName on $sock with {$args}}
   718    718       if {![info exists serviceArr($serviceName)]} {
   719    719           set msg "Unknown service '$serviceName'"
   720    720           switch -exact -- $mode {
   721    721               tclhttpd {
   722    722                   ::Httpd_ReturnData \
   723    723                       $sock \
   724    724                       "text/html; charset=UTF-8" \
................................................................................
   897    897   ###########################################################################
   898    898   # NOTE: This proc only works with Rivet
   899    899   # TODO: Update to handle jsonp?
   900    900   proc ::WS::Server::generateJsonInfo { service sock args } {
   901    901       variable serviceArr
   902    902       variable procInfo
   903    903   
   904         -    ::log::log debug "Generating JSON Documentation for $service on $sock with {$args}"
          904  +    ::log::logsubst debug {Generating JSON Documentation for $service on $sock with {$args}}
   905    905       set serviceInfo $serviceArr($service)
   906    906       array set serviceData $serviceInfo
   907    907       set doc [yajl create #auto -beautify $serviceData(-beautifyJson)]
   908    908   
   909    909       $doc map_open
   910    910   
   911    911       $doc string operations array_open
................................................................................
   922    922           $doc string description string $description
   923    923   
   924    924           # parameters
   925    925           if {[llength [dict get $procInfo $service op$oper argOrder]]} {
   926    926               $doc string inputs array_open
   927    927               
   928    928               foreach arg [dict get $procInfo $service op$oper argOrder] {
   929         -                ::log::log debug "\t\t\tDisplaying '$arg'"
          929  +                ::log::logsubst debug {\t\t\tDisplaying '$arg'}
   930    930                   if {[dict exists $procInfo $service op$oper argList $arg comment]} {
   931    931                       set comment [dict get $procInfo $service op$oper argList $arg comment]
   932    932                   } else {
   933    933                       set comment {}
   934    934                   }
   935    935   
   936    936                   set type [dict get $procInfo $service op$oper argList $arg type]
................................................................................
   961    961   
   962    962       $doc array_close
   963    963   
   964    964       ::log::log debug "\tDisplay custom types"
   965    965       $doc string types array_open
   966    966       set localTypeInfo [::WS::Utils::GetServiceTypeDef Server $service]
   967    967       foreach type [lsort -dictionary [dict keys $localTypeInfo]] {
   968         -        ::log::log debug "\t\tDisplaying '$type'"
          968  +        ::log::logsubst debug {\t\tDisplaying '$type'}
   969    969   
   970    970           $doc map_open
   971    971           $doc string name string $type
   972    972           $doc string fields array_open
   973    973           
   974    974           set typeDetails [dict get $localTypeInfo $type definition]
   975    975           foreach part [lsort -dictionary [dict keys $typeDetails]] {
   976         -            ::log::log debug "\t\t\tDisplaying '$part'"
          976  +            ::log::logsubst debug {\t\t\tDisplaying '$part'}
   977    977               set subType [dict get $typeDetails $part type]
   978    978               set comment {}
   979    979               if {[dict exists $typeDetails $part comment]} {
   980    980                   set comment [dict get $typeDetails $part comment]
   981    981               }
   982    982               $doc map_open string field string $part string type string $subType string comment string $comment map_close
   983    983           }
................................................................................
  1040   1040   #
  1041   1041   ###########################################################################
  1042   1042   proc ::WS::Server::generateInfo {service sock args} {
  1043   1043       variable serviceArr
  1044   1044       variable procInfo
  1045   1045       variable mode
  1046   1046   
  1047         -    ::log::log debug "Generating HTML Documentation for $service on $sock with {$args}"
         1047  +    ::log::logsubst debug {Generating HTML Documentation for $service on $sock with {$args}}
  1048   1048       if {![info exists serviceArr($service)]} {
  1049   1049           set msg "Unknown service '$service'"
  1050   1050           switch -exact -- $mode {
  1051   1051               tclhttpd {
  1052   1052                   ::Httpd_ReturnData \
  1053   1053                       $sock \
  1054   1054                       "text/html; charset=UTF-8" \
................................................................................
  1278   1278   
  1279   1279       # decide if SOAP or REST mode should be used.
  1280   1280       set flavor "soap"
  1281   1281       if {[lsearch -exact $args "-rest"] != -1} {
  1282   1282           set flavor "rest"
  1283   1283       }
  1284   1284   
  1285         -    ::log::log debug "In ::WS::Server::callOperation {$service $sock $args}"
         1285  +    ::log::logsubst debug {In ::WS::Server::callOperation {$service $sock $args}}
  1286   1286       array set serviceInfo $serviceArr($service)
  1287         -    ::log::log debug "\tDocument is {$inXML}"
         1287  +    ::log::logsubst debug {\tDocument is {$inXML}}
  1288   1288   
  1289   1289       set ::errorInfo {}
  1290   1290       set ::errorCode {}
  1291   1291       set ns $service
  1292   1292   
  1293   1293       set inTransform $serviceInfo(-intransform)
  1294   1294       set outTransform $serviceInfo(-outtransform)
................................................................................
  1324   1324               set first [string first {<} $inXML]
  1325   1325               if {$first > 0} {
  1326   1326                   set inXML [string range $inXML $first end]
  1327   1327               }
  1328   1328               # parse the XML request
  1329   1329               dom parse $inXML doc
  1330   1330               $doc documentElement top
  1331         -            ::log::log debug [list $doc selectNodesNamespaces \
  1332         -                                  [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
  1333         -                                       $service http://$serviceInfo(-host)$serviceInfo(-prefix)]]
         1331  +            ::log::logsubst debug {$doc selectNodesNamespaces \
         1332  +                    [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
         1333  +                    $service http://$serviceInfo(-host)$serviceInfo(-prefix)]}
  1334   1334               $doc selectNodesNamespaces \
  1335   1335                   [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
  1336   1336                        $service http://$serviceInfo(-host)$serviceInfo(-prefix)]
  1337   1337               $doc documentElement rootNode
  1338   1338               
  1339   1339               # extract the name of the method
  1340   1340               set top [$rootNode selectNodes /ENV:Envelope/ENV:Body/*]
................................................................................
  1342   1342               set legacyRpcMode 0
  1343   1343               if {$requestMessage == ""} {
  1344   1344                   # older RPC/Encoded clients need to try nodeName instead.
  1345   1345                   # Python pySoap needs this.
  1346   1346                   catch {$top nodeName} requestMessage
  1347   1347                   set legacyRpcMode 1
  1348   1348               }
  1349         -            ::log::log debug "requestMessage = {$requestMessage}"
         1349  +            ::log::logsubst debug {requestMessage = {$requestMessage} legacyRpcMode=$legacyRpcMode}
  1350   1350               if {[string match {*Request} $requestMessage]} {
  1351   1351                   set operation [string range $requestMessage 0 end-7]
  1352   1352               } else {
  1353   1353                   # broken clients might not have sent the correct Document Wrapped name.
  1354   1354                   # Python pySoap and Perl SOAP::Lite need this.
  1355   1355                   set operation $requestMessage
  1356   1356                   set legacyRpcMode 1
  1357   1357               }
         1358  +            ::log::logsubst debug {operation = '$operation' legacyRpcMode=$legacyRpcMode}
  1358   1359               set contentType "text/xml"
  1359   1360           }
  1360   1361           default {
  1361   1362               if {$errorCallback ne {}} { $errorCallback "BAD_FLAVOR No supported protocol" {} "UnknownMethod" $flavor }
  1362   1363               error "bad flavor"
  1363   1364           }
  1364   1365       }
................................................................................
  1376   1377                       CLIENT \
  1377   1378                       $msg \
  1378   1379                       [list "errorCode" $::errorCode "stackTrace" $::errorInfo] \
  1379   1380                       $flavor]
  1380   1381           catch {$doc delete}
  1381   1382           set httpStatus 404
  1382   1383           if {$errorCallback ne {}} { $errorCallback "UNKNOWN_METHOD $msg" httpStatus $operation $flavor }
  1383         -        ::log::log debug "Leaving @ error 1::WS::Server::callOperation $response"
         1384  +        ::log::logsubst debug {Leaving @ error 1::WS::Server::callOperation $response}
  1384   1385   
  1385   1386           # wrap in JSONP
  1386   1387           if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
  1387   1388               set response "$rawargs(jsonp_callback)($response)"
  1388   1389           }
  1389   1390   
  1390   1391           switch -exact -- $mode {
................................................................................
  1433   1434               rest {
  1434   1435                   set tclArgList {}
  1435   1436                   foreach argName $methodArgs {
  1436   1437                       set argType [string trim [dict get $argInfo $argName type]]
  1437   1438                       set typeInfoList [::WS::Utils::TypeInfo Server $service $argType]
  1438   1439   
  1439   1440                       if {![info exists rawargs($argName)]} {
  1440         -                        ::log::log debug "did not find argument for $argName, leaving blank"
         1441  +                        ::log::logsubst debug {did not find argument for $argName, leaving blank}
  1441   1442                           lappend tclArgList {}
  1442   1443                           continue
  1443   1444                       }
  1444   1445   
  1445   1446                       switch -exact -- $typeInfoList {
  1446   1447                           {0 0} {
  1447   1448                               ## Simple non-array
................................................................................
  1492   1493                           } else {
  1493   1494                               # legacyRpcMode only, access arguments by index
  1494   1495                               set path "legacy argument index $argIndex"
  1495   1496                               set node [lindex [$top childNodes] $argIndex]
  1496   1497                               incr argIndex
  1497   1498                           }
  1498   1499                           if {[string equal $node {}]} {
  1499         -                            ::log::log debug "did not find argument for $argName using $path, leaving blank"
         1500  +                            ::log::logsubst debug {did not find argument for $argName using $path, leaving blank (pass $pass)}
  1500   1501                               lappend tclArgList {}
  1501   1502                               continue
  1502   1503                           }
  1503         -                        ::log::log debug "found argument $argName using $path, processing $node"
         1504  +                        ::log::logsubst debug {found argument $argName using $path, processing $node}
  1504   1505                           set gotAnyArgs 1
  1505   1506                           switch -exact -- $typeInfoList {
  1506   1507                               {0 0} {
  1507   1508                                   ## Simple non-array
  1508   1509                                   lappend tclArgList [$node asText]
  1509   1510                               }
  1510   1511                               {0 1} {
................................................................................
  1530   1531                                   lappend tclArgList $tmp
  1531   1532                               }
  1532   1533                               default {
  1533   1534                                   ## Do nothing
  1534   1535                               }
  1535   1536                           }
  1536   1537                       }
  1537         -                    ::log::log debug "gotAnyArgs $gotAnyArgs, legacyRpcMode $legacyRpcMode"
         1538  +                    ::log::logsubst debug {gotAnyArgs $gotAnyArgs, legacyRpcMode $legacyRpcMode}
  1538   1539                       if {$gotAnyArgs || !$legacyRpcMode} break
  1539   1540                   }
  1540   1541               }
  1541   1542               default {
  1542   1543                   if {$errorCallback ne {}} { $errorCallback "BAD_FLAVOR No supported protocol" {} $operation $flavor }
  1543   1544                   error "invalid flavor"
  1544   1545               }
  1545   1546           }
  1546         -        ::log::log debug "finalargs $tclArgList"
         1547  +        ::log::logsubst debug {finalargs $tclArgList}
  1547   1548       } errMsg]} {
  1548   1549           ::log::log error $errMsg
  1549   1550           set localerrorCode $::errorCode
  1550   1551           set localerrorInfo $::errorInfo
  1551   1552           set response [generateError \
  1552   1553                       $serviceInfo(-traceEnabled) \
  1553   1554                       CLIENT \
  1554   1555                       "Error Parsing Arguments -- $errMsg" \
  1555   1556                       [list "errorCode" $localerrorCode "stackTrace" $localerrorInfo] \
  1556   1557                       $flavor]
  1557   1558           catch {$doc delete}
  1558   1559           set httpStatus 400
  1559   1560           if {$errorCallback ne {}} { $errorCallback "INVALID_ARGUMENT $errMsg" httpStatus $operation $flavor }
  1560         -        ::log::log debug "Leaving @ error 3::WS::Server::callOperation $response"
         1561  +        ::log::logsubst debug {Leaving @ error 3::WS::Server::callOperation $response}
  1561   1562   
  1562   1563           # wrap in JSONP
  1563   1564           if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
  1564   1565               set response "$rawargs(jsonp_callback)($response)"
  1565   1566           }
  1566   1567   
  1567   1568           switch -exact -- $mode {
................................................................................
  1657   1658           }
  1658   1659           if {[info exists serviceInfo(-postmonitor)] &&
  1659   1660               [string length $serviceInfo(-postmonitor)]} {
  1660   1661               set precmd $serviceInfo(-postmonitor)
  1661   1662               lappend precmd POST $service $operation OK $results
  1662   1663               catch $precmd
  1663   1664           }
  1664         -        ::log::log debug "Leaving ::WS::Server::callOperation $response"
         1665  +        ::log::logsubst debug {Leaving ::WS::Server::callOperation $response}
  1665   1666           switch -exact -- $mode {
  1666   1667               tclhttpd {
  1667   1668                   ::Httpd_ReturnData $sock "$contentType; charset=UTF-8" $response 200
  1668   1669               }
  1669   1670               embedded {
  1670   1671                   ::WS::Embeded::ReturnData $sock "$contentType; charset=UTF-8" $response 200
  1671   1672               }
................................................................................
  1704   1705                       CLIENT \
  1705   1706                       $msg \
  1706   1707                       [list "errorCode" $localerrorCode "stackTrace" $localerrorInfo] \
  1707   1708                       $flavor]
  1708   1709           catch {$doc delete}
  1709   1710           set httpStatus 500
  1710   1711           if {$errorCallback ne {}} { $errorCallback $msg httpStatus $operation $flavor }
  1711         -        ::log::log debug "Leaving @ error 2::WS::Server::callOperation $response"
         1712  +        ::log::logsubst debug {Leaving @ error 2::WS::Server::callOperation $response}
  1712   1713   
  1713   1714           # wrap in JSONP
  1714   1715           if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
  1715   1716               set response "$rawargs(jsonp_callback)($response)"
  1716   1717           }
  1717   1718   
  1718   1719           switch -exact -- $mode {
................................................................................
  1786   1787   # Version     Date     Programmer   Comments / Changes / Reasons
  1787   1788   # -------  ----------  ----------   -------------------------------------------
  1788   1789   #       1  07/06/2006  G.Lester     Initial version
  1789   1790   #
  1790   1791   #
  1791   1792   ###########################################################################
  1792   1793   proc ::WS::Server::generateError {includeTrace faultcode faultstring detail flavor} {
  1793         -    ::log::log debug "Entering ::WS::Server::generateError $faultcode $faultstring {$detail}"
         1794  +    ::log::logsubst debug {Entering ::WS::Server::generateError $faultcode $faultstring {$detail}}
  1794   1795       set code [lindex $detail 1]
  1795   1796       switch -exact -- $code {
  1796   1797           "VersionMismatch" {
  1797   1798               set code "SOAP-ENV:VersionMismatch"
  1798   1799           }
  1799   1800           "MustUnderstand" {
  1800   1801               set code "SOAP-ENV:MustUnderstand"
................................................................................
  1853   1854                   [$doc asXML -indent none -doctypeDeclaration 0]
  1854   1855               $doc delete
  1855   1856           }
  1856   1857           default {
  1857   1858               error "unsupported flavor"
  1858   1859           }
  1859   1860       }
  1860         -    ::log::log debug "Leaving (error) ::WS::Server::generateError $response"
         1861  +    ::log::logsubst debug {Leaving (error) ::WS::Server::generateError $response}
  1861   1862       return $response
  1862   1863   }
  1863   1864   
  1864   1865   ###########################################################################
  1865   1866   #
  1866   1867   # Private Procedure Header - as this procedure is modified, please be sure
  1867   1868   #                            that you update this header block. Thanks.
................................................................................
  1898   1899   # Version     Date     Programmer   Comments / Changes / Reasons
  1899   1900   # -------  ----------  ----------   -------------------------------------------
  1900   1901   #       1  07/06/2006  G.Lester     Initial version
  1901   1902   #
  1902   1903   #
  1903   1904   ###########################################################################
  1904   1905   proc ::WS::Server::generateReply {serviceName operation results flavor} {
  1905         -    ::log::log debug "Entering ::WS::Server::generateReply $serviceName $operation {$results}"
         1906  +    ::log::logsubst debug {Entering ::WS::Server::generateReply $serviceName $operation {$results}}
  1906   1907   
  1907   1908       variable serviceArr
  1908   1909   
  1909   1910       array set serviceData $serviceArr($serviceName)
  1910   1911   
  1911   1912   
  1912   1913       switch -exact -- $flavor {
................................................................................
  1960   1961               $doc delete
  1961   1962           }
  1962   1963           default {
  1963   1964               error "Unsupported flavor"
  1964   1965           }
  1965   1966       }
  1966   1967   
  1967         -    ::log::log debug "Leaving ::WS::Server::generateReply $output"
         1968  +    ::log::logsubst debug {Leaving ::WS::Server::generateReply $output}
  1968   1969       return $output
  1969   1970   
  1970   1971   }
  1971   1972   
  1972   1973   ###########################################################################
  1973   1974   #
  1974   1975   # Private Procedure Header - as this procedure is modified, please be sure
................................................................................
  2211   2212       foreach oper [lsort -dictionary [dict get $procInfo $service operationList]] {
  2212   2213           lappend operList $oper "#op_$oper"
  2213   2214       }
  2214   2215       append msg [::html::h2 {<a id='OperDetails'>Operation Details</a>}]
  2215   2216   
  2216   2217       set docFormat [dict get $serviceInfo -docFormat]
  2217   2218       foreach {oper anchor} $operList {
  2218         -        ::log::log debug "\t\tDisplaying '$oper'"
         2219  +        ::log::logsubst debug {\t\tDisplaying '$oper'}
  2219   2220           append msg [::html::h3 "<a id='op_$oper'>$oper</a>"]
  2220   2221   
  2221   2222           append msg [::html::h4 {Description}] "\n"
  2222   2223   
  2223   2224           append msg [::html::openTag div {style="margin-left: 40px;"}]
  2224   2225           switch -exact -- $docFormat {
  2225   2226               "html" {
................................................................................
  2238   2239   
  2239   2240           append msg [::html::openTag div {style="margin-left: 40px;"}]
  2240   2241   
  2241   2242           if {[llength [dict get $procInfo $service op$oper argOrder]]} {
  2242   2243               append msg [::html::openTag {table} {border="2"}]
  2243   2244               append msg [::html::hdrRow Name Type Description]
  2244   2245               foreach arg [dict get $procInfo $service op$oper argOrder] {
  2245         -                ::log::log debug "\t\t\tDisplaying '$arg'"
         2246  +                ::log::logsubst debug {\t\t\tDisplaying '$arg'}
  2246   2247                   if {[dict exists $procInfo $service op$oper argList $arg comment]} {
  2247   2248                       set comment [dict get $procInfo $service op$oper argList $arg comment]
  2248   2249                   } else {
  2249   2250                       set comment {}
  2250   2251                   }
  2251   2252                   append msg [::html::row \
  2252   2253                                   $arg \
................................................................................
  2340   2341       ##
  2341   2342       ::log::log debug "\tDisplay custom types"
  2342   2343       set service [dict get $serviceInfo -service]
  2343   2344       append msg [::html::h2 {<a id='CustomTypeDetails'>Custom Types</a>}]
  2344   2345   
  2345   2346       set localTypeInfo [::WS::Utils::GetServiceTypeDef Server $service]
  2346   2347       foreach type [lsort -dictionary [dict keys $localTypeInfo]] {
  2347         -        ::log::log debug "\t\tDisplaying '$type'"
         2348  +        ::log::logsubst debug {\t\tDisplaying '$type'}
  2348   2349           set href_type [lindex [split $type :] end]
  2349   2350           set typeOverloadArray($type) 1
  2350   2351           append msg [::html::h3 "<a id='type_${href_type}'>$type</a>"]
  2351   2352           set typeDetails [dict get $localTypeInfo $type definition]
  2352   2353           append msg [::html::openTag {table} {border="2"}]
  2353   2354           append msg [::html::hdrRow Field Type Comment]
  2354   2355           foreach part [lsort -dictionary [dict keys $typeDetails]] {
  2355         -            ::log::log debug "\t\t\tDisplaying '$part'"
         2356  +            ::log::logsubst debug {\t\t\tDisplaying '$part'}
  2356   2357               if {[dict exists $typeDetails $part comment]} {
  2357   2358                   set comment [dict get $typeDetails $part comment]
  2358   2359               } else {
  2359   2360                   set comment {}
  2360   2361               }
  2361   2362               append msg [::html::row \
  2362   2363                               $part \
................................................................................
  2424   2425       set service [dict get $serviceInfo -service]
  2425   2426       append msg [::html::h2 {<a id='SimpleTypeDetails'>Simple Types</a>}]
  2426   2427   
  2427   2428       append msg "\n<br/>\n<center>" [::html::minorMenu $menuList] "</center>"
  2428   2429       set localTypeInfo [::WS::Utils::GetServiceSimpleTypeDef Server $service]
  2429   2430       foreach typeDetails [lsort -dictionary -index 0 $localTypeInfo] {
  2430   2431           set type [lindex $typeDetails 0]
  2431         -        ::log::log debug "\t\tDisplaying '$type'"
         2432  +        ::log::logsubst debug {\t\tDisplaying '$type'}
  2432   2433           set typeOverloadArray($type) 1
  2433   2434           append msg [::html::h3 "<a id='type_$type'>$type</a>"]
  2434   2435           append msg [::html::openTag {table} {border="2"}]
  2435   2436           append msg [::html::hdrRow Attribute Value]
  2436   2437           foreach part [lsort -dictionary [dict keys [lindex $typeDetails 1]]] {
  2437         -            ::log::log debug "\t\t\tDisplaying '$part'"
         2438  +            ::log::logsubst debug {\t\t\tDisplaying '$part'}
  2438   2439               append msg [::html::row \
  2439   2440                               $part \
  2440   2441                               [dict get [lindex $typeDetails 1] $part]
  2441   2442                          ]
  2442   2443           }
  2443   2444           append msg [::html::closeTag]
  2444   2445       }
  2445   2446       append msg "\n<hr/>\n"
  2446   2447   
  2447   2448       return $msg
  2448   2449   }

Changes to Utilities.tcl.

    55     55       }
    56     56   }
    57     57   
    58     58   package require log
    59     59   
    60     60   # Emulate the log::logsubst command introduced in log 1.4
    61     61   if {![llength [info command ::log::logsubst]]} {
    62         -    if {![llength [info command ::tailcall]]} {
    63         -        proc ::log::logsubst {level text} {
    64         -            if {[::log::lvIsSuppressed $level]} {
    65         -                return
    66         -            }
    67         -            ::log::log $level [uplevel 1 [list subst $text]]
    68         -        }
    69         -    } else {
    70         -        proc ::log::logsubst {level text} {
    71         -            if {[::log::lvIsSuppressed $level]} {
    72         -                return
    73         -            }
    74         -            tailcall ::log::log $level [uplevel 1 [list subst $text]]
    75         -        }
    76         -    }
           62  +	proc ::log::logsubst {level text} {
           63  +		if {[::log::lvIsSuppressed $level]} {
           64  +			return
           65  +		}
           66  +		::log::log $level [uplevel 1 [list subst $text]]
           67  +	}
    77     68   }
    78     69   
    79     70   package require tdom 0.8
    80     71   package require struct::set
    81     72   
    82     73   package provide WS::Utils 2.4.2
    83     74   

Changes to pkgIndex.tcl.

     7      7   # in response to "package require" commands.  When this
     8      8   # script is sourced, the variable $dir must contain the
     9      9   # full path name of this file's directory.
    10     10   
    11     11   package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
    12     12   package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
    13     13   package ifneeded WS::Client 2.5.1 [list source [file join $dir ClientSide.tcl]]
    14         -package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
    15         -package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
           14  +package ifneeded WS::Embeded 2.4.1 [list source [file join $dir Embedded.tcl]]
           15  +package ifneeded WS::Server 2.4.1 [list source [file join $dir ServerSide.tcl]]
    16     16   package ifneeded WS::Utils 2.4.2 [list source [file join $dir Utilities.tcl]]
    17     17   package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
    18     18   package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]