ns_httpspost

one of the defined (but not documented) Tcl procedures in this installation of the ACS
Usage:
ns_httpspost   url   { rqset "" }   { qsset "" }   { type "" }   { filesets "" }   { timeout "30" }   { body "" }
Source code:

    #
    # Build the request. Since we're posting, we have to set
    # content-type and content-length ourselves. We'll add these to
    # rqset, overwriting if they already existed, which they
    # shouldn't.
    #

    #
    # Handle the case where the user puts "" to indicate the default timeout
    #

    if {$timeout == ""} {
	set timeout 30
    }

    set boundary "-----------------rc029340985544hg24309nto8899o9"

    if {[string match "" $rqset]} { 
	set rqset [ns_set new rqset]
	ns_set put $rqset "Accept" "*/*"
	ns_set put $rqset "User-Agent" "[ns_info name]-Tcl/[ns_info version]"
    }

    if {$type == ""} {
	ns_set put $rqset "Content-type" "application/x-www-form-urlencoded"
    } elseif {$type == "multipart/form-data"} {
	# Can't double-quote the boundary value because of form.tcl
	ns_set put $rqset "Content-type" "multipart/form-data, boundary=$boundary"
    } else {
	ns_set put $rqset "Content-type" "$type"
    }

    #
    # Build the query string to POST with
    #

    set querystring ""

    if {$type == "multipart/form-data"} {
	#
	# Set the standard POST form parameters
	#

	if {![string match "" $qsset]} {
	    for {set i 0} {$i < [ns_set size $qsset]} {incr i} {
		set key [ns_set key $qsset $i]
		set value [ns_set value $qsset $i]
		append querystring "--${boundary}\r\n"
		append querystring "Content-Disposition: form-data; name=\"$key\"\r\n\r\n"
		append querystring "$value\r\n"

	# XXX Do we ever have multiple parameters for post elements that aren't files?
	#	append querystring "Content-Disposition: form-data; "
	#	foreach dispositionlist [ns_set key $qsset $i] {
 	#		append querystring "[lindex $dispositionlist 0]=\"[lindex $dispositionlist 1]\"; "
	#	}
	#	regsub {;\s+$} querystring "" $querystring
	#	append querystring "\r\n\r\n"
	#	append querystring "[ns_set value $qsset $i]\r\n"
	    }
	}

	#
	# Add files to POST request, if any
	#
	# filesets is a list of ns_sets that contains the needed information to
	# include files in the post. Each file represents one ns_set in the list
	# Each ns_set consists of four keys:
	#
	#	name:         the name of the form element for this file
	#	filename:     the name of the file
	#	content:      the actual contents of the file
	#	content-type: the type of contents in the file, such as text/plain
	#
	# filesets are only used with multipart/form-data
	#

	# XXX tmp
	ns_log notice "QUERYSTRING:\n$querystring"
	ns_log notice "*** FILESET == $filesets"

	if {![string match "" $filesets]} {
	    ns_log notice "*** S1"
	    foreach file $filesets {
		ns_log notice "*** S2"
		append querystring "--${boundary}\r\n"
		append querystring "Content-Disposition: form-data; name=\"[ns_set iget $file name]\"; filename=\"[ns_set iget $file filename]\"\r\n"
		append querystring "Content-Type: [ns_set iget $file content-type]\r\n\r\n"
		append querystring "[ns_set iget $file content]\r\n"
	    }

	}

	#
	# Finish POST request
	#

	append querystring "--${boundary}--\n"
	ns_set put $rqset "Content-length" [string length $querystring]

    } elseif {![string match "" $qsset]} {
	for {set i 0} {$i < [ns_set size $qsset]} {incr i} {
	    set key [ns_set key $qsset $i]
	    set value [ns_set value $qsset $i]
	    if { $i > 0 } {
		append querystring "&"
	    }
	    append querystring "$key=[ns_urlencode $value]"
	}
	ns_set put $rqset "Content-length" [string length $querystring]
    } else {
	#
	# Send $body as the POST request data.
	#
	set querystring $body
	ns_set put $rqset "Content-length" [string length $querystring]
    }

    #
    # Perform the actual request.
    #
    
    set http [ns_httpsopen POST $url $rqset $timeout $querystring]
    set rfd [lindex $http 0]
    # XXX close [lindex $http 1]
    set headers [lindex $http 2]

    set length [ns_set iget $headers content-length]
    if [string match "" $length] {
	set length -1
    }
    set err [catch {
	#
	# Read the content.
	#
	
	while 1 {
	    set buf [_ns_https_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
    }
    return $page


philg@mit.edu