diff options
| -rw-r--r-- | library/http/http.tcl | 257 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 6 | ||||
| -rw-r--r-- | tests/http.test | 5 | ||||
| -rw-r--r-- | tests/http11.test | 579 | ||||
| -rw-r--r-- | tests/httpd11.tcl | 225 | ||||
| -rw-r--r-- | unix/Makefile.in | 6 | ||||
| -rw-r--r-- | win/Makefile.in | 8 | ||||
| -rw-r--r-- | win/makefile.bc | 6 | ||||
| -rw-r--r-- | win/makefile.vc | 11 | ||||
| -rw-r--r-- | win/rules.vc | 30 |
10 files changed, 997 insertions, 136 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index f40221e..8de0a9d 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,12 +8,12 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: http.tcl,v 1.74 2009/04/09 17:01:38 dgp Exp $ +# RCS: @(#) $Id: http.tcl,v 1.75 2009/04/10 14:19:44 patthoyts Exp $ -package require Tcl 8.4 +package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.7.3 +package provide http 2.8.0 namespace eval http { # Allow resourcing to not clobber existing data @@ -27,7 +27,13 @@ namespace eval http { -proxyfilter http::ProxyRequired -urlencoding utf-8 } - set http(-useragent) "Tcl http client package [package provide http]" + # We need a useragent string of this style or various servers will refuse to + # send us compressed content even when we ask for it. This follows the + # de-facto layout of user-agent strings in current browsers. + set http(-useragent) "Mozilla/5.0\ + ([string totitle $::tcl_platform(platform)]; U;\ + $::tcl_platform(os) $::tcl_platform(osVersion))\ + http/[package provide http] Tcl/[package provide Tcl]" } proc init {} { @@ -94,7 +100,7 @@ namespace eval http { # Arguments: # msg Message to output # -proc http::Log {args} {} +if {[info command http::Log] eq {}} { proc http::Log {args} {} } # http::register -- # @@ -649,7 +655,11 @@ proc http::geturl {url args} { if {[info exists state(-method)] && $state(-method) ne ""} { set how $state(-method) } - + # We cannot handle chunked encodings with -handler, so force HTTP/1.0 + # until we can manage this. + if {[info exists state(-handler)]} { + set state(-protocol) 1.0 + } if {[catch { puts $sock "$how $srvurl HTTP/$state(-protocol)" puts $sock "Accept: $http(-accept)" @@ -693,14 +703,8 @@ proc http::geturl {url args} { puts $sock "$key: $value" } } - # Soft zlib dependency check - no package require - if { - !$accept_encoding_seen && - ([package vsatisfies [package provide Tcl] 8.6] - || [llength [package provide zlib]]) && - !([info exists state(-channel)] || [info exists state(-handler)]) - } then { - puts $sock "Accept-Encoding: gzip, identity, *;q=0.1" + if {!$accept_encoding_seen && ![info exists state(-handler)]} { + puts $sock "Accept-Encoding: deflate,gzip,compress" } if {$isQueryChannel && $state(querylength) == 0} { # Try to determine size of data in channel. If we cannot seek, the @@ -1009,22 +1013,16 @@ proc http::Event {sock token} { # Turn off conversions for non-text data set state(binary) 1 } - if { - $state(binary) || [string match *gzip* $state(coding)] || - [string match *compress* $state(coding)] - } then { - if {[info exists state(-channel)]} { + if {[info exists state(-channel)]} { + if {$state(binary) || [llength [ContentEncoding $token]]} { fconfigure $state(-channel) -translation binary } - } - if { - [info exists state(-channel)] && - ![info exists state(-handler)] - } then { - # Initiate a sequence of background fcopies - fileevent $sock readable {} - CopyStart $sock $token - return + if {![info exists state(-handler)]} { + # Initiate a sequence of background fcopies + fileevent $sock readable {} + CopyStart $sock $token + return + } } } elseif {$n > 0} { # Process header lines @@ -1170,14 +1168,54 @@ proc http::getTextLine {sock} { # Side Effects # This closes the connection upon error -proc http::CopyStart {sock token} { - variable $token +proc http::CopyStart {sock token {initial 1}} { + upvar #0 $token state + if {[info exists state(transfer)] && $state(transfer) eq "chunked"} { + foreach coding [ContentEncoding $token] { + lappend state(zlib) [zlib stream $coding] + } + make-transformation-chunked $sock [namespace code [list CopyChunk $token]] + } else { + if {$initial} { + foreach coding [ContentEncoding $token] { + zlib push $coding $sock + } + } + if {[catch { + fcopy $sock $state(-channel) -size $state(-blocksize) -command \ + [list http::CopyDone $token] + } err]} { + Finish $token $err + } + } +} + +proc http::CopyChunk {token chunk} { upvar 0 $token state - if {[catch { - fcopy $sock $state(-channel) -size $state(-blocksize) -command \ - [list http::CopyDone $token] - } err]} then { - Finish $token $err + if {[set count [string length $chunk]]} { + incr state(currentsize) $count + if {[info exists state(zlib)]} { + foreach stream $state(zlib) { + set chunk [$stream add $chunk] + } + } + puts -nonewline $state(-channel) $chunk + if {[info exists state(-progress)]} { + eval [linsert $state(-progress) end \ + $token $state(totalsize) $state(currentsize)] + } + } else { + Log "CopyChunk Finish $token" + if {[info exists state(zlib)]} { + set excess "" + foreach stream $state(zlib) { + catch {set excess [$stream add -finalize $excess]} + } + puts -nonewline $state(-channel) $excess + foreach stream $state(zlib) { $stream close } + unset state(zlib) + } + Eof $token ;# FIX ME: pipelining. } } @@ -1207,7 +1245,7 @@ proc http::CopyDone {token count {error {}}} { } elseif {[catch {eof $sock} iseof] || $iseof} { Eof $token } else { - CopyStart $sock $token + CopyStart $sock $token 0 } } @@ -1231,34 +1269,31 @@ proc http::Eof {token {force 0}} { set state(status) ok } - if {($state(coding) eq "gzip") && [string length $state(body)] > 0} { - if {[catch { - if {[package vsatisfies [package present Tcl] 8.6]} { - # The zlib integration into 8.6 includes proper gzip support - set state(body) [zlib gunzip $state(body)] - } else { - set state(body) [Gunzip $state(body)] + if {[string length $state(body)] > 0} { + if {[catch { + foreach coding [ContentEncoding $token] { + set state(body) [zlib $coding $state(body)] } - } err]} then { + } err]} { + Log "error doing $coding '$state(body)'" return [Finish $token $err] - } - } - - if {!$state(binary)} { - # If we are getting text, set the incoming channel's encoding - # correctly. iso8859-1 is the RFC default, but this could be any IANA - # charset. However, we only know how to convert what we have - # encodings for. - - set enc [CharsetToEncoding $state(charset)] - if {$enc ne "binary"} { - set state(body) [encoding convertfrom $enc $state(body)] - } - - # Translate text line endings. - set state(body) [string map {\r\n \n \r \n} $state(body)] + } + + if {!$state(binary)} { + # If we are getting text, set the incoming channel's encoding + # correctly. iso8859-1 is the RFC default, but this could be any IANA + # charset. However, we only know how to convert what we have + # encodings for. + + set enc [CharsetToEncoding $state(charset)] + if {$enc ne "binary"} { + set state(body) [encoding convertfrom $enc $state(body)] + } + + # Translate text line endings. + set state(body) [string map {\r\n \n \r \n} $state(body)] + } } - Finish $token } @@ -1403,59 +1438,57 @@ proc http::CharsetToEncoding {charset} { } } -# http::Gunzip -- -# -# Decompress data transmitted using the gzip transfer coding. -# - -# FIX ME: redo using zlib sinflate -proc http::Gunzip {data} { - binary scan $data Scb5icc magic method flags time xfl os - set pos 10 - if {$magic != 0x1f8b} { - return -code error "invalid data: supplied data is not in gzip format" - } - if {$method != 8} { - return -code error "invalid compression method" - } - - # lassign [split $flags ""] f_text f_crc f_extra f_name f_comment - foreach {f_text f_crc f_extra f_name f_comment} [split $flags ""] break - set extra "" - if {$f_extra} { - binary scan $data @${pos}S xlen - incr pos 2 - set extra [string range $data $pos $xlen] - set pos [incr xlen] - } - - set name "" - if {$f_name} { - set ndx [string first \0 $data $pos] - set name [string range $data $pos $ndx] - set pos [incr ndx] - } - - set comment "" - if {$f_comment} { - set ndx [string first \0 $data $pos] - set comment [string range $data $pos $ndx] - set pos [incr ndx] - } - - set fcrc "" - if {$f_crc} { - set fcrc [string range $data $pos [incr pos]] - incr pos +# Return the list of content-encoding transformations we need to do in order. +proc http::ContentEncoding {token} { + upvar 0 $token state + set r {} + if {[info exists state(coding)]} { + foreach coding [split $state(coding) ,] { + switch -exact -- $coding { + deflate { lappend r inflate } + gzip - x-gzip { lappend r gunzip } + compress - x-compress { lappend r decompress } + identity {} + default { + return -code error "unsupported content-encoding \"$coding\"" + } + } + } } + return $r +} - binary scan [string range $data end-7 end] ii crc size - set inflated [zlib inflate [string range $data $pos end-8]] - set chk [zlib crc32 $inflated] - if {($crc & 0xffffffff) != ($chk & 0xffffffff)} { - return -code error "invalid data: checksum mismatch $crc != $chk" - } - return $inflated +proc http::make-transformation-chunked {chan command} { + set lambda {{chan command} { + set data "" + set size -1 + yield + while {1} { + chan configure $chan -translation {crlf binary} + while {[gets $chan line] < 1} { yield } + chan configure $chan -translation {binary binary} + if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" } + set chunk "" + while {$size && ![chan eof $chan]} { + set part [chan read $chan $size] + incr size -[string length $part] + append chunk $part + } + if {[catch { + uplevel #0 [linsert $command end $chunk] + }]} then { + http::Log "Error in callback: $::errorInfo" + } + if {[string length $chunk] == 0} { + # channel might have been closed in the callback + catch {chan event $chan readable {}} + return + } + } + }} + coroutine dechunk$chan ::apply $lambda $chan $command + chan event $chan readable [namespace origin dechunk$chan] + return } # Local variables: diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 07724d3..c7029be 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,4 +1,2 @@ -# Tcl package index file, version 1.1 - -if {![package vsatisfies [package provide Tcl] 8.4]} {return} -package ifneeded http 2.7.3 [list tclPkgSetup $dir http 2.7.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +if {![package vsatisfies [package provide Tcl] 8.6]} {return} +package ifneeded http 2.8.0 [list tclPkgSetup $dir http 2.8.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/tests/http.test b/tests/http.test index c4006f9..7fac104 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.50 2009/04/10 09:37:52 patthoyts Exp $ +# RCS: @(#) $Id: http.test,v 1.51 2009/04/10 14:19:45 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -83,8 +83,9 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { } test http-1.1 {http::config} { + http::config -useragent UserAgent http::config -} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"] +} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"] test http-1.2 {http::config} { http::config -proxyfilter } http::ProxyRequired diff --git a/tests/http11.test b/tests/http11.test new file mode 100644 index 0000000..58bb091 --- /dev/null +++ b/tests/http11.test @@ -0,0 +1,579 @@ +# http11.test -- -*- tcl-*- +# +# Test HTTP/1.1 features. +# +# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require tcltest 2 +namespace import -force ::tcltest::* + +package require http 2.8 + +# start the server +variable httpd_output +proc create_httpd {} { + proc httpd_read {chan} { + variable httpd_output + if {[gets $chan line] != -1} { + #puts stderr "read '$line'" + set httpd_output $line + } + if {[eof $chan]} { + puts stderr "eof from httpd" + fileevent $chan readable {} + close $chan + } + } + variable httpd_output + set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl] + set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+] + fconfigure $httpd -buffering line -blocking 0 + fileevent $httpd readable [list httpd_read $httpd] + vwait httpd_output + variable httpd_port [lindex $httpd_output 2] + return $httpd +} + +proc halt_httpd {} { + variable httpd_output + variable httpd + if {[info exists httpd]} { + puts $httpd "quit" + vwait httpd_output + close $httpd + } + unset -nocomplain httpd_output httpd +} + +proc meta {tok {key ""}} { + set meta [http::meta $tok] + if {$key ne ""} { + if {[dict exists $meta $key]} { + return [dict get $meta $key] + } else { + return "" + } + } + return $meta +} + +proc check_crc {tok args} { + set crc [meta $tok x-crc32] + if {[llength $args]} {set data [lindex $args 0]} else {set data [http::data $tok]} + set chk [format %x [zlib crc32 $data]] + if {$crc ne $chk} { + return "crc32 mismatch: $crc ne $chk" + } + return "ok" +} + +makeFile "<html><head><title>test</title></head>\ +<body><p>this is a test</p>\n\ +[string repeat {<p>This is a tcl test file.</p>} 4192]\n\ +</body></html>" testdoc.html + +# ------------------------------------------------------------------------- + +test http-1.0 "normal request for document " -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close} + +test http-1.1 "normal,gzip,non-chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -headers {accept-encoding gzip}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok gzip {}} + +test http-1.2 "normal,deflated,non-chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -headers {accept-encoding deflate}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok deflate {}} + +test http-1.3 "normal,compressed,non-chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -headers {accept-encoding compress}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok compress {}} + +test http-1.4 "normal,identity,non-chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -headers {accept-encoding identity}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok {} {}} + +test http-1.5 "normal request for document, unsupported coding" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -headers {accept-encoding unsupported}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok {}} + +test http-1.6 "normal, specify 1.1 " -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -protocol 1.1 -timeout 10000] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok connection] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close chunked} + +test http-1.7 "normal, 1.1 and keepalive " -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -protocol 1.1 -keepalive 1 -timeout 10000] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok connection] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok {} chunked} + +test http-1.8 "normal, 1.1 and keepalive, server close" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -protocol 1.1 -keepalive 1 -timeout 10000] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok connection] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close {}} + +test http-1.9 "normal,gzip,chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -headers {accept-encoding gzip}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok gzip chunked} + +test http-1.10 "normal,deflate,chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -headers {accept-encoding deflate}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok deflate chunked} + +test http-1.11 "normal,compress,chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -headers {accept-encoding compress}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok compress chunked} + +test http-1.11 "normal,identity,chunked" -setup { + variable httpd [create_httpd] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -headers {accept-encoding identity}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok content-encoding] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok {} chunked} + +# ------------------------------------------------------------------------- + +test http-2.0 "-channel" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close chunked} + +test http-2.1 "-channel, encoding gzip" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan -headers {accept-encoding gzip}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close gzip chunked} + +test http-2.2 "-channel, encoding deflate" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan -headers {accept-encoding deflate}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close deflate chunked} + +test http-2.3 "-channel,encoding compress" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan \ + -headers {accept-encoding compress}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close compress chunked} + +test http-2.4 "-channel,encoding identity" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan \ + -headers {accept-encoding identity}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close {} chunked} + +test http-2.5 "-channel,encoding unsupported" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan \ + -headers {accept-encoding unsupported}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close {} chunked} + +test http-2.6 "-channel,encoding gzip,non-chunked" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 5000 -channel $chan -headers {accept-encoding gzip}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding]\ + [expr {[file size testdoc.html]-[file size testfile.tmp]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0} + +test http-2.7 "-channel,encoding deflate,non-chunked" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 5000 -channel $chan -headers {accept-encoding deflate}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding]\ + [expr {[file size testdoc.html]-[file size testfile.tmp]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0} + +test http-2.8 "-channel,encoding compress,non-chunked" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 5000 -channel $chan -headers {accept-encoding compress}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding]\ + [expr {[file size testdoc.html]-[file size testfile.tmp]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close compress {} 0} + +test http-2.9 "-channel,encoding identity,non-chunked" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 5000 -channel $chan -headers {accept-encoding identity}] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding]\ + [expr {[file size testdoc.html]-[file size testfile.tmp]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0} + +test http-2.10 "-channel,deflate,keepalive" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan -keepalive 1] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding]\ + [expr {[file size testdoc.html]-[file size testfile.tmp]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0} + +test http-2.11 "-channel,identity,keepalive" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -headers {accept-encoding identity} \ + -timeout 5000 -channel $chan -keepalive 1] + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok {} {} chunked} + +# ------------------------------------------------------------------------- +# +# The following tests for the -handler option will require changes in +# the future. At the moment we cannot handler chunked data with this +# option. Therefore we currently force HTTP/1.0 protocol version. +# +# Once this is solved, these tests should be fixed to assume chunked +# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1 + +proc handler {var sock token} { + upvar #0 $var data + set chunk [read $sock] + append data $chunk + #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])" + if {[eof $sock]} { + #::http::Log "handler eof $sock" + chan event $sock readable {} + } +} + +test http-3.0 "-handler,close,identity" -setup { + variable httpd [create_httpd] + set testdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -handler [namespace code [list handler testdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} + +test http-3.1 "-handler,protocol1.0" -setup { + variable httpd [create_httpd] + set testdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -protocol 1.0 \ + -handler [namespace code [list handler testdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} + +test http-3.2 "-handler,close,chunked" -setup { + variable httpd [create_httpd] + set testdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -keepalive 0 -binary 1\ + -handler [namespace code [list handler testdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} + +test http-3.3 "-handler,keepalive,chunked" -setup { + variable httpd [create_httpd] + set testdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 10000 -keepalive 1 -binary 1\ + -handler [namespace code [list handler testdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} + +# ------------------------------------------------------------------------- + +unset -nocomplain httpd_port +::tcltest::cleanupTests diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl new file mode 100644 index 0000000..afa5f5d --- /dev/null +++ b/tests/httpd11.tcl @@ -0,0 +1,225 @@ +# httpd11.tcl -- -*- tcl -*- +# +# A simple httpd for testing HTTP/1.1 client features. +# Not suitable for use on a internet connected port. +# +# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require Tcl 8.6 + +proc ::tcl::dict::get? {dict key} { + if {[dict exists $dict $key]} { + return [dict get $dict $key] + } + return +} +namespace ensemble configure dict \ + -map [linsert [namespace ensemble configure dict -map] end get? ::tcl::dict::get?] + +proc make-chunk-generator {data {size 4096}} { + variable _chunk_gen_uid + if {![info exists _chunk_gen_uid]} {set _chunk_gen_uid 0} + set lambda {{data size} { + set pos 0 + yield + while {1} { + set payload [string range $data $pos [expr {$pos + $size - 1}]] + incr pos $size + set chunk [format %x [string length $payload]]\r\n$payload\r\n + yield $chunk + if {![string length $payload]} {return} + } + }} + set name chunker[incr _chunk_gen_uid] + coroutine $name ::apply $lambda $data $size + return $name +} + +proc get-chunks {data {compression gzip}} { + switch -exact -- $compression { + gzip { set data [zlib gzip $data] } + deflate { set data [zlib deflate $data] } + compress { set data [zlib compress $data] } + } + + set data "" + set chunker [make-chunk-generator $data 512] + while {[string length [set chunk [$chunker]]]} { + append data $chunk + } + return $data +} + +proc blow-chunks {data {ochan stdout} {compression gzip}} { + switch -exact -- $compression { + gzip { set data [zlib gzip $data] } + deflate { set data [zlib deflate $data] } + compress { set data [zlib compress $data] } + } + + set chunker [make-chunk-generator $data 512] + while {[string length [set chunk [$chunker]]]} { + puts -nonewline $ochan $chunk + } + return +} + +proc mime-type {filename} { + switch -exact -- [file extension $filename] { + .htm - .html { return {text text/html}} + .png { return {binary image/png} } + .jpg { return {binary image/jpeg} } + .gif { return {binary image/gif} } + .css { return {text text/css} } + .xml { return {text text/xml} } + .xhtml {return {text application/xml+html} } + .svg { return {text image/svg+xml} } + .txt - .tcl - .c - .h { return {text text/plain}} + } + return {binary text/plain} +} + +proc Puts {chan s} {puts $chan $s; puts $s} + +proc Service {chan addr port} { + chan event $chan readable [info coroutine] + while {1} { + set meta {} + chan configure $chan -buffering line -encoding iso8859-1 -translation crlf + yield + while {[gets $chan line] < 0} { + if {[eof $chan]} {chan event $chan readable {}; close $chan; return} + yield + } + if {[eof $chan]} {chan event $chan readable {}; close $chan; return} + foreach {req url protocol} {GET {} HTTP/1.1} break + regexp {^(\S+)\s+(.*)\s(\S+)?$} $line -> req url protocol + + puts $line + while {[gets $chan line] > 0} { + if {[regexp {^([^:]+):(.*)$} $line -> key val]} { + #puts "$key $val" + lappend meta [string tolower $key] [string trim $val] + } + yield + } + + if {[scan $url {%[^?]?%s} path query] < 2} { + set query "" + } + + set encoding identity + set transfer "" + set close 1 + set type text/html + set code "404 Not Found" + set data "<html><head><title>Error 404</title></head>" + append data "<body><h1>Not Found</h1><p>Try again.</p></body></html>" + + set path [string trimleft $path /] + set path [file join [pwd] $path] + if {[file exists $path] && [file isfile $path]} { + foreach {what type} [mime-type $path] break + set f [open $path r] + if {$what eq "binary"} {chan configure $f -translation binary} + set data [read $f] + close $f + set code "200 OK" + set close [expr {[dict get? $meta connection] eq "close"}] + } + + if {$protocol eq "HTTP/1.1"} { + if {[string match "*deflate*" [dict get? $meta accept-encoding]]} { + set encoding deflate + } elseif {[string match "*gzip*" [dict get? $meta accept-encoding]]} { + set encoding gzip + } elseif {[string match "*compress*" [dict get? $meta accept-encoding]]} { + set encoding compress + } + set transfer chunked + } else { + set close 1 + } + + foreach pair [split $query &] { + if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""} + switch -exact -- $key { + close {set close 1 ; set transfer 0} + transfer {set transfer $val} + content-type {set type $val} + } + } + + chan configure $chan -translation crlf + Puts $chan "$protocol $code" + Puts $chan "content-type: $type" + Puts $chan [format "x-crc32: %x" [zlib crc32 $data]] + if {$close} { + Puts $chan "connection: close" + } + if {$encoding eq "identity"} { + Puts $chan "content-length: [string length $data]" + } else { + Puts $chan "content-encoding: $encoding" + } + if {$transfer eq "chunked"} { + Puts $chan "transfer-encoding: chunked" + } + puts $chan "" + flush $chan + + chan configure $chan -translation binary + if {$transfer eq "chunked"} { + blow-chunks $data $chan $encoding + } elseif {$encoding ne "identity"} { + puts -nonewline $chan [zlib $encoding $data] + } else { + puts -nonewline $chan $data + } + + if {$close} { + chan event $chan readable {} + close $chan + puts "close $chan" + return + } else { + flush $chan + } + puts "pipeline $chan" + } +} + +proc Accept {chan addr port} { + coroutine client$chan Service $chan $addr $port + return +} + +proc Control {chan} { + if {[gets $chan line] != -1} { + if {[string trim $line] eq "quit"} { + set ::forever 1 + } + } + if {[eof $chan]} { + chan event $chan readable {} + } +} + +proc Main {{port 0}} { + set server [socket -server Accept -myaddr localhost $port] + puts [chan configure $server -sockname] + flush stdout + chan event stdin readable [list Control stdin] + vwait ::forever + close $server + return "done" +} + +if {!$tcl_interactive} { + set r [catch [linsert $argv 0 Main] err] + if {$r} {puts stderr $errorInfo} elseif {[string length $err]} {puts $err} + exit $r +} diff --git a/unix/Makefile.in b/unix/Makefile.in index 0a4b918..42790de 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.266 2009/04/08 19:17:45 andreas_kupries Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.267 2009/04/10 14:19:45 patthoyts Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -820,8 +820,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; - @echo "Installing package http 2.7.3 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.3.tm; + @echo "Installing package http 2.8.0 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.0.tm; @echo "Installing library opt0.4 directory"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ diff --git a/win/Makefile.in b/win/Makefile.in index 378f0e7..ed0632f 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.153 2009/04/08 19:17:45 andreas_kupries Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.154 2009/04/10 14:19:45 patthoyts Exp $ VERSION = @TCL_VERSION@ @@ -667,7 +667,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.2 ../tcl8/8.3 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5; \ + @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.2 ../tcl8/8.3 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -696,8 +696,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.7.3 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.3.tm; + @echo "Installing package http 2.8.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.0.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ diff --git a/win/makefile.bc b/win/makefile.bc index 46d7ec3..758eff6 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -430,9 +430,9 @@ install-libraries: -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" @echo installing http2.7 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7" - -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7" - -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7" + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.8" + -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8" + -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8" @echo installing opt0.4 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" diff --git a/win/makefile.vc b/win/makefile.vc index 1ec42e6..42ca196 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -13,7 +13,7 @@ # Copyright (c) 2003-2008 Pat Thoyts. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.198 2009/02/01 19:35:15 davygrvy Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.199 2009/04/10 14:19:45 patthoyts Exp $ #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) @@ -594,7 +594,6 @@ $** $** << $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp !endif $(TCLSTUBLIB): $(TCLSTUBOBJS) @@ -625,8 +624,6 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp - -@del $*.lib !endif !if $(STATIC_BUILD) @@ -641,8 +638,6 @@ $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp - -@del $*.lib !endif pkgs: @@ -1117,7 +1112,7 @@ install-libraries: tclConfig install-msgs install-tzdata "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\http-$(PKG_HTTP_VER).tm" + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm" @@ -1204,6 +1199,8 @@ clean: clean-pkgs @echo Cleaning $(WINDIR)\versions.vc ... @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc +realclean: hose + hose: @echo Hosing $(OUT_DIR)\* ... @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) diff --git a/win/rules.vc b/win/rules.vc index 1e42e6d..ee216ab 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -11,7 +11,7 @@ # Copyright (c) 2003-2007 Patrick Thoyts # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: rules.vc,v 1.39 2008/06/25 10:25:12 patthoyts Exp $ +# RCS: @(#) $Id: rules.vc,v 1.40 2009/04/10 14:19:45 patthoyts Exp $ #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -216,6 +216,7 @@ TCL_THREADS = 0 DEBUG = 0 SYMBOLS = 0 PROFILE = 0 +PGO = 0 MSVCRT = 0 LOIMPACT = 0 TCL_USE_STATIC_PACKAGES = 0 @@ -265,6 +266,15 @@ PROFILE = 1 !else PROFILE = 0 !endif +!if [nmakehlp -f $(OPTS) "pgi"] +!message *** Doing profile guided optimization instrumentation +PGO = 1 +!elseif [nmakehlp -f $(OPTS) "pgo"] +!message *** Doing profile guided optimization +PGO = 2 +!else +PGO = 0 +!endif !if [nmakehlp -f $(OPTS) "loimpact"] !message *** Doing loimpact LOIMPACT = 1 @@ -419,6 +429,24 @@ WARNINGS = $(WARNINGS) -Wp64 !endif !endif +!if $(PGO) > 1 +!if [nmakehlp -l -ltcg:pgoptimize] +LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize +!else +MSG=^ +This compiler does not support profile guided optimization. +!error $(MSG) +!endif +!elseif $(PGO) > 0 +!if [nmakehlp -l -ltcg:pginstrument] +LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument +!else +MSG=^ +This compiler does not support profile guided optimization. +!error $(MSG) +!endif +!endif + #---------------------------------------------------------- # Set our defines now armed with our options. #---------------------------------------------------------- |