util_httppost (public, deprecated)

 util_httppost url formvars [ timeout ] [ depth ] [ http_referer ]

Defined in packages/acs-tcl/tcl/deprecated-procs.tcl

Deprecated. Invoking this procedure generates a warning.

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\".

post is encoded as application/x-www-form-urlencoded. See util_http_file_upload for file uploads via post (encoded multipart/form-data).

Parameters:

url (required)

formvars (required)

timeout (optional, defaults to "30")

depth (optional, defaults to "0")

http_referer (optional)

See Also:

• util_http_file_upload

Testcases:

No testcase defined.

Source code:

ad_log_deprecated proc util_httppost
    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 necessary 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 create [_ns_http_gets $timeout $rfd]]
        while 1 {
            set line [_ns_http_gets $timeout $rfd]
            if { $line eq "" } 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 ne ""} {
                ns_set free $headers
                close $rfd
                return [util_httpget $location {}  $timeout $depth]
            }
        }
        set length [ns_set iget $headers content-length]
        if { "" eq $length } {set length -1}
        set type [ns_set iget $headers content-type]
        set_encoding $type $rfd
        set err [catch {
            while 1 {
                set buf [_ns_http_read $timeout $rfd $length]
                append page $buf
                if { "" eq $buf } break
                if {$length > 0} {
                    incr length -[string length $buf]
                    if {$length <= 0} break
                }
            }
        } errMsg]
        ns_set free $headers
        close $rfd
        if {$err} {
            return -code error -errorinfo $::errorInfo $errMsg
        }
    } errmgs ] } {return -1}
    return $page

XQL Not present:

PostgreSQL, Oracle

Generic XQL file:

packages/acs-tcl/tcl/deprecated-procs.xql