Index: ns_xmlrpc/ns_xmlrpc-utils.tcl
===================================================================
RCS file: /usr/local/cvsroot/ns_xmlrpc/ns_xmlrpc-utils.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ ns_xmlrpc/ns_xmlrpc-utils.tcl	27 Aug 2001 15:14:30 -0000	1.1
@@ -0,0 +1,160 @@
+
+# returns 1 if a string is empty
+# this is better than using == because it won't fail on long strings of numbers
+
+if {[info commands empty_string_p] == ""} {
+proc empty_string_p {query_string} {
+    if { [string compare $query_string ""] == 0 } {
+	return 1
+    } else {
+	return 0
+    }
+}
+
+}
+
+# system by Tracy Adams (teadams@arsdigita.com) to permit AOLserver to POST 
+# to another Web server; sort of like ns_httpget
+#  Like ns_httpopen but works for POST as well; called by util_httppost
+
+# check if this is already defined
+if {[empty_string_p [info commands util_httpopen]]} {
+proc util_httpopen {method url {rqset ""} {timeout 30} {http_referer ""}} {
+    
+	if ![string match http://* $url] {
+		return -code error "Invalid url \"$url\":  _httpopen only supports HTTP"
+	}
+	set url [split $url /]
+	set hp [split [lindex $url 2] :]
+	set host [lindex $hp 0]
+	set port [lindex $hp 1]
+	if [string match $port ""] {set port 80}
+	set uri /[join [lrange $url 3 end] /]
+	set fds [ns_sockopen -nonblock $host $port]
+	set rfd [lindex $fds 0]
+	set wfd [lindex $fds 1]
+	if [catch {
+		_ns_http_puts $timeout $wfd "$method $uri HTTP/1.0\r"
+		if {$rqset != ""} {
+			for {set i 0} {$i < [ns_set size $rqset]} {incr i} {
+				_ns_http_puts $timeout $wfd \
+					"[ns_set key $rqset $i]: [ns_set value $rqset $i]\r"
+			}
+		} else {
+			_ns_http_puts $timeout $wfd \
+				"Accept: */*\r"
+
+		    	_ns_http_puts $timeout $wfd "User-Agent: Mozilla/1.01 \[en\] (Win95; I)\r"    
+		    	_ns_http_puts $timeout $wfd "Referer: $http_referer \r"    
+	}
+	#
+	# Always send a Host: header because virtual hosting happens
+	# even with HTTP/1.0.
+	#
+	
+	if { $port == 80 } {
+	    set hostheader "Host: ${host}\r"
+	} else {
+	    set hostheader "Host: ${host}:${port}\r"
+	}
+	_ns_http_puts $timeout $wfd $hostheader
+
+    } errMsg] {
+		global errorInfo
+		#close $wfd
+		#close $rfd
+		if [info exists rpset] {ns_set free $rpset}
+		return -1
+	}
+	return [list $rfd $wfd ""]
+    
+}
+}
+
+
+# httppost; give it a URL and a string with formvars, and it 
+# returns the page as a Tcl string
+# formvars are the posted variables in the following form: 
+#        arg1=value1&arg2=value2
+
+# in the event of an error or timeout, -1 is returned
+
+# Returns the result of POSTing to another Web server or -1 if there is an error or timeout.  formvars should be in the form "arg1=value1&arg2=value2"
+
+if {[empty_string_p [info commands util_httppost]]} {
+proc util_httppost {url formvars {timeout 30} {depth 0} {http_referer ""}} {
+    if [catch {
+	if {[incr depth] > 10} {
+		return -code error "util_httppost:  Recursive redirection:  $url"
+	}
+	set http [util_httpopen POST $url "" $timeout $http_referer]
+	set rfd [lindex $http 0]
+	set wfd [lindex $http 1]
+
+	#headers necesary for a post and the form variables
+
+	_ns_http_puts $timeout $wfd "Content-type: application/x-www-form-urlencoded \r"
+	_ns_http_puts $timeout $wfd "Content-length: [string length $formvars]\r"
+	_ns_http_puts $timeout $wfd \r
+	_ns_http_puts $timeout $wfd "$formvars\r"
+	flush $wfd
+	close $wfd
+
+	set rpset [ns_set new [_ns_http_gets $timeout $rfd]]
+		while 1 {
+			set line [_ns_http_gets $timeout $rfd]
+			if ![string length $line] break
+			ns_parseheader $rpset $line
+		}
+
+
+	set headers $rpset
+	set response [ns_set name $headers]
+	set status [lindex $response 1]
+	if {$status == 302} {
+		set location [ns_set iget $headers location]
+		if {$location != ""} {
+			ns_set free $headers
+			close $rfd
+			return [ns_httpget $location $timeout $depth]
+		}
+	}
+	set length [ns_set iget $headers content-length]
+	if [string match "" $length] {set length -1}
+	set err [catch {
+		while 1 {
+			set buf [_http_read $timeout $rfd $length]
+			append page $buf
+			if [string match "" $buf] break
+			if {$length > 0} {
+				incr length -[string length $buf]
+				if {$length <= 0} break
+			}
+		}
+	} errMsg]
+	ns_set free $headers
+	close $rfd
+	if $err {
+		global errorInfo
+		return -code error -errorinfo $errorInfo $errMsg
+	}
+    } errmsg ] {
+        ns_log debug util_httppost error: $errmsg
+        return -1
+    } else {
+        return $page
+    }
+}
+}
+
+# this is needed for the validation code.
+if {[empty_string_p [info commands util_expand_entities]]} {
+proc util_expand_entities {html} {
+
+    regsub -all {&lt;} $html {<} html
+   regsub -all {&gt;} $html {>} html
+   regsub -all {&quot;} $html {\"} html
+   regsub -all {&amp;} $html {\&} html
+   return $html
+}
+}