Index: openacs.org-dev/packages/acs-tcl/tcl/request-processor-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/acs-tcl/tcl/request-processor-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs.org-dev/packages/acs-tcl/tcl/request-processor-procs.tcl 9 Jul 2002 17:34:59 -0000 1.1
+++ openacs.org-dev/packages/acs-tcl/tcl/request-processor-procs.tcl 12 Dec 2002 12:21:34 -0000 1.2
@@ -4,7 +4,7 @@
single HTTP request to an ACS server.
@author Jon Salz (jsalz@arsdigita.com)
- @date 15 May 2000
+ @creation-date 15 May 2000
@cvs-id $Id$
}
@@ -14,6 +14,117 @@
#
#####
+ad_proc -public rp_internal_redirect {
+ -absolute_path:boolean
+ path
+} {
+
+ Tell the request processor to return some other page.
+
+ The path can either be relative to the current directory (e.g. "some-template")
+ relative to the server root (e.g. "/packages/my-package/www/some-template"), or
+ an absolute path (e.g. "/home/donb/openacs-4/templates/some-cms-template").
+
+ When there is no extension then the request processor will choose the
+ matching file according to the extension preferences.
+
+ Parameters will stay the same as in the initial request.
+
+ Keep in mind that if you do an internal redirect to something other than
+ the current directory that relative links returned to the clients
+ browser may be broken (since the client will have the original URL).
+
+ @param absolute_path If set the path is an absolute path within the host filesystem
+ @param path path to the file to serve
+
+} {
+
+ # protect from circular redirects
+ global __rp_internal_redirect_recursion_counter
+ if { ![info exists __rp_internal_redirect_recursion_counter] } {
+ set __rp_internal_redirect_recursion_counter 0
+ } elseif { $__rp_internal_redirect_recursion_counter > 10 } {
+ error "rp_internal_redirect: Recursion limit exceeded."
+ } else {
+ incr __rp_internal_redirect_recursion_counter
+ }
+
+ if { [string is false $absolute_path_p] } {
+ if { [string index $path 0] != "/" } {
+ # it's a relative path, prepend the current location
+ set path "[file dirname [ad_conn file]]/$path"
+ } else {
+ set path "[acs_root_dir]$path"
+ }
+ }
+
+ # save the current file setting
+ set saved_file [ad_conn file]
+
+ rp_serve_abstract_file $path
+
+ # restore the file setting. we need to do this because
+ # rp_serve_abstract_file sets it to the path we internally
+ # redirected to, and rp_handler will cache the file setting
+ # internally in the tcl_url2file variable when PerformanceModeP is
+ # switched on. This way it caches the location that was originally
+ # requested, not the path that we redirected to.
+ ad_conn -set file $saved_file
+}
+
+ad_proc rp_getform {} {
+
+ This proc is a simple wrapper around AOLserver's standard ns_getform
+ proc, that will create the form if it doesn't exist, so that you
+ can then add values to that form. This is useful in conjunction
+ with rp_internal_redirect to redirect to a different page with
+ certain query variables set.
+
+ @author Lars Pind (lars@pinds.com)
+ @creation-date August 20, 2002
+
+ @return the form ns_set, just like ns_getform, except it will
+ always be non-empty.
+
+} {
+ # The form may not exist, if there's nothing in it
+ if { ![empty_string_p [ns_getform]] } {
+ # It's there
+ return [ns_getform]
+ } {
+ # It doesn't exist, create a new one
+
+ # This is the magic global Tcl variable that AOLserver uses
+ # to store the ns_set that contains the query args or form.
+ global _ns_form
+
+ # Simply create a new ns_set and store it in the global _ns_set variable
+ set _ns_form [ns_set create]
+ return $_ns_form
+ }
+}
+
+ad_proc rp_form_put { name value } {
+
+ This proc adds a query variable to AOLserver's internal ns_getform
+ form, so that it'll be picked up by ad_page_contract and other procs
+ that look at the query variables or form supplied. This is useful
+ when you do an rp_internal_redirect to a new page, and you want to
+ feed that page with certain query variables.
+
+ @author Lars Pind (lars@pinds.com)
+ @creation-date August 20, 2002
+
+ @return the form ns_set, in case you're interested. Mostly you'll
+ probably want to discard the result.
+
+ } {
+ set form [rp_getform]
+ ns_set put $form $name $value
+ return $form
+}
+
+
ad_proc ad_return { args } {
Works like the "return" Tcl command, with one difference. Where
@@ -389,6 +500,28 @@
# End of patch "hostname-based subsites"
# -------------------------------------------------------------------------
+ # Force the URL to look like [ns_conn location], if desired...
+
+ # JCD: Only do this if ForceHostP set and root is {}
+ # if root non empty then we had a hostname based subsite and
+ # should not redirect since we got a hostname we know about.
+
+ set acs_kernel_id [util_memoize ad_acs_kernel_id]
+ if { [empty_string_p $root]
+ && [ad_parameter -package_id $acs_kernel_id ForceHostP request-processor 0] } {
+ set host_header [ns_set iget [ns_conn headers] "Host"]
+ regexp {^([^:]*)} $host_header "" host_no_port
+ regexp {^https?://([^:]+)} [ns_conn location] "" desired_host_no_port
+ if { $host_header != "" && [string compare $host_no_port $desired_host_no_port] } {
+ set query [ns_getform]
+ if { $query != "" } {
+ set query "?[export_entire_form_as_url_vars]"
+ }
+ ad_returnredirect "[ns_conn location][ns_conn url]$query"
+ return "filter_return"
+ }
+ }
+
# DRB: a bug in ns_conn causes urlc to be set to one and urlv to be set to
# {} if you hit the site with the host name alone. This confuses code that
# expects urlc to be set to zero and the empty list. This bug is probably due
@@ -425,6 +558,7 @@
ad_conn -set package_id $node(object_id)
ad_conn -set package_key $node(package_key)
ad_conn -set package_url $node(url)
+ ad_conn -set instance_name $node(instance_name)
ad_conn -set extra_url [string range [ad_conn url] [string length $node(url)] end]
}
@@ -466,9 +600,9 @@
if { ![empty_string_p [ad_conn object_id]]} {
ad_try {
if {[string match "admin/*" [ad_conn extra_url]]} {
- ad_require_permission [ad_conn object_id] admin
+ permission::require_permission -object_id [ad_conn object_id] -privilege admin
} else {
- ad_require_permission [ad_conn object_id] read
+ permission::require_permission -object_id [ad_conn object_id] -privilege read
}
} ad_script_abort val {
rp_finish_serving_page
@@ -520,11 +654,11 @@
set error_url [ad_conn url]
if { [llength [info procs ds_collection_enabled_p]] == 1 && [ds_collection_enabled_p] } {
- ds_add conn error $message
+ ad_call_proc_if_exists ds_add conn error $message
}
if {![ad_parameter -package_id [ad_acs_kernel_id] "RestrictErrorsToAdminsP" dummy 0] || \
- [ad_permission_p [ad_conn package_id] admin] } {
+ [permission::permission_p -object_id [ad_conn package_id] -privilege admin] } {
if { [ad_parameter -package_id [ad_acs_kernel_id] "AutomaticErrorReportingP" "rp" 0] } {
set error_info $message
set report_url [ad_parameter -package_id [ad_acs_kernel_id] "ErrorReportURL" "rp" ""]
@@ -533,11 +667,11 @@
} else {
set auto_report 1
ns_returnerror 200 "</table></table></table></h1></b></i>
- <form method=POST action='$report_url'>
+ <form method=\"post\" action=\"$report_url\">
[export_form_vars error_url error_info]
This file has generated an error.
-<input type=submit value='Report this error'>
-</form><hr>
+<input type=\"submit\" value='Report this error' />
+</form><hr />
<blockquote><pre>[ns_quotehtml $error_info]</pre></blockquote>[ad_footer]"
}
} else {
@@ -552,7 +686,11 @@
programmers.
"
}
- ns_log Error "[ns_conn method] $error_url [ns_conn query] $message"
+ set headers [ns_conn headers]
+ ns_log "Error" "[ns_conn method] http://[ns_set iget $headers host][ns_conn url]?[ns_conn query]
+referred by \"[ns_set iget $headers referer]\"
+$message"
+
}
ad_proc -private rp_path_prefixes {path} {
@@ -712,14 +850,18 @@
{-extension_pattern ".*"}
path
} {
+ Serves up a file given the abstract path. Raises the following
+ exceptions in the obvious cases:
+ <ul>
+ <li>notfound (passes back an empty value)
+ <li>redirect (passes back the url to which it wants to redirect)
+ <li>directory (passes back the path of the directory)
+ </ul>
- Serves up a file given the abstract path. Raises the following
- exceptions in the obvious cases:
+ Should not be used in .vuh files or elsewhere, instead
+ use the public function rp_internal_redirect.
- notfound (passes back an empty value)
- redirect (passes back the url to which it wants to redirect)
- directory (passes back the path of the directory)
-
+ @see rp_internal_redirect
} {
if { [string equal [string index $path end] "/"] } {
if { [file isdirectory $path] } {
@@ -872,6 +1014,7 @@
You probably want ad_acs_kernel_id, that is what has all the
useful parameters.
+ @see ad_acs_kernel_id
} {
return [db_string acs_admin_id_get {
select package_id from apm_packages
@@ -882,7 +1025,7 @@
ad_proc -public ad_conn {args} {
Returns a property about the connection. See the <a
- href="/doc/acs-kernel/request-processor/design.html">request
+ href="/doc/request-processor.html">request
processor documentation</a> for a list of allowable values. If -set
is passed then it sets a property.
@@ -931,6 +1074,7 @@
object_type ""
package_id ""
package_url ""
+ instance_name ""
package_key ""
extra_url ""
file ""
@@ -942,11 +1086,23 @@
}
-get {
- if { [info exists ad_conn($var)] } {
- return $ad_conn($var)
- } else {
- return [ns_conn $var]
- }
+ # Special handling for the form, because "ns_conn form" can
+ # cause the server to hang until the socket times out. This
+ # happens on pages handling multipart form data, where
+ # ad_page_contract already has called ns_getform and has
+ # retrieved all data from the client. ns_getform has its
+ # own caching, so calling it instead of [ns_conn form]
+ # is OK.
+
+ if { $var == "form" } {
+ return [ns_getform]
+ }
+
+ if { [info exists ad_conn($var)] } {
+ return $ad_conn($var)
+ } else {
+ return [ns_conn $var]
+ }
}
default {