Index: openacs-4/packages/acs-tcl/tcl/http-client-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/http-client-procs.tcl,v diff -u -r1.3.2.10 -r1.3.2.11 --- openacs-4/packages/acs-tcl/tcl/http-client-procs.tcl 23 Jan 2017 14:34:18 -0000 1.3.2.10 +++ openacs-4/packages/acs-tcl/tcl/http-client-procs.tcl 30 Jan 2017 16:14:10 -0000 1.3.2.11 @@ -22,21 +22,21 @@ } { Extracts cookies from response headers. This is done reading every set-cookie header and populating a ns_set of request headers suitable for issuing util::http requests. - + @param resp_headers Response headers, in a list form as returned by util::http API. - + @param headers ns_set of request headers that will be populated with extracted cookies. If not specified, a new ns_set will be created. Existing cookies will be overwritten. - + @param cookie_names Cookie names we want to retrieve. Other cookies will be ignored. - If omitted toghether with -pattern proc will include + If omitted toghether with -pattern proc will include every cookie. - + @param pattern Cookies which name respects this pattern as in string match - will be included. If omitted toghether with -cookie_names proc + will be included. If omitted toghether with -cookie_names proc will include every cookie. - + @return ns_set of headers containing received cookies } { if {$headers eq ""} { @@ -47,7 +47,7 @@ # get only set-cookie headers, ignoring case set name [string tolower $name] if {$name ne "set-cookie"} continue - + # keep only relevant part of the cookie set cookie [lindex [split $value ";"] 0] set cookie_name [lindex [split $cookie "="] 0] @@ -59,7 +59,7 @@ ns_set idelkey $headers "cookie" set cookies [join $cookies "; "] ns_set put $headers "cookie" $cookies - + return $headers } @@ -69,15 +69,15 @@ -password:required } { Builds BASIC authentication header for a HTTP request - + @param headers ns_set of request headers that will be populated with auth header. If not specified, a new ns_set will be created. Existing header for BASIC authentication will be overwtitten. - + @param username Username for authentication - + @param password Password for authentication - + @return ns_set of headers containing authentication data } { if {$headers eq ""} { @@ -104,42 +104,42 @@
By this method it is possible, for example, to authenticate on a remote OpenACS installation providing email and password as credentials - to the /register/ page, and using ad_session_id and ad_user_login + to the /register/ page, and using ad_session_id and ad_user_login as auth_cookies.

This proc takes care to submit to the login form also every other formfield on the login page. This is important because this (often hidden) formfields can contain tokens necessary for the authentication process. - + @param headers ns_set of request headers that will be populated with auth headers. If not specified, a new ns_set will be created. Existing cookies will be overwritten. - + @param auth_vars Variables issued to the login page in export_vars -url form. - + @param auth_url Login url - + @param auth_cookies Cookies we should look for in the response from the login page to obtain authentication data. If not specified, this will refer to every cookie received into set-cookie response headers. - + @auth_form Form to put our data into. If not specified, there must be only one form on the login page, otherwise proc will throw an error. - + @return ns_set of headers containing authentication data } { if {$headers eq ""} { set headers [ns_set create headers] } - + # Normalize url. Slashes at the end can make # the same url don't look the same for the # server, if we retrieve the same url from # the 'action' attribute of the form. set auth_url [string trimright $auth_url "/"] set base_url [split $auth_url "/"] set base_url [lindex $base_url 0]//[lindex $base_url 2] - + # Call login url to obtain login form array set r [util::http::get -url $auth_url -preference $preference] @@ -152,7 +152,7 @@ # Obtain and export form vars not provided explicitly set form [util::html::get_forms -html $r(page)] set form [util::html::get_form -forms $form -id $auth_form] - + array set f $form array set a $f(attributes) # Action could be different from original login url @@ -161,15 +161,15 @@ set auth_url ${base_url}${a(action)} set auth_url [string trimright $auth_url "/"] } - + set formvars [util::html::get_form_vars -form $form] set formvars [export_vars -exclude $auth_vars $formvars] # Export vars provided explicitly in caller scope set auth_vars [uplevel [list export_vars -url $auth_vars]] # Join form vars with our vars set formvars [join [list $formvars $auth_vars] "&"] - # Call login url with authentication parameters. Just retrieve the first response, as it + # Call login url with authentication parameters. Just retrieve the first response, as it # is common for login pages to redirect somewhere, but we just need to steal the cookies. array set r [util::http::post \ -url $auth_url -body $formvars \ @@ -180,12 +180,12 @@ -resp_headers $r(headers) \ -headers $headers \ -cookie_names $auth_cookies - + return $headers } ad_proc -public util::http::available { - -url + -url {-preference {native curl}} -force_ssl:boolean -spool:boolean @@ -211,7 +211,7 @@ } else { set apis [lindex [apis] 0] } - + # just allow spool when NaviServer os 4.99.6 or newer if {$spool_p && [apm_version_names_compare [ns_info patchlevel] "4.99.6"] == -1} { if {"native" in $apis} { @@ -225,23 +225,34 @@ return $p } } - + return "" } -ad_proc -private util::http::native_https_api { +ad_proc -private util::http::native_https_api_not_cached { } { Obtains the right https native API } { # Since naviserver 4.99.12 ns_http handles also https if {[apm_version_names_compare \ - [ns_info patchlevel] "4.99.12"] >= 0} { + [ns_info patchlevel] "4.99.12"] >= 0} { return [info commands ns_http] } # Default: check if we have ns_ssl return [info commands ns_ssl] } +ad_proc -private util::http::native_https_api { +} { + Obtains implemented apis for http communication +} { + set key ::util::http::native_https_api + if {[info exists $key]} { + return [set $key] + } else { + return [set $key [util::http::native_https_api_not_cached]] + } +} ad_proc -private util::http::apis_not_cached { } { @@ -258,7 +269,7 @@ lappend http "native" } - if {[util::http::native_https_api] ne ""} { + if {[util::http::native_https_api] ne ""} { lappend https "native" } @@ -269,7 +280,12 @@ } { Obtains implemented apis for http communication } { - return [ns_memoize -- util::http::apis_not_cached] + set key ::util::http::apis + if {[info exists $key]} { + return [set $key] + } else { + return [set $key [util::http::apis_not_cached]] + } } @@ -292,12 +308,12 @@ # helper proc does not consider RFC 3023 at all. In the future, # RFC 3023 support should enter a revised [ns_encodingfortype], # for now, we fork. - # + # # The mappings between Tcl encoding names (as shown by [encoding # names]) and IANA/MIME charset names (i.e., names and aliases in # the sense of http://www.iana.org/assignments/character-sets) is # provided by ... - # + # # i. a static, built-in correspondence map: see nsd/encoding.c # ii. an extensible correspondence map (i.e., the ns/charsets # section in config.tcl). @@ -348,13 +364,13 @@ # = "binary"). This requires the client of the *HttpRequest* to # treat the data accordingly. # - + set enc "" if {[regexp {^text/.*$|^.*/json.*$|^.*/xml.*$|^.*\+xml.*$} $content_type]} { # Case (A): Check for an explicitly provided charset parameter if {[regexp {;\s*charset\s*=([^;]*)} $content_type _ charset]} { set enc [ns_encodingforcharset [string trim $charset]] - } + } # Case (B.1) if {$enc eq "" && [regexp {^text/xml.*$|text/.*\+xml.*$} $content_type]} { set enc [ns_encodingforcharset us-ascii] @@ -371,13 +387,13 @@ } # Cases (C) and (B.2) are covered by the [expr] below. set enc [expr {$enc eq "" ? "binary" : $enc}] - + return $enc } ad_proc util::http::get { - -url - {-headers ""} + -url + {-headers ""} {-timeout 30} {-max_depth 10} -force_ssl:boolean @@ -386,34 +402,34 @@ {-preference {native curl}} } { Issue an http GET request to url. - + @param headers specifies an ns_set of extra headers to send to the server when doing the request. Some options exist that allow to avoid the need to specify headers manually, but headers - will always take precedence over options. - + will always take precedence over options. + @param gzip_response informs the server that we are capable of receiving gzipped responses. If server complies to our - indication, the result will be automatically decompressed. - + indication, the result will be automatically decompressed. + @param force_ssl specifies wether we want to use SSL despite the url being in http:// form. Default behavior is to use - SSL on https:// urls only. - + SSL on https:// urls only. + @param spool enables file spooling of the request on the file specified. It is useful when we expect large responses from the server. The result is spooled to a temporary file, the name is returned in the file component of the result. - + @param preference decides which available implementation prefer in respective order. Choice is between 'native', based on ns_ api, available for NaviServer only and giving the best performances and 'curl', which wraps the command line utility (available on every - system with curl installed). + system with curl installed). @param timeout Timeout in seconds. The value can be an integer, a floating point number or an ns_time value. - + @return Returns the data as dict with elements headers, page, file, status, and modified. @@ -431,11 +447,12 @@ } ad_proc util::http::post { - -url + -url {-files {}} -base64:boolean {-formvars ""} {-body ""} + {-max_body_size 25000000} {-headers ""} {-timeout 30} {-max_depth 10} @@ -448,12 +465,21 @@ {-preference {native curl}} } { Implement client-side HTTP POST request. - + @param body is the payload for the request and will be passed as is (useful for many purposes, such as webDav). A convenient way to specify form variables through this argument is - passing a string obtained by export_vars -url. - + passing a string obtained by export_vars -url. + + @param max_body_size this value in number of characters will tell + how big can the whole body payload get before we start spooling + its content to a file. This is important in case of big file + uploads, when keeping the entire request in memory is just not + feasible. The handling of the spooling is taken care of in the + api. This value takes into account also the encoding required by + the content type, so its value could not reflect the exact length + of body's string representation. + @param files File upload can be specified using actual files on the filesystem or binary strings of data using the -files parameter. -files must be a dict (flat list of key value pairs). @@ -472,14 +498,14 @@ missing, it will be guessed from 'filename'. If result is */* or an empty mime_type, 'application/octet-stream' will be used
If -base64 flag is set, files will be base64 encoded - (useful for some kind of form). + (useful for some kind of form). @param -formvars Other form variables can be passes in-formvars easily by the use of export_vars -url and will be translated for the proper type of form. URL variables, as with GET requests, are also sent, but an error is thrown if URL variables conflict with those specified in other ways. - +

Default behavior is to build payload as an 'application/x-www-form-urlencoded' payload if no files are specified, and 'multipart/form-data' otherwise. If @@ -499,35 +525,35 @@ @param gzip_response informs the server that we are capable of receiving gzipped responses. If server complies to our indication, the result will be automatically decompressed. - + @param force_ssl specifies wether we want to use SSL despite the url being in http:// form. Default behavior is to use SSL on https:// urls only. - + @param spool enables file spooling of the request on the file specified. It is useful when we expect large responses from the server. The result is spooled to a temporary file, the name is returned in the file component of the result. - + @param post_redirect decides what happens when we are POSTing and server replies with 301, 302 or 303 redirects. RFC 2616/10.3.2 states that method should not change when 301 or 302 are returned, and that GET should be used on a 303 response, but most HTTP clients fail in respecting this and switch to a GET request independently. This options forces this kinds of redirect to conserve their original method. - + @param max_depth is the maximum number of redirects the proc is - allowed to follow. A value of 0 disables redirection. When max - depth for redirection has been reached, proc will return response - from the last page we were redirected to. This is important if + allowed to follow. A value of 0 disables redirection. When max + depth for redirection has been reached, proc will return response + from the last page we were redirected to. This is important if redirection response contains data such as cookies we need to obtain anyway. Be aware that when following redirects, unless it is a code 303 redirect, url and POST urlencoded variables will be sent again to the redirected host. Multipart variables won't be sent again. Sending to the redirected host can be dangerous, if such host is not trusted or uses a lower level of security. - + @param preference decides which available implementation prefer in respective order. Choice is between 'native', based on ns_ api, available for NaviServer only and giving the best performances and @@ -536,21 +562,21 @@ @param timeout Timeout in seconds. The value can be an integer, a floating point number or an ns_time value. - + @return Returns the data as dict with elements headers, page, file, status, and modified. -} { +} { set this_proc [lindex [info level 0] 0] - + # Retrieve variables sent by the URL... set vars [lindex [split $url ?] 1] foreach var [split $vars &] { set var [split $var =] set key [lindex $var 0] set urlvars($key) 1 } - + # Check wether we don't have multiple variable definition in url and payload foreach var [split $formvars &] { set var [split $var =] @@ -559,35 +585,39 @@ return -code error "${this_proc}: Variable '$key' already specified as url variable" } } - + if {$headers eq ""} { set headers [ns_set create headers] } - + # If required from headers, force a multipart form set req_content_type [ns_set iget $headers "content-type"] if {$req_content_type ne ""} { set multipart_p [string match -nocase "*multipart/form-data*" $req_content_type] # avoid duplicated headers ns_set idelkey $headers "Content-type" } - + ## Construction of the payload # By user choice, or because we have files, this will be a 'multipart/form-data' payload... + set payload {} + set payload_file {} + set payload_file_fd {} + if {$multipart_p || $files ne [list]} { - + set boundary [ns_sha1 [list [clock clicks -milliseconds] [clock seconds]]] - ns_set put $headers "Content-type" "multipart/form-data; boundary=$boundary" - - set payload {} - + set content_type "multipart/form-data; boundary=$boundary" + ns_set put $headers "Content-type" $content_type + set enc [util::http::get_channel_settings $content_type] + # Transform files into binaries foreach file $files { array set f $file - + if {![info exists f(data)]} { if {![info exists f(file)]} { - return -code error "${this_proc}: No file or binary data specified" + return -code error "${this_proc}: No file specified" } if {![file exists $f(file)]} { return -code error "${this_proc}: Error reading file: $f(file) not found" @@ -596,29 +626,24 @@ return -code error "${this_proc}: Error reading file: $f(file) permission denied" } - set fp [open $f(file)] - fconfigure $fp -translation binary - set f(data) [read $fp] - close $fp - if {![info exists f(filename)]} { set f(filename) [file tail $f(file)] } } - - foreach key {data filename fieldname} { + + foreach key {filename fieldname} { if {![info exists f($key)]} { - return -code error "${this_proc}: '$key' missing for binary data" + return -code error "${this_proc}: '$key' missing for file POST" } } - + # Check that we don't already have this var specified in the url if {[info exists urlvars($f(fieldname))]} { return -code error "${this_proc}: file field '$f(fieldname)' already specified as url variable" } # Track form variables sent as files set filevars($f(fieldname)) 1 - + if {![info exists f(mime_type)]} { set f(mime_type) [ns_guesstype $f(filename)] if {$f(mime_type) in {"*/*" ""}} { @@ -627,61 +652,123 @@ } if {$base64_p} { - set f(data) [base64::encode $f(data)] set transfer_encoding base64 } else { set transfer_encoding binary } - append payload --$boundary \ - \r\n \ - "Content-Disposition: form-data; " \ - "name=\"$f(fieldname)\"; filename=\"$f(filename)\"" \ - \r\n \ - "Content-Type: $f(mime_type)" \ - \r\n \ - "Content-transfer-encoding: $transfer_encoding" \ - \r\n \ - \r\n \ - $f(data) \ - \r\n - - } ; unset files + set content [list --$boundary \ + \r\n \ + "Content-Disposition: form-data; " \ + "name=\"$f(fieldname)\"; filename=\"$f(filename)\"" \ + \r\n \ + "Content-Type: $f(mime_type)" \ + \r\n \ + "Content-transfer-encoding: $transfer_encoding" \ + \r\n \ + \r\n] + set app [append_to_payload \ + -content [join $content ""] \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + lassign $app payload payload_file payload_file_fd + if {[info exists f(data)]} { + set app [append_to_payload \ + -content $f(data) \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + } else { + set app [append_to_payload \ + -file $f(file) \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + } + lassign $app payload payload_file payload_file_fd + + set app [append_to_payload \ + -content \r\n \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + lassign $app payload payload_file payload_file_fd + + } + # Translate urlencoded vars into multipart variables foreach formvar [split $formvars &] { set formvar [split $formvar =] set key [lindex $formvar 0] set val [join [lrange $formvar 1 end] =] - + if {[info exists filevars($key)]} { return -code error "${this_proc}: Variable '$key' already specified as file variable" } - append payload --$boundary \ - \r\n \ - "Content-Disposition: form-data; name=\"$key\"" \ - \r\n \ - \r\n \ - $val \ - \r\n - - } ; unset formvars + set content [list --$boundary \ + \r\n \ + "Content-Disposition: form-data; name=\"$key\"" \ + \r\n \ + \r\n \ + $val \ + \r\n] + set app [append_to_payload \ + -content [join $content ""] \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + lassign $app payload payload_file payload_file_fd - append payload --$boundary-- \r\n - + } + + set content "--$boundary--\r\n" + set app [append_to_payload \ + -content $content \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + lassign $app payload payload_file payload_file_fd + # ...otherwise this will be an 'application/x-www-form-urlencoded' payload } else { - ns_set put $headers "Content-type" "application/x-www-form-urlencoded" - set payload $formvars; unset formvars + set content_type "application/x-www-form-urlencoded" + ns_set put $headers "Content-type" $content_type + set enc [util::http::get_channel_settings $content_type] + set payload $formvars } # Body will be appended as is to the payload - set body "${payload}${body}" + set app [append_to_payload \ + -content $body \ + $enc \ + $max_body_size \ + $payload \ + $payload_file \ + $payload_file_fd] + lassign $app payload payload_file payload_file_fd + + if {$payload_file_fd ne ""} {close $payload_file_fd} return [util::http::request \ -method POST \ - -body $body \ + -body $payload \ + -body_file $payload_file \ + -delete_body_file \ -headers $headers \ -url $url \ -timeout $timeout \ @@ -695,12 +782,85 @@ } +ad_proc -private util::http::append_to_payload { + {-content ""} + {-file ""} + -base64:boolean + encoding + max_size + payload + spool_file + wfd +} { + Appends content to a POST payload making sure this doesn't exceed + given max size. When this happens, proc creates a spool file and + writes there the content. + + @return a list in the format {total_payload spooling_file + spooling_file_handle} + +} { + set payload_size [string length $payload] + + if {$file eq ""} { + if {$encoding ne "binary"} {set content [encoding convertto $encoding $content]} + set content_size [string length $content] + } else { + # At first check length by file size, so we don't have to read + # anything... + set content_size [file size $file] + set rfd [open $file r] + fconfigure $rfd -translation binary + } + + # ...file as it is could be small enough, now let's check with + # encoding... + if {$spool_file eq "" && + $payload_size + $content_size <= $max_size && + $file ne ""} { + set content [read $rfd]; close $rfd + if {$base64_p} {set content [base64::encode $content]} + if {$encoding ne "binary"} {set content [encoding convertto $encoding $content]} + set content_size [string length $content] + } + + if {$spool_file eq "" && + $payload_size + $content_size <= $max_size} { + return [list ${payload}${content} {} {}] + } else { + if {$spool_file eq ""} { + set spool_file [ad_tmpnam] + set wfd [open $spool_file w] + # Flush previously collected payload. As it was already + # properly encoded, use the binary translation... + fconfigure $wfd -translation binary + puts -nonewline $wfd $payload + # ...then switch to the proper one. + fconfigure $wfd -translation $encoding + } + if {$file ne ""} { + if {$base64_p} { + # TODO: it's tricky to base64 encode without slurping + # the whole file (exec + pipes?) + error "Base64 encoding currently supported only for in-memory file POSTing" + } + fcopy $rfd $wfd + close $rfd + } else { + puts -nonewline $wfd $content + } + return [list {} $spool_file $wfd] + } +} + ad_proc -private util::http::follow_redirects { -url -method -status - -location + -location {-body ""} + {-body_file ""} + -delete_body_file:boolean {-headers ""} {-timeout 30} {-depth 0} @@ -717,23 +877,31 @@ to be able to follow a redirect until a certain depth and then stop without throwing an error.

- Happens at times that even a redirect page contains + Happens at times that even a redirect page contains very important information we want to be able to reach. An example could be authentication headers. By putting redirection handling here we can force a common behavior between the two implementations, that otherwise would not be possible. - - @param body is the payload for the request and will be - passed as is (useful for many purposes, such as webDav). A - convenient way to specify form variables through this argument is - passing a string obtained by export_vars -url. - -

Default behavior is to build payload as an + + @param body is the payload for the request and will be passed as + is (useful for many purposes, such as webDav). A convenient way + to specify form variables through this argument is passing a + string obtained by export_vars -url.

Default + behavior is to build payload as an 'application/x-www-form-urlencoded' payload if no files are specified, and 'multipart/form-data' otherwise. If -multipart flag is set, format will be forced to multipart. + @param body_file is an alternative way to specify the payload, + useful in cases such as the upload of big files by POST. If + specified, will have precedence over the body + parameter. Content of the file won't be encoded according with the + content type of the request as happen with body + + @param delete_body_file decides whether remove body payload file + once the request is over. + @param headers specifies an ns_set of extra headers to send to the server when doing the request. Some options exist that allow to avoid the need to specify headers manually, but headers will @@ -747,35 +915,35 @@ @param gzip_response informs the server that we are capable of receiving gzipped responses. If server complies to our indication, the result will be automatically decompressed. - + @param force_ssl specifies wether we want to use SSL despite the url being in http:// form. Default behavior is to use SSL on https:// urls only. - + @param spool enables file spooling of the request on the file specified. It is useful when we expect large responses from the server. The result is spooled to a temporary file, the name is returned in the file component of the result. - + @param post_redirect decides what happens when we are POSTing and server replies with 301, 302 or 303 redirects. RFC 2616/10.3.2 states that method should not change when 301 or 302 are returned, and that GET should be used on a 303 response, but most HTTP clients fail in respecting this and switch to a GET request independently. This options forces this kinds of redirect to conserve their original method. - + @param max_depth is the maximum number of redirects the proc is - allowed to follow. A value of 0 disables redirection. When max - depth for redirection has been reached, proc will return response - from the last page we were redirected to. This is important if + allowed to follow. A value of 0 disables redirection. When max + depth for redirection has been reached, proc will return response + from the last page we were redirected to. This is important if redirection response contains data such as cookies we need to obtain anyway. Be aware that when following redirects, unless it is a code 303 redirect, url and POST urlencoded variables will be sent again to the redirected host. Multipart variables won't be sent again. Sending to the redirected host can be dangerous, if such host is not trusted or uses a lower level of security. - + @param preference decides which available implementation prefer in respective order. Choice is between 'native', based on ns_ api, available for NaviServer only and giving the best performances and @@ -784,20 +952,20 @@ @param timeout Timeout in seconds. The value can be an integer, a floating point number or an ns_time value. - + @return Returns the data as dict with elements headers, page, file, status, and modified from the last followed redirect, or an empty string if request was not a redirection. -} { +} { ## Redirection management ## - + # Don't follow if page was not modified or this was not a proper redirect: # not the right status code, missing location. if {$status == 304 || ![string match "3??" $status] || $location eq ""} { return "" } - + # Other kinds of redirection... # Decide by which method follow the redirect if {$method eq "POST"} { @@ -812,17 +980,17 @@ # util::http::request again. # set this_proc ::util::http::request - + set urlvars [list] - + # ...retrieve redirect location variables... set locvars [lindex [split $location ?] 1] if {$locvars ne ""} { lappend urlvars $locvars } - + lappend urlvars [lindex [split $url ?] 1] - + # If we have POST payload and we are following by GET, put the payload into url vars. if {$method eq "GET" && $body ne ""} { set req_content_type [ns_set iget $headers "content-type"] @@ -838,14 +1006,14 @@ lappend urlvars $body } } - + # Unite all variables into location URL set urlvars [join $urlvars &] - + if {$urlvars ne ""} { set location ${location}?${urlvars} } - + if {$method eq "GET"} { return [$this_proc \ -method GET \ @@ -864,6 +1032,8 @@ -method POST \ -url $location \ -body $body \ + -body_file $body_file \ + -delete_body_file=$delete_body_file_p \ -headers $headers \ -timeout $timeout \ -depth $depth \ @@ -878,11 +1048,13 @@ } ad_proc -private util::http::request { - -url + -url {-method GET} - {-headers ""} + {-headers ""} {-body ""} - {-timeout 30} + {-body_file ""} + -delete_body_file:boolean + {-timeout 30} {-depth 0} {-max_depth 10} -force_ssl:boolean @@ -898,30 +1070,39 @@ server when doing the request. Some options exist that allow to avoid the need to specify headers manually, but headers will always take precedence over options. - + @param body is the payload for the request and will be passed as is (useful for many purposes, such as webDav). A convenient way to specify form variables for POST payloads through this argument is passing a string obtained by export_vars -url. + @param body_file is an alternative way to specify the payload, + useful in cases such as the upload of big files by POST. If + specified, will have precedence over the body + parameter. Content of the file won't be encoded according with the + content type of the request as happen with body + + @param delete_body_file decides whether remove body payload file + once the request is over. + @param gzip_request informs the server that we are sending data in gzip format. Data will be automatically compressed. Notice that not all servers can treat gzipped requests properly, and in such cases response will likely be an error. - + @param gzip_response informs the server that we are capable of receiving gzipped responses. If server complies to our indication, the result will be automatically decompressed. - + @param force_ssl specifies wether we want to use SSL despite the url being in http:// form. Default behavior is to use SSL on https:// urls only. - + @param spool enables file spooling of the request on the file specified. It is useful when we expect large responses from the server. The result is spooled to a temporary file, the name is returned in the file component of the result. - + @param post_redirect decides what happens when we are POSTing and server replies with 301, 302 or 303 redirects. RFC 2616/10.3.2 states that method should not change when 301 or 302 are returned, @@ -931,18 +1112,18 @@ conserve their original method. Notice that, as from RFC, a 303 redirect won't send again any data to the server, as specification says we can assume variables to have been received. - + @param max_depth is the maximum number of redirects the proc is - allowed to follow. A value of 0 disables redirection. When max - depth for redirection has been reached, proc will return response - from the last page we were redirected to. This is important if + allowed to follow. A value of 0 disables redirection. When max + depth for redirection has been reached, proc will return response + from the last page we were redirected to. This is important if redirection response contains data such as cookies we need to obtain anyway. Be aware that when following redirects, unless it is a code 303 redirect, url and POST urlencoded variables will be sent again to the redirected host. Multipart variables won't be sent again. Sending to the redirected host can be dangerous, if such host is not trusted or uses a lower level of security. - + @param preference decides which available implementation prefer in respective order. Choice is between 'native', based on ns_ api, available for NaviServer only and giving the best performances and @@ -951,21 +1132,23 @@ @param timeout Timeout in seconds. The value can be an integer, a floating point number or an ns_time value. - + @return Returns the data as dict with elements headers, page, file, status, and modified. -} { +} { set this_proc [lindex [info level 0] 0] - + set impl [available -url $url -force_ssl=$force_ssl_p -preference $preference -spool=$spool_p] if {$impl eq ""} { return -code error "${this_proc}: HTTP client functionalities for this protocol are not available with current system configuration." } - + return [util::http::${impl}::request \ -method $method \ -body $body \ + -body_file $body_file \ + -delete_body_file=$delete_body_file_p \ -headers $headers \ -url $url \ -timeout $timeout \ @@ -988,7 +1171,7 @@ ad_proc -private util::http::native::timeout {input} { Convert the provided value to a ns_time format - used be NaviServer + used by NaviServer } { if {[string is integer -strict $input]} { @@ -1001,11 +1184,13 @@ } ad_proc -private util::http::native::request { - -url + -url {-method GET} - {-headers ""} + {-headers ""} {-body ""} - {-timeout 30} + {-body_file ""} + -delete_body_file:boolean + {-timeout 30} {-depth 0} {-max_depth 10} -force_ssl:boolean @@ -1017,35 +1202,44 @@ Issue an HTTP request either GET or POST to the url specified. This is the native implementation based on NaviServer HTTP api. - + @param headers specifies an ns_set of extra headers to send to the server when doing the request. Some options exist that allow to avoid the need to specify headers manually, but headers will always take precedence over options. - + @param body is the payload for the request and will be passed as is (useful for many purposes, such as webDav). A convenient way to specify form variables for POST payloads through this argument is passing a string obtained by export_vars -url. + @param body_file is an alternative way to specify the payload, + useful in cases such as the upload of big files by POST. If + specified, will have precedence over the body + parameter. Content of the file won't be encoded according with the + content type of the request as happen with body + + @param delete_body_file decides whether remove body payload file + once the request is over. + @param gzip_request informs the server that we are sending data in gzip format. Data will be automatically compressed. Notice that not all servers can treat gzipped requests properly, and in such cases response will likely be an error. - + @param gzip_response informs the server that we are capable of receiving gzipped responses. If server complies to our indication, the result will be automatically decompressed. - + @param force_ssl specifies wether we want to use SSL despite the url being in http:// form. Default behavior is to use SSL on https:// urls only. - + @param spool enables file spooling of the request on the file specified. It is useful when we expect large responses from the server. The result is spooled to a temporary file, the name is returned in the file component of the result. - + @param post_redirect decides what happens when we are POSTing and server replies with 301, 302 or 303 redirects. RFC 2616/10.3.2 states that method should not change when 301 or 302 are returned, @@ -1055,11 +1249,11 @@ conserve their original method. Notice that, as from RFC, a 303 redirect won't send again any data to the server, as specification says we can assume variables to have been received. - + @param max_depth is the maximum number of redirects the proc is - allowed to follow. A value of 0 disables redirection. When max - depth for redirection has been reached, proc will return response - from the last page we were redirected to. This is important if + allowed to follow. A value of 0 disables redirection. When max + depth for redirection has been reached, proc will return response + from the last page we were redirected to. This is important if redirection response contains data such as cookies we need to obtain anyway. Be aware that when following redirects, unless it is a code 303 redirect, url and POST urlencoded variables will @@ -1069,17 +1263,17 @@ @param timeout Timeout in seconds. The value can be an integer, a floating point number or an ns_time value. - + @return Returns the data as dict with elements headers, page, file, status, and modified. } { set this_proc [lindex [info level 0] 0] - + if {![regexp "^(https|http)://*" $url]} { return -code error "${this_proc}: Invalid url: $url" } - + # Check wether we will use ssl or not if {$force_ssl_p || [string match "https://*" $url]} { set http_api [util::http::native_https_api] @@ -1089,11 +1283,11 @@ } else { set http_api "ns_http" } - + if {$headers eq ""} { set headers [ns_set create headers] } - + # Determine wether we want to gzip the request. # Servers uncapable of treating such requests will likely throw an error... set req_content_encoding [ns_set iget $headers "content-encoding"] @@ -1102,7 +1296,7 @@ } elseif {$gzip_request_p} { ns_set put $headers "Content-Encoding" "gzip" } - + # See if we want the response to be gzipped by headers or options # Server can decide to ignore this and serve the encoding he desires. # I also say to server that whatever he can give me will do, in case. @@ -1112,46 +1306,48 @@ } elseif {$gzip_response_p} { ns_set put $headers "Accept-Encoding" "gzip, */*" } - + # zlib is mandatory when requiring compression if {$gzip_request_p || $gzip_response_p} { if {[info commands zlib] eq ""} { return -code error "${this_proc}: zlib support not enabled" } } - + ## Encoding of the request - + # Any conversion or encoding of the payload should happen only at # the first request and not on redirects if {$depth == 0} { set content_type [ns_set iget $headers "content-type"] if {$content_type eq ""} { set content_type "text/plain; charset=[ns_config ns/parameters OutputCharset iso-8859-1]" } - + set enc [util::http::get_channel_settings $content_type] if {$enc ne "binary"} { set body [encoding convertto $enc $body] } - + if {$gzip_request_p} { set body [zlib gzip $body] } } - - + + ## Issuing of the request - + set queue_cmd [list $http_api queue \ -timeout [timeout $timeout] \ -method $method \ -headers $headers] - if {$body ne ""} { + if {$body_file ne ""} { + lappend queue_cmd -body_file $body_file + } elseif {$body ne ""} { lappend queue_cmd -body $body } lappend queue_cmd $url - + set resp_headers [ns_set create resp_headers] set wait_cmd [list $http_api wait -headers $resp_headers -status status] if {$spool_p} { @@ -1167,7 +1363,7 @@ lappend wait_cmd -decompress } } - + # Queue call to the url and wait for response {*}$wait_cmd [{*}$queue_cmd] @@ -1186,34 +1382,39 @@ set r_headers [ns_set array $resp_headers] ns_set free $resp_headers - + # Redirection handling if {$depth <= $max_depth} { incr depth set redirection [util::http::follow_redirects \ - -url $url \ - -method $method \ - -status $status \ - -location $location \ - -body $body \ - -headers $headers \ - -timeout $timeout \ - -depth $depth \ - -max_depth $max_depth \ - -force_ssl=$force_ssl_p \ - -gzip_request=$gzip_request_p \ - -gzip_response=$gzip_response_p \ - -post_redirect=$post_redirect_p \ - -spool=$spool_p \ - -preference "native"] + -url $url \ + -method $method \ + -status $status \ + -location $location \ + -body $body \ + -body_file $body_file \ + -delete_body_file=$delete_body_file_p \ + -headers $headers \ + -timeout $timeout \ + -depth $depth \ + -max_depth $max_depth \ + -force_ssl=$force_ssl_p \ + -gzip_request=$gzip_request_p \ + -gzip_response=$gzip_response_p \ + -post_redirect=$post_redirect_p \ + -spool=$spool_p \ + -preference "native"] if {$redirection ne ""} { return $redirection } } - - + + if {$delete_body_file_p} { + file delete -force $body_file + } + ## Decoding of the response - + # If response was compressed and our NaviServer # is prior 4.99.6, we have to decompress on our own. if {$content_encoding eq "gzip"} { @@ -1223,14 +1424,14 @@ } } } - + # Translate into proper encoding set enc [util::http::get_channel_settings $content_type] if {$enc ne "binary"} { set page [encoding convertfrom $enc $page] } - - + + return [list \ headers $r_headers \ page $page \ @@ -1257,7 +1458,12 @@ } { Gets Curl's version number. } { - return [util_memoize [list util::http::curl::version_not_cached]] + set key ::util::http::curl::version + if {[info exists $key]} { + return [set $key] + } else { + return [set $key [util::http::curl::version_not_cached]] + } } ad_proc -private util::http::curl::timeout {input} { @@ -1282,12 +1488,14 @@ } ad_proc -private util::http::curl::request { - -url + -url {-method GET} - {-headers ""} + {-headers ""} {-body ""} + {-body_file ""} + -delete_body_file:boolean {-files {}} - {-timeout 30} + {-timeout 30} {-depth 0} {-max_depth 10} -force_ssl:boolean @@ -1300,40 +1508,50 @@ Issue an HTTP request either GET or POST to the url specified. This is the curl wrapper implementation, used on Aolserver and when ssl native capabilities are not available. - + @param headers specifies an ns_set of extra headers to send to the server when doing the request. Some options exist that allow to avoid the need to specify headers manually, but headers will always take precedence over options. - + @param body is the payload for the request and will be passed as is (useful for many purposes, such as webDav). A convenient way to specify form variables for POST payloads through this argument is passing a string obtained by export_vars -url. + @param body_file is an alternative way to specify the payload, + useful in cases such as the upload of big files by POST. If + specified, will have precedence over the body + parameter. Content of the file won't be encoded according with the + content type of the request as happen with body + + @param delete_body_file decides whether remove body payload file + once the request is over. + @param gzip_request informs the server that we are sending data in gzip format. Data will be automatically compressed. Notice that not all servers can treat gzipped requests properly, and in such cases response will likely be an error. @param files curl is natively capable to send files via POST - requests, and exploiting it can be desirable to overcome the still - relevant 2GB limitation on tcl vars, that is, to send very large - files via POST. Files by this parameter are couples in the form - { form_field_name file_path_on_filesystem } - + requests, and exploiting it can be desirable to send very large + files via POST, because no extra space will be required on the + disk to prepare the request payload using this feature. Files by + this parameter are couples in the form { form_field_name + file_path_on_filesystem } + @param gzip_response informs the server that we are capable of receiving gzipped responses. If server complies to our - indication, the result will be automatically decompressed. - + indication, the result will be automatically decompressed. + @param force_ssl is ignored when using curl http client implementation and is only kept for cross compatibility. - + @param spool enables file spooling of the request on the file specified. It is useful when we expect large responses from the server. The result is spooled to a temporary file, the name is returned in the file component of the result. - + @param post_redirect decides what happens when we are POSTing and server replies with 301, 302 or 303 redirects. RFC 2616/10.3.2 states that method should not change when 301 or 302 are returned, @@ -1346,11 +1564,11 @@ by GET method. If following by POST is a requirement, please consider switching to the native http client implementation, or update curl. - + @param max_depth is the maximum number of redirects the proc is - allowed to follow. A value of 0 disables redirection. When max - depth for redirection has been reached, proc will return response - from the last page we were redirected to. This is important if + allowed to follow. A value of 0 disables redirection. When max + depth for redirection has been reached, proc will return response + from the last page we were redirected to. This is important if redirection response contains data such as cookies we need to obtain anyway. Be aware that when following redirects, unless it is a code 303 redirect, url and POST urlencoded variables will @@ -1362,21 +1580,21 @@ floating point number or an ns_time value. Since curl versions before 7.32.0 just accept integer, the granularity is set to seconds. - + @return Returns the data as dict with elements headers, page, file, status, and modified. } { set this_proc [lindex [info level 0] 0] - + if {![regexp "^(https|http)://*" $url]} { return -code error "${this_proc}: Invalid url: $url" } - + if {$headers eq ""} { set headers [ns_set create headers] } - + # Determine wether we want to gzip the request. # Default is no, can't know wether the server accepts it. # We could at the http api level (TODO?) @@ -1386,16 +1604,16 @@ } elseif {$gzip_request_p} { ns_set put $headers "Content-Encoding" "gzip" } - - # Curls accepts gzip by default, so if gzip response is not required + + # Curls accepts gzip by default, so if gzip response is not required # we have to ask explicitly for a plain text enconding set req_accept_encoding [ns_set iget $headers "accept-encoding"] if {$req_accept_encoding ne ""} { set gzip_response_p [string match "*gzip*" $req_accept_encoding] } elseif {!$gzip_response_p} { ns_set put $headers "Accept-Encoding" "utf-8" } - + # zlib is mandatory when compressing the input if {$gzip_request_p} { if {[info commands zlib] eq ""} { @@ -1404,25 +1622,25 @@ } ## Encoding of the request - + # Any conversion or encoding of the payload should happen only at # the first request and not on redirects if {$depth == 0} { set content_type [ns_set iget $headers "content-type"] if {$content_type eq ""} { set content_type "text/plain; charset=[ns_config ns/parameters OutputCharset iso-8859-1]" } - + set enc [util::http::get_channel_settings $content_type] if {$enc ne "binary"} { set body [encoding convertto $enc $body] } - + if {$gzip_request_p} { set body [zlib gzip $body] } } - + ## Issuing of the request set cmd [list exec curl -s] @@ -1433,20 +1651,20 @@ } else { set spool_file "" } - + if {$timeout ne ""} { lappend cmd --connect-timeout [timeout $timeout] - } + } # Antonio Pisano 2015-09-28: curl can follow redirects # out of the box, but its behavior is to throw an error -# when maximum depth has been reached. I want it to +# when maximum depth has been reached. I want it to # return even a 3** page without complaining. # # Set redirection up to max_depth # if {$max_depth ne ""} { # lappend cmd -L --max-redirs $max_depth # } - + if {$method eq "GET"} { lappend cmd -G } @@ -1458,34 +1676,38 @@ } set f [join $f "=@"] lappend cmd -F $f - } - + } + # If required, we'll follow POST request redirections by GET if {!$post_redirect_p} { lappend cmd --post301 --post302 if {[apm_version_names_compare [version] "7.26"] >= 0} { lappend cmd --post303 } } - + # Curl can decompress response transparently if {$gzip_response_p} { lappend cmd --compressed } - - # Unfortunately, as we are interacting with a shell, there - # is no way to escape content in an easy and safe way. We - # just spool body content to a file and let it be read by curl. - set data_binary_tmpfile [ad_tmpnam] - set wfd [open $data_binary_tmpfile w] - fconfigure $wfd -translation binary - puts -nonewline $wfd $body - close $wfd - lappend cmd --data-binary "@${data_binary_tmpfile}" - + + # Unfortunately, as we are interacting with a shell, there is no + # way to escape content easily and safely. Even when body is + # passed as a tcl variable, we just write its content to a file + # and let it be read by curl. + set create_body_file_p [expr {$body_file eq ""}] + if {$create_body_file_p} { + set body_file [ad_tmpnam] + set wfd [open $body_file w] + fconfigure $wfd -translation binary + puts -nonewline $wfd $body + close $wfd + } + lappend cmd --data-binary "@${body_file}" + # Return response code toghether with webpage lappend cmd -w " %\{http_code\}" - + # Add headers to the command line foreach {key value} [ns_set array $headers] { if {$value eq ""} { @@ -1496,14 +1718,14 @@ set header "${key}${value}" lappend cmd -H "$header" } - + # Dump response headers into a tempfile to get them set resp_headers_tmpfile [ad_tmpnam] lappend cmd -D $resp_headers_tmpfile lappend cmd $url set response [{*}$cmd] - + # Parse headers from dump file set resp_headers [ns_set create resp_headers] set rfd [open $resp_headers_tmpfile r] @@ -1514,56 +1736,60 @@ ns_set put $resp_headers $key [string trim $value] } close $rfd - + # Get values from response headers, then remove them set content_type [ns_set iget $resp_headers content-type] set last_modified [ns_set iget $resp_headers last-modified] set location [ns_set iget $resp_headers location] # Move in a list to be returned to the caller set r_headers [ns_set array $resp_headers] ns_set free $resp_headers - + set status [string range $response end-2 end] set page [string range $response 0 end-4] - + # Redirection handling if {$depth <= $max_depth} { incr depth set redirection [util::http::follow_redirects \ - -url $url \ - -method $method \ - -status $status \ - -location $location \ - -body $body \ - -headers $headers \ - -timeout $timeout \ - -depth $depth \ - -max_depth $max_depth \ - -force_ssl=$force_ssl_p \ - -gzip_request=$gzip_request_p \ - -gzip_response=$gzip_response_p \ - -post_redirect=$post_redirect_p \ - -spool=$spool_p \ - -preference "curl"] + -url $url \ + -method $method \ + -status $status \ + -location $location \ + -body $body \ + -body_file $body_file \ + -delete_body_file=$delete_body_file_p \ + -headers $headers \ + -timeout $timeout \ + -depth $depth \ + -max_depth $max_depth \ + -force_ssl=$force_ssl_p \ + -gzip_request=$gzip_request_p \ + -gzip_response=$gzip_response_p \ + -post_redirect=$post_redirect_p \ + -spool=$spool_p \ + -preference "curl"] if {$redirection ne ""} { return $redirection } } - + if {$spool_file ne ""} { set page "${this_proc}: response spooled to '$spool_file'" } - + # Translate into proper encoding set enc [util::http::get_channel_settings $content_type] if {$enc ne "binary"} { set page [encoding convertfrom $enc $page] } - + # Delete temp files file delete $resp_headers_tmpfile - file delete $data_binary_tmpfile - + if {$create_body_file_p || $delete_body_file_p} { + file delete -force $body_file + } + return [list \ headers $r_headers \ page $page \ @@ -1573,17 +1799,17 @@ } ad_proc -public util::get_http_status { - -url - {-use_get_p 1} + -url + {-use_get_p 1} {-timeout 30} } { - Returns the HTTP status code, e.g., 200 for a normal response - or 500 for an error, of a URL. By default this uses the GET method - instead of HEAD since not all servers will respond properly to a - HEAD request even when the URL is perfectly valid. Note that - this means that the server may be sucking down a lot of bits that it + Returns the HTTP status code, e.g., 200 for a normal response + or 500 for an error, of a URL. By default this uses the GET method + instead of HEAD since not all servers will respond properly to a + HEAD request even when the URL is perfectly valid. Note that + this means that the server may be sucking down a lot of bits that it doesn't need. -} { +} { set result [util::http::request \ -url $url \ -method [expr {$use_get_p ? "GET" : "HEAD"}] \ @@ -1593,12 +1819,12 @@ ad_proc -public util::link_responding_p { - -url + -url {-list_of_bad_codes "404"} } { Returns 1 if the URL is responding (generally we think that anything other than 404 (not found) is okay). - @see util::get_http_status + @see util::get_http_status } { if { [catch { set status [util::get_http_status -url $url] } errmsg] } { # got an error; definitely not valid @@ -1619,7 +1845,7 @@ ######################### ad_proc -deprecated -public util_link_responding_p { - url + url {list_of_bad_codes "404"} } { Returns 1 if the URL is responding (generally we think that anything other than 404 (not found) is okay). @@ -1630,32 +1856,32 @@ } ad_proc -public -deprecated util_get_http_status { - url - {use_get_p 1} + url + {use_get_p 1} {timeout 30} } { - Returns the HTTP status code, e.g., 200 for a normal response - or 500 for an error, of a URL. By default this uses the GET method - instead of HEAD since not all servers will respond properly to a - HEAD request even when the URL is perfectly valid. Note that - this means AOLserver may be sucking down a lot of bits that it + Returns the HTTP status code, e.g., 200 for a normal response + or 500 for an error, of a URL. By default this uses the GET method + instead of HEAD since not all servers will respond properly to a + HEAD request even when the URL is perfectly valid. Note that + this means AOLserver may be sucking down a lot of bits that it doesn't need. @see util::get_http_status -} { +} { return [util::get_http_status -url $url -use_get_p $use_get_p -timeout $timeout] } ad_proc -deprecated -public ad_httpget { - -url - {-headers ""} + -url + {-headers ""} {-timeout 30} {-depth 0} } { Just like ns_httpget, but first headers is an ns_set of headers to send during the fetch. - ad_httpget also makes use of Conditional GETs (if called with a + ad_httpget also makes use of Conditional GETs (if called with a Last-Modified header). Returns the data in array get form with array elements page status modified. @@ -1677,25 +1903,25 @@ if {$status == 302 || $status == 301} { set location [ns_set iget $headers location] - if {$location ne ""} { + if {$location ne ""} { ns_set free $headers close $rfd return [ad_httpget -url $location -timeout $timeout -depth $depth] } } elseif { $status == 304 } { # The requested variant has not been modified since the time specified - # A conditional get didn't return anything. return an empty page and + # A conditional get didn't return anything. return an empty page and set page {} ns_set free $headers close $rfd - } else { + } else { set length [ns_set iget $headers content-length] if { $length eq "" } {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] @@ -1715,8 +1941,8 @@ } } - # order matters here since we depend on page content - # being element 1 in this list in util_httpget + # order matters here since we depend on page content + # being element 1 in this list in util_httpget return [list page $page \ status $status \ modified $last_modified] @@ -1725,28 +1951,28 @@ ad_proc -deprecated -public util_httpget { url {headers ""} {timeout 30} {depth 0} } { - util_httpget simply calls util::http::get which also returns + util_httpget simply calls util::http::get which also returns status and last_modfied - + @see util::http::get } { return [dict get [util::http::get -url $url -headers $headers -timeout $timeout -depth $depth] page] } -# httppost; give it a URL and a string with formvars, and it +# 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: +# formvars are the posted variables in the following form: # arg1=value1&arg2=value2 # in the event of an error or timeout, -1 is returned ad_proc -deprecated -public util_httppost {url formvars {timeout 30} {depth 0} {http_referer ""}} { - 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\". -

+ 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). -

+

@see util_http_file_upload } { if { [catch { @@ -1808,19 +2034,19 @@ return $page } -# system by Tracy Adams (teadams@arsdigita.com) to permit AOLserver to POST +# system by Tracy Adams (teadams@arsdigita.com) to permit AOLserver to POST # to another Web server; sort of like ns_httpget ad_proc -deprecated -public util_httpopen { - method - url - {rqset ""} - {timeout 30} + method + url + {rqset ""} + {timeout 30} {http_referer ""} -} { +} { Like ns_httpopen but works for POST as well; called by util_httppost -} { - +} { + if { ![string match "http://*" $url] } { return -code error "Invalid url \"$url\": _httpopen only supports HTTP" } @@ -1845,8 +2071,8 @@ _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" + _ns_http_puts $timeout $wfd "User-Agent: Mozilla/1.01 \[en\] (Win95; I)\r" + _ns_http_puts $timeout $wfd "Referer: $http_referer \r" } } errMsg] } { @@ -1856,22 +2082,22 @@ return -1 } return [list $rfd $wfd ""] - + } -ad_proc -deprecated -public util_http_file_upload { -file -data -binary:boolean -filename - -name {-mime_type */*} {-mode formvars} - {-rqset ""} url {formvars {}} {timeout 30} +ad_proc -deprecated -public util_http_file_upload { -file -data -binary:boolean -filename + -name {-mime_type */*} {-mode formvars} + {-rqset ""} url {formvars {}} {timeout 30} {depth 10} {http_referer ""} } { - Implement client-side HTTP file uploads as multipart/form-data as per + Implement client-side HTTP file uploads as multipart/form-data as per RFC 1867.

- Similar to util_httppost, - but enhanced to be able to upload a file as multipart/form-data. - Also useful for posting to forms that require their input to be encoded - as multipart/form-data instead of as + Similar to util_httppost, + but enhanced to be able to upload a file as multipart/form-data. + Also useful for posting to forms that require their input to be encoded + as multipart/form-data instead of as application/x-www-form-urlencoded.

@@ -1885,7 +2111,7 @@

- If you specify either -file or -data you + If you specify either -file or -data you must supply a value for -name, which is the name of the <INPUT TYPE="file" NAME="..."> form tag. @@ -1907,10 +2133,10 @@

If -mime_type is not specified then ns_guesstype - is used to try and find a mime type based on the filename. + is used to try and find a mime type based on the filename. If ns_guesstype returns */* the generic value of application/octet-stream will be used. - +

Any form variables may be specified in one of four formats: @@ -1944,7 +2170,7 @@ error "Invalid mode \"$mode\"; should be one of: formvars,\ array, ns_set, vars" } - + if {[info exists file] && [info exists data]} { error "Both -file and -data are mutually exclusive; can't use both" } @@ -1979,14 +2205,14 @@ if {![info exists name]} { error "Cannot upload file without specifing form variable -name" } - + if {![info exists filename]} { error "Cannot upload file without specifing -filename" } - + if {$mime_type eq "*/*" || $mime_type eq ""} { set mime_type [ns_guesstype $filename] - + if {$mime_type eq "*/*" || $mime_type eq ""} { set mime_type application/octet-stream } @@ -2017,7 +2243,7 @@ set variables [list] switch -- $mode { array { - set variables $formvars + set variables $formvars } formvars { @@ -2063,7 +2289,7 @@ Recursive redirection: $url" } - lassign [util_httpopen POST $url $rqset $timeout $http_referer] rfd wfd + lassign [util_httpopen POST $url $rqset $timeout $http_referer] rfd wfd _ns_http_puts $timeout $wfd \ "Content-type: multipart/form-data; boundary=$boundary\r" @@ -2072,7 +2298,7 @@ _ns_http_puts $timeout $wfd "$payload\r" flush $wfd close $wfd - + set rpset [ns_set new [_ns_http_gets $timeout $rfd]] while 1 { set line [_ns_http_gets $timeout $rfd] @@ -2116,7 +2342,7 @@ set page -1 } - + return $page }