Check-in [0bdb608566]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Corrections for Embedded Mode.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0bdb60856617ece4b24f82950cd89115fc1e023c
User & Date: gerald 2012-11-02 05:06:05
Context
2012-11-04 19:20
Move default content type to a configurable option. check-in: df85e4e49c user: gerald tags: trunk
2012-11-02 05:06
Corrections for Embedded Mode. check-in: 0bdb608566 user: gerald tags: trunk
2012-10-31 14:37
Bug fix [66fb3aeef5] -- correct header parsing check-in: b2b280b87e user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Embedded.tcl.

32
33
34
35
36
37
38

39
40
41
42
43
44
45
...
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
...
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
...
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
...
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
...
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
...
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
...
688
689
690
691
692
693
694

695
696
697
698
699
700

701
702
703
704
705
706
##  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;
}






>







 







|

<







 







|




|







 







|







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|







 







|



|
|

|









|
|


|







 







|





|



|
|
|
>

|
>
>

<
>
>
>
>
>
>
>
>
>
>







 







>
|



|
|
>




|

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
158
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
...
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
...
269
270
271
272
273
274
275









































































































































276
277
278
279
280
281
282
...
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
...
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
...
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
...
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528

529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

package require uri
package require base64
package require html
package require log

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:password
#       realm    -- The security realm

#
# 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 {}}} {
    variable portInfo
    variable portList

    lappend portList $port
    foreach key {port certfile keyfile userpwds realm} {
        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 {
        ::log::log debug [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;
}










































































































































 
###########################################################################
#
# 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"
        ::log::log warning "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}]} {
        ::log::log warning {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]} {
            ::log::log error [list 404 b $msg]
            respond $sock 404 Error $msg
        } else {
            set type [dict get $req(reply) type]
            set encoding [string tolower [lindex [split [lindex [split $type {;}] 1] {=}] 1]]
            if {$encoding ni [encoding names]} {
                set encoding utf-8
                set type "[lindex [split $type ";"] 0]; 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 $data
            ::log::log debug ok
        }
    } else {
        ::log::log warning {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
    ::log::log info "Receviced request on $port for $ip:$clientport"

    array unset query reply
    chan configure $sock -translation crlf
    if {[catch {
        gets $sock line
        ::log::log debug "Request is: $line"
        set auth {}
        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]} {
            ::log::log warning  "Connection closed from $ip"
            catch {close $sock}
            return;
        }

        if {[dict exists $request header authorization]} {
            regexp -nocase {^basic +([^ ]+)$}\
                [dict get $request header authorization] -> auth
        }
        if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
            respond $sock 400 Error "Wrong request"
            ::log::log warning  "Wrong request: $line"
            catch {close $sock}
            return
        }
        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 {
                respond $sock 501 Error "Method not implemented"
                ::log::log warning "Unsupported method '$method' from $ip"
            }
        }
    } msg]} {
        ::log::log error "Error: $msg"
        # catch this against an eventual closed socket
        catch {respond $sock 500 Error "Server error"}
    }

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

Changes to ServerSide.tcl.

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
...
197
198
199
200
201
202
203

















204
205
206
207
208
209
210
...
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
...
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
    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}
................................................................................
        -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]} {
................................................................................
            -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 {






<







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|


|







159
160
161
162
163
164
165

166
167
168
169
170
171
172
...
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
...
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
...
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
...
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
    variable serviceArr
    variable procInfo
    variable mode

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

    array set defaults {

        -description    {}
        -checkheader    {::WS::Server::ok}
        -inheaders      {}
        -outheaders     {}
        -intransform    {}
        -outtransform   {}
        -htmlhead       {TclHttpd Based Web Services}
................................................................................
        -stylesheet     {}
    }
    array set defaults $args
    if {[string equal $defaults(-mode) channel]} {
        set defaults(-ports) {stdin stdout}
        array set defaults $args
    }
    set requiredList {-service}
    set missingList {}
    foreach opt $requiredList {
        if {![info exists defaults($opt)]} {
            lappend missingList $opt
        }
    }
    if {[llength $missingList]} {
................................................................................
            -errorcode [list WSSERVER MISSREQARG $missingList] \
            "Missing required arguments '[join $missingList {,}]'"
    }
    set service $defaults(-service)
    if {![info exists defaults(-prefix)]} {
        set defaults(-prefix) /service/$service
    }
    # find default host
    if {![info exists defaults(-host)]} {
	switch -exact -- $defaults(-mode) {
	    embedded {
		set me [socket -server garbage_word -myaddr [info hostname] 0]
    		set defaults(-host) [lindex [fconfigure $me -sockname] 0]
	    	close $me
	    	if {0 !=[llength $defaults(-ports)] && 80 != [lindex $defaults(-ports) 0]} {
        	    append defaults(-host) ":[lindex $defaults(-ports) 0]"
	    	}
            }
	    default {
	    	set defaults(-host) localhost
            }
	}
    }

    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/html; 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/html; charset=UTF-8" $msg 200
        }
        channel {
            ::WS::Channel::ReturnData $sock "text/html; charset=UTF-8" $msg 200
        }
        rivet {
            headers numeric 200
            headers type text/html
            puts $msg
        }
        aolserver {

Changes to pkgIndex.tcl.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# 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]]






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# 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.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]]

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