Index: openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl,v
diff -u -r1.153.2.41 -r1.153.2.42
--- openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl	27 Sep 2021 11:28:26 -0000	1.153.2.41
+++ openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl	4 Nov 2021 16:11:27 -0000	1.153.2.42
@@ -878,7 +878,7 @@
     set error_url "[ad_url][ad_conn url]?[export_entire_form_as_url_vars]"
     set error_file [ad_conn file]
     #set package_key [ad_conn package_key]
-    set prev_url [util::get_referrer]
+    set prev_url [util::get_referrer -trusted]
     set feedback_id [db_nextval acs_object_id_seq]
     set user_id [ad_conn user_id]
     set bug_package_id [ad_conn package_id]
Index: openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl,v
diff -u -r1.61.2.19 -r1.61.2.20
--- openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl	30 Sep 2021 16:21:58 -0000	1.61.2.19
+++ openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl	4 Nov 2021 16:11:28 -0000	1.61.2.20
@@ -226,7 +226,7 @@
     {-form {}}
     {-level 1}
     {-context ""}
-    {-warn:boolean}    
+    {-warn:boolean}
     -properties
     docstring
     args
@@ -1206,7 +1206,7 @@
                 ad_log warning "contract in '$::ad_page_contract_context'"\
                     "was violated:\n" [join $complaints "\n "]
             }
-            
+
             if { [info exists return_errors] } {
                 upvar 1 $return_errors error_list
                 set error_list $complaints
@@ -1218,7 +1218,7 @@
                 ad_try {
                     set html [ad_parse_template \
                                   -params [list complaints [list context $::ad_page_contract_context] \
-                                               [list prev_url [util::get_referrer]] \
+                                               [list prev_url [util::get_referrer -trusted]] \
                                               ] [template::themed_template "/packages/acs-tcl/lib/complain"]]
                 } on error {errorMsg} {
                     set errorCode $::errorCode
@@ -2343,7 +2343,7 @@
     ns_return 422 text/html [ad_parse_template \
                                  -params [list [list exception_count $exception_count] \
                                               [list exception_text $exception_text] \
-                                              [list prev_url  [util::get_referrer]] \
+                                              [list prev_url [util::get_referrer -trusted]] \
                                              ]  $complaint_template]
 }
 
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -r1.189.2.103 -r1.189.2.104
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	7 Oct 2021 11:07:50 -0000	1.189.2.103
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	4 Nov 2021 16:11:28 -0000	1.189.2.104
@@ -235,11 +235,20 @@
 
 ad_proc -public util::get_referrer {
     -relative:boolean
+    -trusted:boolean
 } {
     @return referrer from the request headers.
     @param relative return the refer without protocol and host
 } {
     set url [ns_set iget [ns_conn headers] Referer]
+    #
+    # Don't return untrusted header field when -trusted was
+    # specified. An attacker might to sneak in e.g. a JavaScript URL.
+    #
+    if { $trusted_p && [util::external_url_p $url]} {
+        ns_log warning "someone tried to sneak in an untrusted referrer '$url'"
+        set url ""
+    }
     if {$relative_p} {
         # In case the referrer URL has a protocol and host remove it
         regexp {^[a-z]+://[^/]+(/.*)$} $url . url