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