- 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 { - if {[incr depth] > 10} { - return -code error "util_httppost: Recursive redirection: $url" - } - lassign [util_httpopen POST $url "" $timeout $http_referer] rfd wfd - #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 { $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} { - global errorInfo - return -code error -errorinfo $errorInfo $errMsg - } - } errmgs ] } {return -1} - return $page -} - ad_proc -public util_report_successful_library_load { {extra_message ""} } { @@ -1627,95 +1498,6 @@ fconfigure $channel -translation $trl -encoding $enc } -ad_proc -public ad_httpget { - -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 - Last-Modified header). - - Returns the data in array get form with array elements page status modified. -} { - ns_log debug "Getting {$url} {$headers} {$timeout} {$depth}" - - if {[incr depth] > 10} { - return -code error "ad_httpget: Recursive redirection: $url" - } - - lassign [ns_httpopen GET $url $headers $timeout] rfd wfd headers - - close $wfd - set response [ns_set name $headers] - set status [lindex $response 1] - set last_modified [ns_set iget $headers last-modified] - - if {$status == 302 || $status == 301} { - set location [ns_set iget $headers location] - 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 - set page {} - - ns_set free $headers - close $rfd - } 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] - 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} { - global errorInfo - return -code error -errorinfo $errorInfo $errMsg - } - } - - # 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] -} - -ad_proc -public util_httpget { - url - {headers ""} - {timeout 30} - {depth 0} -} { - util_httpget simply calls ad_httpget which also returns - status and last_modfied - - @see ad_httpget -} { - return [lindex [ad_httpget -url $url -headers $headers -timeout $timeout -depth $depth] 1] -} - # some procs to make it easier to deal with CSV files (reading and writing) # added by philg@mit.edu on October 30, 1999 @@ -3266,276 +3048,6 @@ return 1 } -ad_proc -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 - 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 - application/x-www-form-urlencoded. - -
- - The switches -file /path/to/file and -data $raw_data - are mutually exclusive. You can specify one or the other, but not - both. NOTE: it is perfectly valid to not specify either, in which - case no file is uploaded, but form variables are encoded using - multipart/form-data instead of the usual encoding (as - noted aboved). - -
- - 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. - -
- - Specify the -binary switch if the file (or data) needs - to be base-64 encoded. Not all servers seem to be able to handle - this. (For example, http://mol-stage.usps.com/mml.adp, which - expects to receive an XML file doesn't seem to grok any kind of - Content-Transfer-Encoding.) - -
- - If you specify -file then -filename is optional - (it can be infered from the name of the file). However, if you - specify -data then it is mandatory. - -
- - If -mime_type is not specified then ns_guesstype - 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: -
- - -rqset specifies an ns_set of extra headers to send to - the server when doing the POST. - -
- - timeout, depth, and http_referer are optional, and are included - as optional positional variables in the same order they are used - in util_httppost. NOTE: util_http_file_upload does - not (currently) follow any redirects, so depth is superfulous. - - @author Michael A. Cleverly (michael@cleverly.com) - @creation-date 3 September 2002 -} { - - # sanity checks on switches given - if {$mode ni {formvars array ns_set vars}} { - 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" - } - - if {[info exists file]} { - if {![file exists $file]} { - error "Error reading file: $file not found" - } - - if {![file readable $file]} { - error "Error reading file: $file permission denied" - } - - set fp [open $file] - fconfigure $fp -translation binary - set data [read $fp] - close $fp - - if {![info exists filename]} { - set filename [file tail $file] - } - - if {"*/*" eq $mime_type || $mime_type eq ""} { - set mime_type [ns_guesstype $file] - } - } - - set boundary [ns_sha1 [list [clock clicks -milliseconds] [clock seconds]]] - set payload {} - - if {[info exists data] && [string length $data]} { - 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 - } - } - - if {$binary_p} { - set data [base64::encode base64] - set transfer_encoding base64 - } else { - set transfer_encoding binary - } - - append payload --$boundary \ - \r\n \ - "Content-Disposition: form-data; " \ - "name=\"$name\"; filename=\"$filename\"" \ - \r\n \ - "Content-Type: $mime_type" \ - \r\n \ - "Content-transfer-encoding: $transfer_encoding" \ - \r\n \ - \r\n \ - $data \ - \r\n - } - - - set variables [list] - switch -- $mode { - array { - set variables $formvars - } - - formvars { - foreach formvar [split $formvars &] { - set formvar [split $formvar =] - set key [lindex $formvar 0] - set val [join [lrange $formvar 1 end] =] - lappend variables $key $val - } - } - - ns_set { - for {set i 0} {$i < [ns_set size $formvars]} {incr i} { - set key [ns_set key $formvars $i] - set val [ns_set value $formvars $i] - lappend variables $key $val - } - } - - vars { - foreach key $formvars { - upvar 1 $key val - lappend variables $key $val - } - } - } - - foreach {key val} $variables { - append payload --$boundary \ - \r\n \ - "Content-Disposition: form-data; name=\"$key\"" \ - \r\n \ - \r\n \ - $val \ - \r\n - } - - append payload --$boundary-- \r\n - - if { [catch { - if {[incr depth -1] <= 0} { - return -code error "util_http_file_upload:\ - Recursive redirection: $url" - } - - lassign [util_httpopen POST $url $rqset $timeout $http_referer] rfd wfd - - _ns_http_puts $timeout $wfd \ - "Content-type: multipart/form-data; boundary=$boundary\r" - _ns_http_puts $timeout $wfd "Content-length: [string length $payload]\r" - _ns_http_puts $timeout $wfd \r - _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] - if { $line eq "" } break - ns_parseheader $rpset $line - } - - set headers $rpset - set response [ns_set name $headers] - set status [lindex $response 1] - 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} { - global errorInfo - return -code error -errorinfo $errorInfo $errMsg - } - } errmsg] } { - if {[info exists wfd] && $wfd in [file channels]} { - close $wfd - } - - if {[info exists rfd] && $rfd in [file channels]} { - close $rfd - } - - set page -1 - } - - return $page -} - ad_proc -public util_list_of_ns_sets_to_list_of_lists { {-list_of_ns_sets:required} } {