Posted to tcl by aspect at Fri Jul 04 23:08:55 GMT 2014view pretty

# a simple transchan to log everything that's written
# supports [read] as well, so it can be used on bidirectional chans
namespace eval logchan {
    proc initialize args {
        info procs
    }
    proc finalize args {}
    proc clear args {}
    proc write {x h data} {
        uplevel #0 $x [list $data]
        return $data
    }
    proc read {x h data} {
        return $data
    }

    namespace export *
    namespace ensemble create -parameters x
}

# test using logchan with http and tls
proc test {} {

    package require http 2.7
    #source http.tcl
    package require tls
    proc ::http::Log {args} {puts "HTTP: $args"}

    proc tlssock args {
        set r [::tls::socket {*}$args]
        set cmdPrefix [string map [list :R $r] {apply {{data} {
            puts "SENDING :R: $data"
        }}}]
        chan push $r [list logchan $cmdPrefix]
        return $r
    }

    proc ssock args {
        set r [socket {*}$args]
        set cmdPrefix [string map [list :R $r] {apply {{data} {
            puts "SENDING :R: $data"
        }}}]
        chan push $r [list logchan $cmdPrefix]
        return $r
    }

    http::register http 80 ssock
    http::register https 443 tlssock

    # this one is fine:
    set tok [::http::geturl http://google.com]
    upvar 1 $tok state
    puts "http: $state(http)"
    ::http::cleanup $tok

    # this gets an error calling [flush] in http::Connected:
    set tok [::http::geturl https://google.com]
    upvar 1 $tok state
    puts "https: $state(http)"
    ::http::cleanup $tok
}
test