- 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"
- }
- set http [util_httpopen POST $url "" $timeout $http_referer]
- set rfd [lindex $http 0]
- set wfd [lindex $http 1]
-
- #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 { ![string length $line] } 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 ""}} {
Should be called at end of private Tcl library files so that it is
easy to see in the error log whether or not private Tcl library
files contain errors.
@@ -1508,7 +1401,7 @@
return [expr { [info exists var] && $var ne "" }]
}
-ad_proc -public exists_or_null { varname } {
+ad_proc -public -deprecated exists_or_null { varname } {
Returns the contents of the variable if it exists, otherwise returns empty string
} {
upvar 1 $varname var
@@ -1531,7 +1424,7 @@
return [expr { [info exists var] && $var eq $value } ]
}
-ad_proc -private set_encoding {
+ad_proc -deprecated -private set_encoding {
{-text_translation {auto binary}}
content_type
channel
@@ -1617,97 +1510,12 @@
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"
- }
-
- set http [ns_httpopen GET $url $headers $timeout]
- set rfd [lindex $http 0]
- close [lindex $http 1]
- set headers [lindex $http 2]
- 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
-ad_proc util_escape_quotes_for_csv {string} "Returns its argument with double quote replaced by backslash double quote" {
+ad_proc util_escape_quotes_for_csv {string} {
+ Returns its argument with double quote replaced by backslash double quote
+} {
regsub -all \" $string {\"} result
return $result
@@ -1782,7 +1590,7 @@
# check that either all elements are blank
# date value is formated correctly for ns_dbformvalue
- if { [empty_string_p "$day$month$year"] } {
+ if { "$day$month$year" eq "" } {
if { $allow_null == 0 } {
error "$field_name must be supplied"
} else {
@@ -1797,7 +1605,10 @@
return $date
}
-ad_proc -private util_WriteWithExtraOutputHeaders {headers_so_far {first_part_of_page ""}} {
+ad_proc -private util_WriteWithExtraOutputHeaders {
+ headers_so_far
+ {first_part_of_page ""}
+} {
Takes in a string of headers to write to an HTTP connection,
terminated by a newline. Checks \[ad_conn outputheaders\] and adds
those headers if appropriate. Adds two newlines at the end and writes
@@ -1815,7 +1626,9 @@
ns_write $entire_string_to_write
}
-ad_proc -public ReturnHeaders {{content_type text/html}} {
+ad_proc -private ReturnHeaders {
+ {content_type text/html}
+} {
We use this when we want to send out just the headers
and then do incremental writes with ns_write. This way the user
doesn't have to wait for streamed output (useful when doing
@@ -1825,7 +1638,7 @@
any added to outputheaders.
} {
- if {[string match "text/*" $content_type] && ![string match *charset=* $content_type]} {
+ if {[string match "text/*" $content_type] && ![string match "*charset=*" $content_type]} {
append content_type "; charset=[ns_config ns/parameters OutputCharset iso-8859-1]"
}
@@ -1844,8 +1657,12 @@
}
}
-ad_proc -public ad_return_top_of_page {first_part_of_page {content_type text/html}} {
+ad_proc -public ad_return_top_of_page {
+ first_part_of_page
+ {content_type text/html}
+} {
Returns HTTP headers plus the top of the user-visible page.
+ To be used with streaming HTML output
} {
ReturnHeaders $content_type
if { $first_part_of_page ne "" } {
@@ -1873,7 +1690,7 @@
return [ad_apply uplevel $args]
}
-ad_proc -public lmap {list proc_name} {
+ad_proc -public -deprecated lmap {list proc_name} {
Applies proc_name to each item of the list, appending the result of
each call to a new list that is the return value.
} {
@@ -1897,7 +1714,7 @@
set counter 1
- while { $counter < [expr {$num_args - 2}] } {
+ while { $counter < $num_args - 2 } {
lappend from_list [lindex $args $counter]
incr counter
lappend to_list [lindex $args $counter]
@@ -1928,6 +1745,33 @@
return $ad_encoded_string
}
+if {[ns_info name] eq "NaviServer"} {
+ ad_proc -public ad_urlencode_path { string } {
+ encode provided string with url-encoding for paths (instead of queries) as defined in RFC 3986
+ } {
+ return [ns_urlencode -part path $string]
+ }
+ ad_proc -public ad_urldecode_path { string } {
+ decode provided string with url-encoding for paths (instead of queries) as defined in RFC 3986
+ } {
+ return [ns_urldecode -part path $string]
+ }
+} else {
+ ad_proc -public ad_urlencode_path { string } {
+ encode provided string with url-encodingfor paths;
+ same as ad_urlencode, since aolserver does not support this difference
+ } {
+ return [ad_urlencode $string]
+ }
+ ad_proc -public ad_urldecode_path { string } {
+ decode provided string with url-encoding for paths;
+ same as ns_urldecode, since aolserver does not support this difference
+ } {
+ return [ns_urldecode $string]
+ }
+}
+
+
ad_proc -public ad_get_cookie {
{ -include_set_cookies t }
name
@@ -1936,12 +1780,13 @@
Returns the value of a cookie, or $default if none exists.
} {
- if { $include_set_cookies eq "t" } {
+ if { $include_set_cookies == "t" } {
set headers [ns_conn outputheaders]
set nr_headers [ns_set size $headers]
for { set i 0 } { $i < $nr_headers } { incr i } {
- if { [string tolower [ns_set key $headers $i]] eq "set-cookie" && \
- [regexp "^$name=(\[^;\]*)" [ns_set value $headers $i] match value] } {
+ if { [string tolower [ns_set key $headers $i]] eq "set-cookie"
+ && [regexp "^$name=(\[^;\]*)" [ns_set value $headers $i] match value]
+ } {
return $value
}
}
@@ -1965,19 +1810,21 @@
}
ad_proc -public ad_set_cookie {
- {
- -replace f
- -secure f
- -expire f
- -max_age ""
- -domain ""
- -path "/"
- -discard f
- }
- name {value ""}
+ {-replace f}
+ {-secure f}
+ {-expire f}
+ {-max_age ""}
+ {-domain ""}
+ {-path "/"}
+ {-discard f}
+ name
+ {value ""}
} {
- Sets a cookie.
+ Sets a cookie. This function can be used as well to clear a cookie via:
+
+ ad_set_cookie -replace t -max_age 0 -domain $domain ad_session_id ""
+
@param max_age specifies the maximum age of the cookies in
seconds (consistent with RFC 2109). max_age inf specifies cookies
@@ -2013,8 +1860,9 @@
if { $replace } {
# Try to find an already-set cookie named $name.
for { set i 0 } { $i < [ns_set size $headers] } { incr i } {
- if { [string tolower [ns_set key $headers $i]] eq "set-cookie" &&
- [string match "$name=*" [ns_set value $headers $i]] } {
+ if { [string tolower [ns_set key $headers $i]] eq "set-cookie"
+ && [string match "$name=*" [ns_set value $headers $i]]
+ } {
ns_set delete $headers $i
}
}
@@ -2031,7 +1879,7 @@
append cookie "; Path=$path"
}
- if { $discard ne "f" } {
+ if { $discard != "f" } {
append cookie "; Discard"
} elseif { $max_age eq "inf" } {
if { !$expire } {
@@ -2067,14 +1915,8 @@
}
# Grab information about the scheduled procedure.
- set thread [lindex $proc_info 0]
- set once [lindex $proc_info 1]
- set interval [lindex $proc_info 2]
- set proc [lindex $proc_info 3]
- set args [lindex $proc_info 4]
- set time [lindex $proc_info 5]
+ lassign $proc_info thread once interval proc args time . debug
set count 0
- set debug [lindex $proc_info 7]
ns_mutex lock [nsv_get ad_procs mutex]
set procs [nsv_get ad_procs .]
@@ -2094,7 +1936,7 @@
}
}
- if { $once eq "f" } {
+ if { $once == "f" } {
# The proc will run again - readd it to the shared variable (updating ns_time and
# incrementing the count).
lappend procs [list $thread $once $interval $proc $args [ns_time] [expr { $count + 1 }] $debug]
@@ -2118,13 +1960,11 @@
}
ad_proc -public ad_schedule_proc {
- {
- -thread f
- -once f
- -debug f
- -all_servers f
- -schedule_proc ""
- }
+ {-thread f}
+ {-once f}
+ {-debug f}
+ {-all_servers f}
+ {-schedule_proc ""}
interval
proc
args
@@ -2148,7 +1988,7 @@
} {
# we don't schedule a proc to run if we have enabled server clustering,
# we're not the canonical server, and the procedure was not requested to run on all servers.
- if { [server_cluster_enabled_p] && ![ad_canonical_server_p] && $all_servers eq "f" } {
+ if { [server_cluster_enabled_p] && ![ad_canonical_server_p] && $all_servers == "f" } {
return
}
@@ -2164,10 +2004,10 @@
ns_mutex unlock [nsv_get ad_procs mutex]
set my_args [list]
- if { $thread eq "t" } {
+ if { $thread == "t" } {
lappend my_args "-thread"
}
- if { $once eq "t" } {
+ if { $once == "t" } {
lappend my_args "-once"
}
@@ -2180,14 +2020,16 @@
}
}
-ad_proc util_ReturnMetaRefresh { url { seconds_delay 0 } } {
+ad_proc -deprecated util_ReturnMetaRefresh {
+ url
+ { seconds_delay 0 }
+} {
Ugly workaround to deal with IE5.0 bug handling
multipart/form-data using
Meta Refresh page instead of a redirect.
} {
- ReturnHeaders
- ns_write "
+ ad_return_top_of_page "