From 6e17c8ff854c2c7d06c9bd399e3d24f3891d18e6 Mon Sep 17 00:00:00 2001 From: patthoyts Date: Thu, 23 Oct 2008 23:17:38 +0000 Subject: Fixed a failure to read SHOUTcast streams with the new 2.7 package. Introduced a new intial state as the first response may not be HTTP*. --- ChangeLog | 6 ++++++ library/http/http.tcl | 17 ++++++++++------- library/http/pkgIndex.tcl | 2 +- unix/Makefile.in | 6 +++--- win/Makefile.in | 6 +++--- 5 files changed, 23 insertions(+), 14 deletions(-) diff --git a/ChangeLog b/ChangeLog index 16d31b3..1c2f9b8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2008-10-24 Pat Thoyts + + * library/http/http.tcl: Fixed a failure to read SHOUTcast streams + with the new 2.7 package. Introduced a new intial state as the + first response may not be HTTP*. + 2008-10-23 Miguel Sofer * generic/tclCmdAH.c (ForNextCallback): handle TCL_CONTINUE in diff --git a/library/http/http.tcl b/library/http/http.tcl index 046329b..fab054f 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.71 2008/08/11 21:58:07 dgp Exp $ +# RCS: @(#) $Id: http.tcl,v 1.72 2008/10/23 23:17:38 patthoyts Exp $ package require Tcl 8.4 # Keep this in sync with pkgIndex.tcl and with the install directories # in Makefiles -package provide http 2.7.1 +package provide http 2.7.2 namespace eval http { # Allow resourcing to not clobber existing data @@ -319,7 +319,7 @@ proc http::geturl { url args } { -queryprogress {} -protocol 1.1 binary 0 - state header + state connecting meta {} coding {} currentsize 0 @@ -942,7 +942,12 @@ proc http::Event {sock token} { CloseSocket $sock return } - if {$state(state) eq "header"} { + if {$state(state) eq "connecting"} { + set state(state) "header" + if {[catch {gets $sock state(http)} n]} { + return [Finish $token $n] + } + } elseif {$state(state) eq "header"} { if {[catch {gets $sock line} n]} { return [Finish $token $n] } elseif {$n == 0} { @@ -985,7 +990,7 @@ proc http::Event {sock token} { fconfigure $state(-channel) -translation binary } } - if {[info exists state(-channel)] && + if {[info exists state(-channel)] && ![info exists state(-handler)]} { # Initiate a sequence of background fcopies fileevent $sock readable {} @@ -1019,8 +1024,6 @@ proc http::Event {sock token} { } } lappend state(meta) $key [string trim $value] - } elseif {[string match HTTP* $line]} { - set state(http) $line } } } else { diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 932017a..6badcea 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,4 +1,4 @@ # Tcl package index file, version 1.1 if {![package vsatisfies [package provide Tcl] 8.4]} {return} -package ifneeded http 2.7.1 [list tclPkgSetup $dir http 2.7.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.7.2 [list tclPkgSetup $dir http 2.7.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/unix/Makefile.in b/unix/Makefile.in index 7ead8d7..afe0eec 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.246 2008/08/29 12:37:16 dkf Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.247 2008/10/23 23:17:38 patthoyts Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -800,8 +800,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; - @echo "Installing package http 2.7.1 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.1.tm; + @echo "Installing package http 2.7.2 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.2.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 53d4148..1be741a 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.135 2008/08/29 12:37:17 dkf Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.136 2008/10/23 23:17:38 patthoyts Exp $ VERSION = @TCL_VERSION@ @@ -637,8 +637,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.7.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.1.tm; + @echo "Installing package http 2.7.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.2.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12