Check-in [ba63c62ab5]
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:Bug fix: [68310fe3bd] - Content Length wrong
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ba63c62ab56da9d37100be0e402947c79b138c82
User & Date: gerald 2012-10-31 14:19:03
Context
2012-10-31 14:37
Bug fix [66fb3aeef5] -- correct header parsing check-in: b2b280b87e user: gerald tags: trunk
2012-10-31 14:19
Bug fix: [68310fe3bd] - Content Length wrong check-in: ba63c62ab5 user: gerald tags: trunk
2012-10-31 06:42
Enhancement: [98ce08579d] -- Return socket hadle by ::WS::Embeded::Listen check-in: b9290820be user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Embedded.tcl.

542
543
544
545
546
547
548

549
550
551
552
553
554
555
...
568
569
570
571
572
573
574
575






576
577
578
579
580
581



582
583
584
585
586
587
588
589
# 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::handler {port sock ip reqstring auth} {
    variable portInfo
    upvar #0 ::WS::Embeded::Httpd$sock req

................................................................................
        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 data [dict get $req(reply) data]






            set reply "HTTP/1.0 [dict get $req(reply) code] ???\n"
            append reply "Content-Type: [dict get $req(reply) type]; charset=UTF-8\n"
            append reply "Connection: close\n"
            append reply "Content-length: [string length $data]\n"
            append reply "\n"
            append reply $data



            puts -nonewline $sock $reply
            $portInfo($port,logger) ok
        }
    } else {
        $portInfo($port,logger) {404 Error}
        respond $sock 404 Error "Error"
    }







>







 







|
>
>
>
>
>
>

|


<
<
>
>
>
|







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
...
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
# 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
#   2.3.0  10/31/2012  G.Lester     bug fix for [68310fe3bd] -- correct encoding and data length
#
#
###########################################################################
proc ::WS::Embeded::handler {port sock ip reqstring auth} {
    variable portInfo
    upvar #0 ::WS::Embeded::Httpd$sock req

................................................................................
        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"
    }

Changes to ServerSide.tcl.

700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
...
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
...
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
....
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
....
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
....
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
                    "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 \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            channel {
                ::WS::Channel::ReturnData \
                    $sock \
                    text/html \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            rivet {
                headers type text/html
                headers numeric 404
                puts "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>"
................................................................................
                set urlPrefix [lindex $s(self) 0]://$s(mime,host)
            }
            set xml [GetWsdl $serviceName $urlPrefix]
            ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 200
        }
        channel {
            set xml [GetWsdl $serviceName]
            ::WS::Channel::ReturnData $sock text/xml $xml 200
        }
        embedded {
            set xml [GetWsdl $serviceName]
            ::WS::Embeded::ReturnData $sock text/xml $xml 200
        }
        rivet {
            set xml [GetWsdl $serviceName]
            headers type text/xml
            headers numeric 200
            puts $xml
        }
................................................................................
                    "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 \
                    "<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 $msg 200
        }
        channel {
            ::WS::Channel::ReturnData $sock text/html $msg 200
        }
        rivet {
            headers numeric 200
            headers type text/html
            puts $msg
        }
        aolserver {
................................................................................
        catch {$doc delete}
        ::log::log debug "Leaving @ error 1::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock text/xml $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
................................................................................
        catch {$doc delete}
        ::log::log debug "Leaving @ error 3::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock text/xml $xml 500
            }
            channel {
                ::WS::Channel::ReturnData $sock text/xml $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
................................................................................
        }
        ::log::log debug "Leaving ::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            embedded {
                ::WS::Embeded::ReturnData $sock text/xml $xml 200
            }
            channel {
                ::WS::Channel::ReturnData $sock text/xml $xml 200
            }
            rivet {
                headers type text/xml
                headers numeric 200
                puts $xml
            }
            aolserver {
................................................................................
        catch {$doc delete}
        ::log::log debug "Leaving @ error 2::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock text/xml $xml 500
            }
            channel {
                ::WS::Channel::ReturnData $sock text/xml $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {






|






|







 







|



|







 







|







 







|


|







 







|







 







|


|







 







|


|







 







|


|







700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
...
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
...
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
....
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
....
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
....
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
                    "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/xml; charset=UTF-8" \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            rivet {
                headers type text/html
                headers numeric 404
                puts "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>"
................................................................................
                set urlPrefix [lindex $s(self) 0]://$s(mime,host)
            }
            set xml [GetWsdl $serviceName $urlPrefix]
            ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 200
        }
        channel {
            set xml [GetWsdl $serviceName]
            ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
        }
        embedded {
            set xml [GetWsdl $serviceName]
            ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
        }
        rivet {
            set xml [GetWsdl $serviceName]
            headers type text/xml
            headers numeric 200
            puts $xml
        }
................................................................................
                    "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 {
................................................................................
        catch {$doc delete}
        ::log::log debug "Leaving @ error 1::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
................................................................................
        catch {$doc delete}
        ::log::log debug "Leaving @ error 3::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            channel {
                ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
................................................................................
        }
        ::log::log debug "Leaving ::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            channel {
                ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            rivet {
                headers type text/xml
                headers numeric 200
                puts $xml
            }
            aolserver {
................................................................................
        catch {$doc delete}
        ::log::log debug "Leaving @ error 2::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            channel {
                ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {