Index: openacs-4/packages/acs-tcl/tcl/security-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-procs.tcl,v
diff -u -r1.78 -r1.79
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl	30 Jun 2015 21:14:52 -0000	1.78
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl	7 Aug 2017 23:47:59 -0000	1.79
@@ -10,11 +10,15 @@
     @cvs-id $Id$
 }
 
-namespace eval security {}
+namespace eval security {
+    set log(login_url) debug    ;# notice
+    set log(login_cookie) debug ;# notice
+}
 
+
 # cookies (all are signed cookies):
 #   cookie                value                          max-age         secure
-#   ad_session_id         session_id,user_id,login_level SessionTimeout  no
+#   ad_session_id         session_id,user_id,login_level SessionTimeout  yes|no  (when SecureSessionCookie set: yes)
 #   ad_user_login         user_id,issue_time,auth_token  never expires   no
 #   ad_user_login_secure  user_id,random                 never expires   yes
 #   ad_secure_token       session_id,random,peeraddr     SessionLifetime yes
@@ -69,17 +73,30 @@
     db_release_unused_handles
 }
 
+ad_proc -private sec_handler_reset {} {
+
+    Provide dummy values for global variables provided by the
+    sec_handler, in case, the sec_handler is not called or runs into
+    an exception.
+    
+} {
+    set ::__csp_nonce [::security::csp::nonce]
+    set ::__csrf_token ""
+}
+
 ad_proc -private sec_handler {} {
 
     Reads the security cookies, setting fields in ad_conn accordingly.
 
 } {
     ns_log debug "OACS= sec_handler: enter"
 
-    #foreach c [list ad_session_id ad_secure_token ad_user_login ad_user_login_secure] {
-    #    lappend msg "$c [ad_get_cookie $c]"
-    #}
-    #ns_log notice "OACS cookies: $msg"
+    if {$::security::log(login_cookie) ne "debug"} {
+        foreach c [list ad_session_id ad_secure_token ad_user_login ad_user_login_secure] {
+            lappend msg "$c '[ad_get_cookie $c]'"
+        }
+        ns_log notice "OACS [ns_conn url] cookies: $msg"
+    }
 
     if { [catch { 
         set cookie_list [ad_get_signed_cookie "ad_session_id"]
@@ -90,16 +107,22 @@
         # -> it expired.
 
         # Now check for login cookie
-        ns_log Debug "OACS: Not a valid session cookie, looking for login cookie '$errmsg'"
-        ad_user_logout
+        ns_log $::security::log(login_cookie) "OACS: Not a valid session cookie, looking for login cookie '$errmsg'"
+        if {![string match "*does not exist*" $errmsg]} {
+            #
+            # Current firefox does not seem to include cookies in CSP
+            # messages sent via "report-uri"
+            #
+            ad_user_logout
+        }
         sec_login_handler
     } else {
         # The session cookie already exists and is valid.
         set cookie_data [split [lindex $cookie_list 0] {,}]
         set session_last_renew_time [lindex $cookie_data 3]
         if {![string is integer -strict $session_last_renew_time]} {
             # This only happens if the session cookie is old style
-            # previous to openacs 5.7 and does not have session review time
+            # previous to OpenACS 5.7 and does not have session review time
             # embedded.
             # Assume cookie expired and force login handler
             set session_last_renew_time 0
@@ -132,7 +155,7 @@
             }
         }
 
-        ns_log Debug "Security: Insecure session OK: session_id = $session_id, untrusted_user_id = $untrusted_user_id, auth_level = $auth_level, user_id = $user_id"
+        ns_log $::security::log(login_cookie) "Security: Insecure session OK: session_id $session_id, untrusted_user_id $untrusted_user_id, auth_level $auth_level, user_id $user_id"
 
         # We're okay, insofar as the insecure session, check if it's also secure
         if { $auth_level eq "ok" && [security::secure_conn_p] } {
@@ -144,7 +167,7 @@
                     set auth_level secure
                 }
             }
-            ns_log Debug "Security: Secure session checked: session_id = $session_id, untrusted_user_id = $untrusted_user_id, auth_level = $auth_level, user_id = $user_id"
+            ns_log $::security::log(login_cookie) "Security: Secure session checked: session_id = $session_id, untrusted_user_id = $untrusted_user_id, auth_level = $auth_level, user_id = $user_id"
         }
 
         # Setup ad_conn
@@ -168,6 +191,11 @@
             # would cause users' sessions to expire as soon as the session needed to be renewed
             sec_generate_session_id_cookie
         }
+        
+        #
+        # generate a csrf token and a csp nonce value
+        #
+        security::csrf::new
     }
 }
 
@@ -180,17 +208,15 @@
 
     @return List of values read from cookie ad_user_login_secure or ad_user_login
 } {
-    # If over HTTPS, we look for a secure cookie, otherwise we look for the normal one
-    set login_list [list]
+    #
+    # If over HTTPS, we look for the *_secure cookie
+    #
     if { [security::secure_conn_p] } {
-        catch {
-            set login_list [split [ad_get_signed_cookie "ad_user_login_secure"] ","]
-        }
-    } 
-    if { $login_list eq "" } {
-        set login_list [split [ad_get_signed_cookie "ad_user_login"] ","]
+        set cookie_name "ad_user_login_secure"
+    } else {
+        set cookie_name "ad_user_login"
     }
-    return $login_list
+    return [split [ad_get_signed_cookie $cookie_name] ","]
 }
 
 ad_proc -private sec_login_handler {} {
@@ -241,6 +267,7 @@
 
 ad_proc -public ad_user_login {
     {-account_status "ok"}
+    {-cookie_domain ""}
     -forever:boolean
     user_id
 } { 
@@ -260,14 +287,16 @@
 
     set auth_level "ok"
     set secure_p [security::secure_conn_p]
-    set domain [parameter::get -parameter CookieDomain -package_id [ad_acs_kernel_id]]
+    if {$cookie_domain eq ""} {
+        set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id]
+    }
 
     # If you're logged in over a secure connection, you're secure
     if { $secure_p } {
         ad_set_signed_cookie \
             -max_age $max_age \
             -secure t \
-            -domain $domain \
+            -domain $cookie_domain \
             ad_user_login_secure \
             "$user_id,[ns_time],[sec_get_user_auth_token $user_id],[ns_time],$forever_p"
 
@@ -282,13 +311,13 @@
     ns_log Debug "ad_user_login: Setting new ad_user_login cookie with max_age $max_age"
     ad_set_signed_cookie \
         -max_age $max_age \
-        -domain $domain \
+        -domain $cookie_domain \
         -secure f \
         ad_user_login \
         "$user_id,[ns_time],[sec_get_user_auth_token $user_id],$forever_p"
 
     # deal with the current session
-    sec_setup_session $user_id $auth_level $account_status
+    sec_setup_session -cookie_domain $cookie_domain $user_id $auth_level $account_status
 }
 
 ad_proc -public sec_get_user_auth_token {
@@ -326,15 +355,28 @@
 }
 
 
-ad_proc -public ad_user_logout {} { 
+ad_proc -public ad_user_logout {
+    {-cookie_domain ""}
+} { 
     Logs the user out. 
 } {
-    set domain [parameter::get -parameter CookieDomain -package_id [ad_acs_kernel_id]]
-
-    ad_unset_cookie -domain $domain -secure t ad_session_id
-    ad_unset_cookie -domain $domain -secure t ad_secure_token
-    ad_unset_cookie -domain $domain -secure t ad_user_login
-    ad_unset_cookie -domain $domain -secure t ad_user_login_secure
+    if {$cookie_domain eq ""} {
+        set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id]
+    }
+    #
+    # Use the same "secure" setting for unsetting the cookie as it was
+    # used for setting the cookie. The implementation is not 100%
+    # correct, for cases, when the parameter value for
+    # "SecureSessionCookie" was altered during a session, but this
+    # should be a seldom border case.
+    #
+    ad_unset_cookie -domain $cookie_domain -secure [expr {[parameter::get \
+                            -parameter SecureSessionCookie \
+                            -package_id [ad_acs_kernel_id] \
+                            -default 0] ? "t" : "f"}] ad_session_id
+    ad_unset_cookie -domain $cookie_domain -secure f ad_user_login
+    ad_unset_cookie -domain $cookie_domain -secure t ad_secure_token
+    ad_unset_cookie -domain $cookie_domain -secure t ad_user_login_secure
 }
 
 ad_proc -public ad_check_password { 
@@ -378,7 +420,8 @@
     db_release_unused_handles
 }
 
-ad_proc -private sec_setup_session { 
+ad_proc -private sec_setup_session {
+    {-cookie_domain ""}
     new_user_id 
     auth_level
     account_status
@@ -391,7 +434,7 @@
     ns_log debug "OACS= sec_setup_session: enter"
 
     set session_id [ad_conn session_id]
-
+    
     # figure out the session id, if we don't already have it
     if { $session_id eq ""} {
 
@@ -423,16 +466,19 @@
         # changes from user_id 0, since owasp recommends to renew the
         # session_id after any privilege level change
         #
-        #if { $prev_user_id != 0 && $prev_user_id != $new_user_id } 
+        ns_log debug "prev_user_id $prev_user_id new_user_id $new_user_id"
+        
         if { $prev_user_id != 0 && $prev_user_id != $new_user_id } {
             # this is a change in identity so we should create
             # a new session so session-level data is not shared
+            ns_log debug "sec_allocate_session"
             set session_id [sec_allocate_session]
         }
 
         if { $prev_user_id != $new_user_id } {
             # a change of user_id on an active session
             # demands an update of the users table
+            ns_log debug "sec_update_user_session_info"
             sec_update_user_session_info $new_user_id
         }
     }
@@ -453,7 +499,7 @@
 
     ns_log debug "OACS= about to generate session id cookie"
 
-    sec_generate_session_id_cookie
+    sec_generate_session_id_cookie -cookie_domain $cookie_domain
 
     ns_log debug "OACS= done generating session id cookie"
 
@@ -471,20 +517,19 @@
     the user login either via permanent cookies at session creation
     time or when they login by entering their password.
 } {
-    db_dml update_last_visit {
-        update users
-        set second_to_last_visit = last_visit,
-        last_visit = sysdate,
-        n_sessions = n_sessions + 1
-        where user_id = :user_id
-    }
+    db_dml update_last_visit {}
     db_release_unused_handles
 }
 
-ad_proc -private sec_generate_session_id_cookie {} { 
+ad_proc -private sec_generate_session_id_cookie {
+    {-cookie_domain ""}
+} { 
     Sets the ad_session_id cookie based on global variables. 
 } {
     set user_id [ad_conn untrusted_user_id]
+    #
+    # Maybe we need the session_id of the cookie-domain
+    #
     set session_id [ad_conn session_id]
     set auth_level [ad_conn auth_level]
     set account_status [ad_conn account_status]
@@ -500,10 +545,14 @@
 
     ns_log Debug "Security: [ns_time] sec_generate_session_id_cookie setting session_id=$session_id, user_id=$user_id, login_level=$login_level"
 
-    set domain [parameter::get -parameter CookieDomain -package_id [ad_acs_kernel_id]]
+    if {$cookie_domain eq ""} {
+        set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id]
+    }
 
-    # we fetch the last value element of ad_user_login cookie (or ad_user_login_secure) that indicates
-    # if user wanted to be remembered when loggin in
+    # Fetch the last value element of ad_user_login cookie (or
+    # ad_user_login_secure) that indicates if user wanted to be
+    # remembered when loggin in.
+    
     set discard t
     set max_age [sec_session_timeout]
     catch { 
@@ -514,8 +563,14 @@
         }
     }
     ad_set_signed_cookie \
-        -secure f \
-        -discard $discard -replace t -max_age $max_age -domain $domain \
+        -secure [expr {[parameter::get \
+                            -parameter SecureSessionCookie \
+                            -package_id [ad_acs_kernel_id] \
+                            -default 0] ? "t" : "f"}] \
+        -discard $discard \
+        -replace t \
+        -max_age $max_age \
+        -domain $cookie_domain \
         ad_session_id "$session_id,$user_id,$login_level,[ns_time]"
 }
 
@@ -550,12 +605,13 @@
     Returns 1 if the page is used for logging in, 0 otherwise. 
 
 } {
-
     set url [ad_conn url]
-    if { [string match "*register/*" $url] || [string match "/index*" $url] || \
-             [string match "/index*" $url] || \
-             "/" eq $url || \
-             [string match "*password-update*" $url] } {
+    if { [string match "*register/*" $url]
+         || [string match "/index*" $url]
+         || [string match "/index*" $url]
+         || "/" eq $url
+         || [string match "*password-update*" $url]
+     } {
         return 1
     }
 
@@ -573,6 +629,28 @@
 #
 #####
 
+ad_proc -private ad_get_node_id_from_host_node_map {hostname} {
+    Obtain node_id from host_node_map
+    @param hostname
+    @return node_id (or 0, if the provided hostname is not mapped)
+} {
+    #
+    # Get all entries in one sweep, such that the result can be
+    # cached, no matter which hostname is provided as input; the code
+    # assumes that the host-node-map is always short. This allows us
+    # as well to purge the entries without a pattern match.
+    #
+    set lists [db_list_of_lists -cache_key ad_get_host_node_map \
+                  get_node_host_names {select host, node_id from host_node_map}]
+    set p [lsearch -index 0 -exact $lists $hostname]
+    if {$p != -1} {
+        set result [lindex $lists $p 1]
+    } else {
+        set result 0
+    }
+    return $result
+}
+
 ad_proc -public ad_redirect_for_registration {} {
     
     Redirects user to [subsite]/register/index to require the user to
@@ -589,149 +667,176 @@
     ad_returnredirect [ad_get_login_url -return]
 }
 
-ad_proc -public ad_get_login_url {
-    -authority_id
-    -username
-    -return:boolean
-} {
-    
-    Returns a URL to the login page of the closest subsite, or the main site, if there's no current connection.
-    
-    @option return      If set, will export the current form, so when the registration is complete, 
-    the user will be returned to the current location.  All variables in 
-    ns_getform (both posts and gets) will be maintained.
 
-    @author Lars Pind (lars@collaboraid.biz)
-} {
-    if { [ad_conn isconnected] } {
-        set url [subsite::get_element -element url]
+ad_proc -private security::replace_host_in_url {-hostname url} {
 
-        # Check to see that the user (most likely "The Public" party, since there's probably no user logged in)
-        # actually have permission to view that subsite, otherwise we'll get into an infinite redirect loop
-        array set site_node [site_node::get_from_url -url $url]
-        set package_id $site_node(object_id)
-        if { ![permission::permission_p -no_login -object_id $site_node(object_id) -privilege read -party_id 0] } {
-            set url /
-        }
+    Given a fully qualified url, replace the hostname in this URL with
+    the given hostname.
+    
+    @return url with remapped hostname
+} {
+    set ui [ns_parseurl $url]
+    if {[dict exists $ui port]} {
+        set _port [dict get $ui port]
     } else {
-        set url /
+        set _port ""
     }
+    set location [util::join_location \
+                      -proto [dict get $ui proto] \
+                      -hostname $hostname \
+                      -port $_port]
+    set elements ""
+    if {[dict get $ui path] ne ""} {
+        lappend elements [dict get $ui path]
+    }
+    lappend elements [dict get $ui tail]
 
-    set UseHostnameDomainforReg [parameter::get -package_id [apm_package_id_from_key acs-tcl] \
-                                     -parameter UseHostnameDomainforReg -default 0]
-    if { $UseHostnameDomainforReg } {
+    return $location/[join $elements /]
+}
 
-        # get config.tcl's hostname
-        set config_hostname [ns_config [ns_driversection] hostname]
+ad_proc -private security::get_register_subsite {} {
+    
+    Returns a URL pointing to the subsite, on which the
+    register/unregister should be performed. If there is no current
+    connection, the main site url is returned.
 
-        set current_location [util_current_location]
-        # if current domain and hostdomain are different (and UseHostnameDomain), revise url
-        if { ![string match -nocase "*${config_hostname}*" $current_location] } {
+    @author Gustaf Neumann
+} {
+    
+    util::split_location [util_current_location] current_proto current_host current_port
+    set config_hostname [dict get [util_driver_info] hostname] 
+    set UseHostnameDomainforReg [parameter::get \
+                                     -package_id [apm_package_id_from_key acs-tcl] \
+                                     -parameter UseHostnameDomainforReg \
+                                     -default 0]
+    set require_qualified_return_url $UseHostnameDomainforReg
+    set host_node_id [ad_get_node_id_from_host_node_map $current_host]
+    
+    if { $host_node_id > 0 } {
+        #
+        # We are on a host-node mapped subsite
+        #
+        set package_id  [site_node::get_object_id -node_id $host_node_id]
+        set package_key [apm_package_key_from_id $package_id]
+        if {$package_key eq "acs-subsite"} {
+            #
+            # The host-node-map points to a subsite, use this for
+            # login.
+            #
+            set url /
 
-            if { [string range $url 0 0] eq "/" } {
-                # Make the url fully qualified
-                if { [security::secure_conn_p] } {
-                    set url_decoded [security::get_secure_qualified_url $url]
-                } else {
-                    set url_decoded [security::get_insecure_qualified_url $url]
-                }
-            } else {
-                set url_decoded $url
+            if {$UseHostnameDomainforReg} {
+                set url [subsite::get_element -subsite_id $package_id -element url]
+                set url [security::get_qualified_url $url]
+                # We have a fully qualified url, but we have to remap
+                # the URL to the configured host name, since
+                # get_qualified prepends the [ad_conn location], which
+                # points to the virtual host name.
+                set url [security::replace_host_in_url -hostname $config_hostname $url]
             }
-
-            # revise url to use hostname's domain
-            # if url points to a non / host_node, redirect to main hostname
-            set host_node_map_hosts_list [db_list -cache_key security-locations-host-names \
-                                              get_node_host_names "select host from host_node_map"]
-            if { [llength $host_node_map_hosts_list] > 0 } {
-                foreach hostname $host_node_map_hosts_list {
-                    if { [string match -nocase "http://${hostname}*" $url_decoded] 
-                         || [string match -nocase "https://${hostname}*" $url_decoded] } {
-                        db_1row get_node_id_from_host_name {
-                            select node_id as host_node_id 
-                            from host_node_map 
-                            where host = :hostname
-                        }
-                        # site node already in url, so just switching domain.
-                        if { ![regsub -- "${hostname}" $url_decoded "${config_hostname}" url_decoded] } {
-                            ns_log Warning "ad_get_login_url(ref619): regsub was unable to modify url to hostname's domain. User may not appear to be logged-in after login. url_decoded: ${url_decoded} url: ${url}"
-                        } 
-                    }
-                }
+        } else {
+            #
+            # The host-node-map points to an application package and
+            # not to a subsite. We have to provide logins via next
+            # available subsite.
+            #
+            set subsite_id [site_node::closest_ancestor_package \
+                                     -node_id $host_node_id \
+                                     -package_key acs-subsite \
+                                     -include_self \
+                                     -element "object_id"]
+            set url [subsite::get_element -subsite_id $subsite_id -element url]
+            set url [security::get_qualified_url $url]
+            set url [security::replace_host_in_url -hostname $config_hostname $url]
+            set require_qualified_return_url 1
+        }
+    } else {
+        #
+        # We are on normal subsite
+        #
+        if { [ad_conn isconnected] } {
+            set url [subsite::get_element -element url]
+            #
+            # Check to see that the user (most likely "The Public"
+            # party, since there's probably no user logged in)
+            # actually have permission to view that subsite, otherwise
+            # we'll get into an infinite redirect loop.
+            #
+            array set site_node [site_node::get_from_url -url $url]
+            set package_id $site_node(object_id)
+            if { ![permission::permission_p -no_login \
+                       -object_id $site_node(object_id) \
+                       -privilege read \
+                       -party_id 0] } {
+                set url /
             }
-            set url $url_decoded
+        } else {
+            #
+            # If we are not connected, there can't be a virtual
+            # server, so we assume to perform the login on the main
+            # subsite.
+            #
+            set url /
         }
+        if {$UseHostnameDomainforReg} {
+            set url [security::get_qualified_url $url]
+            set url [security::replace_host_in_url -hostname $config_hostname $url]
+        }
     }
+    return [list \
+                url $url \
+                require_qualified_return_url $require_qualified_return_url \
+                host_node_id $host_node_id]
+}
 
 
-    append url "register/"
+ad_proc -public ad_get_login_url {
+    {-authority_id ""}
+    {-username ""}
+    -return:boolean
+} {
+    
+    Returns a URL to the login page of the closest subsite, or the main site, if there's no current connection.
+    
+    @option return      If set, will export the current form, so when the registration is complete, 
+    the user will be returned to the current location.  All variables in 
+    ns_getform (both posts and gets) will be maintained.
 
-    set export_vars [list]
-    if { [info exists authority_id] && $authority_id ne "" } {
-        lappend export_vars authority_id
-        
+    @author Lars Pind (lars@collaboraid.biz)
+    @author Gustaf Neumann
+
+} {
+
+    set subsite_info [security::get_register_subsite]
+    foreach var {url require_qualified_return_url host_node_id} {
+        set $var [dict get $subsite_info $var]
     }
-    if { ([info exists username] && $username ne "") } {
-        lappend export_vars username
-        
-    }
+    
+    append url "register/"
 
-    # We don't add a return_url if you're currently under /register, because that will frequently
-    # interfere with normal login procedure
+    #
+    # Don't add a return_url if you're already under /register,
+    # because that will frequently interfere with the normal login
+    # procedure.
+    #
     if { [ad_conn isconnected] && $return_p && ![string match "register/*" [ad_conn extra_url]] } {
-        if { [security::secure_conn_p] || ![security::RestrictLoginToSSLP] } {
+        #
+        # In a few cases, we do not need to add a fully qualified
+        # return url. The secure cases have to be still tested.
+        #
+        if { !$require_qualified_return_url && ([security::secure_conn_p] || ![security::RestrictLoginToSSLP]) } {
             set return_url [ad_return_url]
         } else {
             set return_url [ad_return_url -qualified]
         }
-
-        if { $UseHostnameDomainforReg } {
-            # if current domain and hostdomain are different (and UseHostnameDomainforReg), revise return_url
-            if { ![string match -nocase "*${config_hostname}*" $current_location] } {
-                
-                if { [string range $return_url 0 0] eq "/" } {
-                    # Make the return_url fully qualified
-                    if { [security::secure_conn_p] } {
-                        set return_url_decoded [security::get_secure_qualified_url $return_url]
-                    } else {
-                        set return_url_decoded [security::get_insecure_qualified_url $return_url]
-                    }
-                } else {
-                    set return_url_decoded $return_url
-                }
-                # revise return_url to use hostname's domain
-                # if return_url points to a non / host_node, redirect to main hostname
-                set host_node_map_hosts_list [db_list -cache_key security-locations-host-names \
-                                                  get_node_host_names "select host from host_node_map"]
-                if { [llength $host_node_map_hosts_list] > 0 } {
-                    foreach hostname $host_node_map_hosts_list {
-                        if { [string match -nocase "http://${hostname}*" $return_url_decoded] \
-                                 || [string match -nocase "https://${hostname}*" $return_url_decoded] } {
-                            db_1row get_node_id_from_host_name {
-                                select node_id as host_node_id 
-                                from host_node_map 
-                                where host = :hostname
-                            }
-                            if { ![regsub -- ${hostname} $return_url_decoded \
-                                       "${config_hostname}[site_node::get_url -node_id ${host_node_id} -notrailing]" \
-                                       return_url_decoded] } {
-                                ns_log Warning "ad_get_login_url(ref672): regsub was unable to modify return_url to hostname's domain. User may not appear to be logged-in after login. return_url_decoded: ${return_url_decoded} return_url: ${return_url}"
-                            } 
-                        }
-                    }
-                }
-                set return_url $return_url_decoded
-            }
-        }
-
-
-        lappend export_vars { return_url }
     }
-
-    if { [llength $export_vars] > 0 } {
-        set url [export_vars -base $url $export_vars]
+    if {$host_node_id == 0} {
+        unset host_node_id
     }
+    set url [export_vars -base $url -no_empty {authority_id username return_url host_node_id}]
 
+    ns_log $::security::log(login_url) "ad_get_login_url: final login_url <$url>"
+
     return $url
 }
 
@@ -748,12 +853,10 @@
 
     @author Lars Pind (lars@collaboraid.biz)
 } {
-    if { [ad_conn isconnected] } {
-        set url [subsite::get_element -element url]
-    } else {
-        set url /
-    }
 
+    set subsite_info [security::get_register_subsite]
+    set url [dict get $subsite_info url]
+    
     append url "register/logout"
 
     if { $return_p && $return_url eq "" } {
@@ -833,12 +936,12 @@
 
     @param value the value to be signed.
 } {
+    if {$token_id eq ""} { 
+        # pick a random token_id
+        set token_id [sec_get_random_cached_token_id]
+    }
 
     if { $secret eq "" } {
-        if {$token_id eq ""} { 
-            # pick a random token_id
-            set token_id [sec_get_random_cached_token_id]
-        }
         set secret_token [sec_get_token $token_id]
     } else {
         set secret_token $secret
@@ -854,7 +957,6 @@
     }
 
     set hash [ns_sha1 "$value$token_id$expire_time$secret_token"]
-
     set signature [list $token_id $expire_time $hash]
 
     return $signature
@@ -977,21 +1079,20 @@
 
 } {
 
-    set cookie_value [ns_urldecode [ad_get_cookie -include_set_cookies $include_set_cookies $name]]
-
+    set cookie_value [ad_get_cookie -include_set_cookies $include_set_cookies $name]
     if { $cookie_value eq "" } {
         error "Cookie does not exist."
     }
 
     lassign $cookie_value value signature
-    ns_log Debug "ad_get_signed_cookie: Got signed cookie $name with value $value, signature $signature."
+    ns_log $::security::log(login_cookie) "ad_get_signed_cookie: Got signed cookie $name with value $value, signature $signature."
 
-    if { [ad_verify_signature $value $signature] } {
-        ns_log Debug "ad_get_signed_cookie: Verification of cookie $name OK"
+    if { [ad_verify_signature -secret $secret $value $signature] } {
+        ns_log $::security::log(login_cookie) "ad_get_signed_cookie: Verification of cookie $name OK"
         return $value
     }
 
-    ns_log Debug "ad_get_signed_cookie: Verification of cookie $name FAILED"
+    ns_log $::security::log(login_cookie) "ad_get_signed_cookie: Verification of cookie $name FAILED"
     error "Cookie could not be authenticated."
 }
 
@@ -1009,14 +1110,14 @@
 
 } {
 
-    set cookie_value [ns_urldecode [ad_get_cookie -include_set_cookies $include_set_cookies $name]]
+    set cookie_value [ad_get_cookie -include_set_cookies $include_set_cookies $name]
 
     if { $cookie_value eq "" } {
         error "Cookie does not exist."
     }
 
     lassign $cookie_value value signature
-    set expr_time [ad_verify_signature_with_expr $value $signature]
+    set expr_time [ad_verify_signature_with_expr -secret $secret $value $signature]
 
     ns_log Debug "Security: Done calling get_cookie $cookie_value for $name; received $expr_time expiration, getting $value and $signature."
 
@@ -1082,7 +1183,7 @@
     }
 
     set cookie_value [ad_sign -secret $secret -token_id $token_id -max_age $signature_max_age $value]
-    set data [ns_urlencode [list $value $cookie_value]]
+    set data [list $value $cookie_value]
 
     ad_set_cookie \
         -replace $replace \
@@ -1194,13 +1295,7 @@
     # this is called directly from security-init.tcl,
     # so it runs during the install before the data model has been loaded
     if { [db_table_exists secret_tokens] } {
-        db_foreach get_secret_tokens {
-            select * from (
-                           select token_id, token
-                           from secret_tokens
-                           sample(15)
-                           ) where rownum < :num_tokens
-        } {
+        db_foreach get_secret_tokens {} {
             ns_cache set secret_tokens $token_id $token
         }
     }
@@ -1248,9 +1343,10 @@
 } { 
 
     Used as a helper procedure for util_memoize to look up a
-    particular property from the database. Returns
-    [list $property_value $secure_p].
+    particular property from the database.
 
+    @return empty, when no property is recorded or a list containing property_value and secure_p
+
 } {
     if {
         ![db_0or1row property_lookup_sec {
@@ -1283,15 +1379,20 @@
     {-session_id ""}
     module
     name
-} { 
-    Looks up a property for a session. If $cache is true, will use the
-    cached value if available. If $cache_only is true, will never
+} {
+    Looks up a property for a session. If -cache is true, will use the
+    cached value if available. If -cache_only is true, will never
     incur a database hit (i.e., will only return a value if
-                          cached). If the property is secure, we must be on a validated session
-    over SSL.
+    cached). If the property is secure, we must be on a validated session
+    over HTTPS.
 
     @param session_id controls which session is used
-
+    @param module typically the name of the package to which the property
+           belongs (serves as a namespace)
+    @param name name of the property
+    @return value of the property or default
+    
+    @see ad_set_client_property
 } {
     if { $session_id eq "" } {
         set id [ad_conn session_id]
@@ -1308,7 +1409,7 @@
     set cmd [list sec_lookup_property $id $module $name]
 
     if { $cache_only == "t" && ![util_memoize_cached_p $cmd] } {
-        return ""
+        return $default
     }
 
     if { $cache != "t" } {
@@ -1322,7 +1423,7 @@
     lassign $property value secure_p
     
     if { $secure_p != "f" && ![security::secure_conn_p] } {
-        return ""
+        return $default
     }
 
     return $value
@@ -1337,17 +1438,20 @@
     name
     value
 } { 
-    Sets a client (session-level) property. If $persistent is true,
-    the new value will be written through to the database. If
-    $deferred is true, the database write will be delayed until
-    connection close (although calls to ad_get_client_property will
-                      still return the correct value immediately). If $secure is true,
+    Sets a client (session-level) property. If -persistent is true,
+    the new value will be written through to the database (it will
+    survive a server restart, bit it will be slower). If -secure is true,
     the property will not be retrievable except via a validated,
     secure (HTTPS) connection.
 
     @param session_id controls which session is used
     @param clob tells us to use a large object to store the value
+    @param module typically the name of the package to which the property
+           belongs (serves as a namespace)
+    @param name name of the property
+    @param value value if the property
 
+    @see ad_get_client_property
 } {
 
     if { $secure != "f" && ![security::secure_conn_p] } {
@@ -1450,31 +1554,29 @@
 
     @author Peter Marklund
 } {
-    if { ![https_available_p] } {
-        return
-    } 
-
-    if { ![security::secure_conn_p] } {
-        security::redirect_to_secure [ad_return_url -qualified]
+    if { [https_available_p] } {
+        if { ![security::secure_conn_p] } {
+            security::redirect_to_secure [ad_return_url -qualified]
+        }
     }
 }
 
 ad_proc -public security::redirect_to_secure {
+    {-script_abort:boolean true}
     url 
 } {
     Redirect to the given URL and enter secure (HTTPS) mode.    
     Does nothing if the server is not configured for HTTPS support.
 
     @author Peter Marklund
 } {
-    if { ![https_available_p] } {
-        return
-    } 
-
-    set secure_url [get_secure_qualified_url $url]
-
-    ad_returnredirect $secure_url
-    ad_script_abort
+    if { [https_available_p] } {
+        set secure_url [get_secure_qualified_url $url]
+        ns_set put [ad_conn outputheaders] Vary "Upgrade-Insecure-Requests"
+        #ns_log notice "redirect $url to secure url $secure_url"
+        ad_returnredirect $secure_url
+        if {$script_abort_p} {ad_script_abort}
+    }
 }
 
 ad_proc -public security::redirect_to_insecure {
@@ -1503,40 +1605,36 @@
 
     @author Gustaf Neumann
 } {
-
-    # get available server modules
+    # get secure driver server modules
     set sdriver [security::driver]
 
-    if {$sdriver eq ""} {
-        return ""
+    if {$sdriver ne ""} {
+        set d [util_driver_info -driver $sdriver]
+        return [dict get $d port]
     }
+}
 
-    set secure_port [ns_config -int [ns_driversection -driver $sdriver] port]
-    if {$secure_port eq "" && $driver eq "nsopenssl"} {
-        # checking nsopenssl 2.0 which has different names for the secure port etc, 
-        # and is not supported with this version of OpenACS
-        set secure_port [ns_config -int [ns_driversection -driver nsopenssl] ServerPort]
-        if {$secure_port eq ""} {
-            # nsopenssl 3 has variable locations for the secure
-            # port, openacs standardized at:
-            set secure_port [ns_config -int "ns/server/[ns_info server]/module/nsopenssl/ssldriver/users" port]
-        }
+ad_proc -private security::get_qualified_url { url } {
+    @return secure or insecure qualified url
+} {
+    if { [security::secure_conn_p] || [ad_conn behind_secure_proxy_p] } {
+        set qualified_url [security::get_secure_qualified_url $url]
+    } else {
+        set qualified_url [security::get_insecure_qualified_url $url]
     }
-    
-    return $secure_port
+    return $qualified_url
 }
 
+
 ad_proc -private security::get_secure_qualified_url { url } {
     Given a relative or qualified url, return the fully qualified
     HTTPS version.
 
     @author Peter Marklund
 } {
-    # Get part of URL after location
-    set qualified_uri [get_qualified_uri $url]
-
+    set qualified_uri [get_qualified_uri_part $url]
     set secure_url [get_secure_location]${qualified_uri}
-
+    
     return $secure_url
 }
 
@@ -1547,7 +1645,7 @@
     @author Peter Marklund
 } {
     # Get part of URL after location
-    set qualified_uri [get_qualified_uri $url]
+    set qualified_uri [get_qualified_uri_part $url]
 
     set insecure_url [get_insecure_location]${qualified_uri}
 
@@ -1556,22 +1654,22 @@
 
 ad_proc -private security::get_uri_part { url } {
     Get the URI following the location of the given URL. Assumes
-    the given URL has the http or https protocol or is a relative
+    the given URL has the "http" or "https" protocol or is a relative
     URL.
 
     @author Peter Marklund
 } {
-    regexp {^(?:http://[^/]+)?(.*)} $url match uri
+    regexp {^(?:http[s]?://[^/]+)?(.*)} $url match uri
 
     return $uri
 }
 
-ad_proc -private security::get_qualified_uri { url } {
+ad_proc -private security::get_qualified_uri_part { url } {
     
 } {
     set uri [get_uri_part $url]
 
-    if { [string range $uri 0 0] ne "/" } {
+    if { [string index $uri 0] ne "/" } {
         # Make relative URI qualified
         return [ad_conn url]/$uri
     }
@@ -1585,26 +1683,19 @@
     @author Peter Marklund
 } {
     set current_location [util_current_location]
-    set https_prefix {https://}
-
-    if { [regexp $https_prefix $current_location] } {
+    
+    if { [regexp {^https://} $current_location] } {
+        #
         # Current location is already secure - do nothing
+        #
         set secure_location $current_location
+    } elseif {[util::split_location $current_location proto hostname port]} {
+        set secure_location [util::join_location \
+                                 -proto https \
+                                 -hostname $hostname \
+                                 -port [security::get_https_port]]
     } else {
-        # Current location is insecure - get location from config file
-        set secure_location [ad_conn location]
-        # Prefix with https
-        regsub {^(?:http://)?} $secure_location {https://} secure_location
-
-        # remove port number if using nonstandard port
-        regexp {^(.*:.*):([0-9]+)} $secure_location match secure_location port
-
-        # Add port number if non-standard
-        set https_port [get_https_port]
-        if { $https_port ne "443" } {
-            set secure_location ${secure_location}:$https_port
-        }
-
+        error "invalid location $current_location"
     }
 
     return $secure_location
@@ -1636,8 +1727,11 @@
 
 if {[ns_info name] ne "NaviServer"} {
     #
-    # compatibility with NaviServer, which allows global and per-server
-    # defined drivers.
+    # Compatibility function for AOLserver, which allows abstracts
+    # from the configuration section in the config files. NaviServer
+    # supports in general global and per-server defined drivers. The
+    # emulated version just supports per-server configurations, since
+    # these are the only ones supported by AOLserver.
     #
     ad_proc -public ns_driversection {
         {-driver "nssock"}
@@ -1683,127 +1777,743 @@
     }
     set ::acs::sdriver ""
     set server_modules [ad_server_modules]
-    foreach driver {nsssl nsopenssl nsssle} {
+    foreach driver {nsssl nsssl_v4 nsssl_v6 nsopenssl nsssle} {
         if {$driver ni $server_modules} continue
         set ::acs::sdriver $driver
         break
     }
     return $::acs::sdriver
 }
 
+if {[info commands ns_driver] ne ""} {
+    
+    ad_proc -private security::configured_driver_info {} {
+        
+        Return a list of dicts containing type, driver, location and port
+        of all configured drivers
 
-ad_proc -public security::locations {} {
-    @return insecure location and secure location followed possibly by alternate insecure location(s) as a list.
+        @see util_driver_info
+        
+    } {
+        set defaultport {http 80 https 433}
+        set result {}
+        foreach i [ns_driver info] {
+            set type     [dict get $i type]
+            set location [dict get $i location]
+            set proto    [dict get $i protocol]
+            set li       [ns_parseurl $location]
+            
+            if {[dict exists $li port]} {
+                set port [dict get $li port]
+                set suffix ":$port"
+            } else {
+                set port [dict get $defaultport $proto]
+                set suffix ""
+            }
+            lappend result [list \
+                                proto $proto \
+                                driver [dict get $i module] \
+                                host [dict get $li host] \
+                                location $location port $port suffix $suffix]
+        }
+        return $result
+    }
+    
+} else {
+    
+    ad_proc -private security::configured_driver_info {} {
+        set result ""
+        #
+        # Find the first insecure driver based on driver names from
+        # recommended config files
+        # 
+        foreach driver {nssock nssock_v4 nssock_v6} {
+            set driver_section [ns_driversection -driver $driver]
+            if {$driver_section ne ""} {
 
-    The location consists of protocol://domain:port for website. This proc is ported 
-    from ec_insecure_location and ec_secure_location for reliably getting locations.  
-    If acs-tcl's SuppressHttpPort parameter is true, then the alternate ec_insecure_location 
-    without port is appended to the list, since it is a valid alternate.  
-    This proc also assumes hostnames from host_node_map table are accurate and legit.
-} {
-    set locations [list]
-    # following from ec_preferred_drivers
-    set driver "nssock"
-    set sdriver [security::driver]
+                set location [ns_config $driver_section location]
+                if {$location ne "" && [util::split_location $location proto host port]} {
+                    lappend result [list proto http driver $driver host $host \
+                                        location $location port $port suffix $suffix]
+                }
 
-    # set the driver results
-    array set drivers [list driver $driver sdriver $sdriver]
-    set driver $drivers(driver)
+                set host [ns_config $driver_section hostname]
+                if {$host eq ""} {
+                    set host [ns_config $driver_section address]
+                    if {[string match "*:*" $host]} {
+                        set host "\[$host\]"
+                    }
+                }
+                set location "http://$host"
+                
+                set port [ns_config -int $driver_section port 80]
+                if { $port ne "" && $port != 80 } {
+                    set suffix ":$port"
+                    append location $suffix
+                } else {
+                    set port 80
+                    set suffix ""
+                }
+                lappend result [list proto http driver $driver host $host \
+                                    location $location port $port suffix $suffix]                
+            }
+        }
 
-    # check if port number is included here, we'll reattach it after
-    # the request if its a non-standard port. Since we build the
-    # secure url from this host name we need to replace the port with
-    # the secure port
-    set host_post ""
+        #
+        # Obtain information about secure locations.
+        #
+        set sdriver [security::driver]
 
-    # set host_name
-    if {![regexp {(http://|https://)(.*?):(.*?)/?} [util_current_location] discard host_protocol host_name host_port]} {
-        regexp {(http://|https://)(.*?)/?} [util_current_location] discard host_protocol host_name
+        # nsopenssl 3 has variable locations for the secure
+        # port, OpenACS standardized at:
+        
+        if { $sdriver eq "nsopenssl" } {
+            set port [ns_config -int "ns/server/[ns_info server]/module/$sdriver/ssldriver/users" port 443]
+            set host [ns_config "ns/server/[ns_info server]/module/$sdriver/ssldriver/users" hostname]
+            
+        } elseif { $sdriver ne "" } {
+            # get secure port for all other cases of nsssl, nsssle etc
+            set driver_section [ns_driversection -driver $sdriver]
+            set host [ns_config $driver_section hostname]
+            if {$host eq ""} {
+                set host [ns_config $driver_section address]
+                if {[string match "*:*" $host]} {
+                    set host "\[$host\]"
+                }
+            }
+            set port [ns_config -int $driver_section port]
+            
+            # checking nsopenssl 2.0 which has different names for 
+            # the secure port etc, and deprecated with this version of OpenACS
+            if {$port eq ""} {
+                set port [ns_config -int $driver_section ServerPort 443]
+                if {$port ne ""} {
+                    ns_log Warning "Using 'ServerPort' in config file in $driver_section is deprecated (use 'port' instead)"
+                }
+            }
+        } else {
+            set port ""
+        }
+        
+        if {$sdriver ne ""} {
+            set location "https://$host"
+            if {$port eq "" || $port eq "443" } {
+                set suffix ""
+            } else {
+                set suffix ":$port"
+                append location $suffix
+            }
+ 
+            lappend result [list proto https driver $sdriver host $host \
+                                location $location port $port suffix $suffix]                
+        }
+        return $result
     }
+}
 
-    set driver_section [ns_driversection -driver $driver]
+ad_proc -public security::locations {} {
+
+    This function returns the configured locations and the current
+    location and the vhost locations, potentially in HTTP or in HTTPs
+    variants.
+
+    When the package parameter "SuppressHttpPort" of acs-tcl parameter
+    is true, then an alternate location without a port is included.
+    This proc also assumes hostnames from host_node_map table are
+    accurate and legit.
     
-    # Let's give a warning if util_current_location returns host_name
-    # not same as from config.tcl, may help with proxy issues etc
-    set config_hostname [ns_config $driver_section hostname]
-    if { $config_hostname ne $host_name } {
-        ns_log Warning "security::locations hostname '[ns_config $driver_section hostname]' from config.tcl does not match from util_current_location: $host_name"
-    }
+    The term location refers to protocol://domain:port for
+    website.
 
-    # insecure locations
-    set insecure_port [ns_config -int $driver_section port 80]
+    @return insecure location and secure location followed possibly by alternate location(s) as a list.
 
-    set insecure_location "http://${host_name}"
-    set host_map_http_port ""
-    if { $insecure_port ne "" && $insecure_port != 80 } {
-        set alt_insecure_location $insecure_location
-        append insecure_location ":$insecure_port"
-        set host_map_http_port ":$insecure_port"
+} {
+    set locations [list]
+    set portless_locations {}
+    #
+    # Get Information from configured servers
+    #
+    set driver_info [security::configured_driver_info]
+    foreach d $driver_info {
+        #
+        # port == 0 means that the driver is just used for sending, but not for receiveing
+        #
+        if {[dict get $d port] != 0} {
+            set location [dict get $d location]
+            if {$location ni $locations} {lappend locations $location}
+            
+            set location [dict get $d proto]://[dict get $d host]
+            if {$location ni $portless_locations &&
+                $location ni $locations} {
+                lappend portless_locations $location
+            }
+            append location :[dict get $d port]
+            if {$location ni $locations} {lappend locations $location}
+        }
     }
 
-    # secure location, favoring nsopenssl
-    # nsopenssl 3 has variable locations for the secure port, openacs standardized at:
-    if { $sdriver eq "nsopenssl" } {
-        set secure_port [ns_config -int "ns/server/[ns_info server]/module/$sdriver/ssldriver/users" port 443]
-    } elseif { $sdriver ne "" } {
-        # get secure port for all other cases of nsssl, nsssle etc
-        set driver_section [ns_driversection -driver $sdriver]
-        set secure_port [ns_config -int $driver_section port]
+    if {[ns_conn isconnected]} {
+        #
+        # Is the current connection secure?
+        #
+        set secure_conn_p [security::secure_conn_p]
         
-        # checking nsopenssl 2.0 which has different names for 
-        # the secure port etc, and deprecated with this version of OpenACS
-        if {$secure_port eq "" || $secure_port eq "443" } {
-            ns_log Notice "Using 'ServerPort' in $driver_section is deprecated"
-            set secure_port [ns_config -int $driver_section ServerPort 443]
+        set current_location [util_current_location]
+        if {$current_location ni $locations} {
+            lappend locations $current_location
         }
+        
+        #
+        # When we are on a secure connection, the command above added
+        # already a secure connection. When we are on a nonsecure
+        # connection, but HTTPS is available, allow as well the
+        # current host via the secure connection.
+        #
+        if {!$secure_conn_p && [https_available_p]} {
+            set secure_current_location [security::get_secure_location]
+            #ns_log notice "ADD secure_current_location: <$secure_current_location>"
+            if {$secure_current_location ni $locations} {
+                lappend locations $secure_current_location
+            }
+        }
     } else {
-        set secure_port ""
+        set secure_conn_p 0
     }
-
-    lappend locations $insecure_location
-    # if we have a secure location, add it
-    set host_map_https_port ""
-
-    if { $sdriver ne "" } {
-        set secure_location "https://${host_name}"
-        if {$secure_port ne "" && $secure_port ne "443"}  {
-            append secure_location ":$secure_port"
-            set host_map_https_port ":$secure_port"
-        }
-        lappend locations $secure_location
-    }
-    # consider if we are behind a proxy and don't want to publish the proxy's backend port
+    
+    #
+    # Consider if we are behind a proxy and don't want to publish the
+    # proxy's backend port. In this cases, SuppressHttpPort can be used
+    #
     set suppress_http_port [parameter::get -parameter SuppressHttpPort \
                                 -package_id [apm_package_id_from_key acs-tcl] \
                                 -default 0]
-    if { [info exists alt_insecure_location] && $suppress_http_port } {
-        lappend locations $alt_insecure_location
+    if {$suppress_http_port} {
+        lappend locations {*}$portless_locations
     }
 
-    # add locations from host_node_map 
+   
+    #
+    # Add locations from host_node_map
+    #
     set host_node_map_hosts_list [db_list -cache_key security-locations-host-names \
-                                      get_node_host_names "select host from host_node_map"]
-    # fastest place for handling this special case:
-    if { $config_hostname ne $host_name } {
-        ns_log Notice "security::locations adding $config_hostname since utl_current_location different than config.tcl."
-        lappend host_node_map_hosts_list $config_hostname
-    }
+                                      get_node_host_names {select host from host_node_map}]
+ 
     if { [llength $host_node_map_hosts_list] > 0 } {
         if { $suppress_http_port } {
             foreach hostname $host_node_map_hosts_list {
                 lappend locations "http://${hostname}"
-                lappend locations "https://${hostname}${host_map_https_port}"
+                if {$secure_conn_p} {
+                    lappend locations "https://${hostname}"
+                }
             }
         } else {
             foreach hostname $host_node_map_hosts_list {
-                lappend locations "http://${hostname}${host_map_http_port}"
-                lappend locations "https://${hostname}${host_map_https_port}"
+                foreach d $driver_info {
+                    if {[dict get $d proto] eq "http"} {
+                        lappend locations "http://${hostname}[dict get $d suffix]"
+                    }
+                }
+                if {$secure_conn_p} {
+                    foreach d $driver_info {
+                        if {[dict get $d proto] eq "https"} {
+                            lappend locations "https://${hostname}[dict get $d suffix]"
+                        }
+                    }
+                }
             }
         }
     }
+    #ns_log notice "security::locations <$locations>"
     return $locations
 }
 
+
+ad_proc -public security::validated_host_header {} {
+    @return validated host header field or empty
+    @author Gustaf Neumann
+
+    Protect against faked or invalid host header fields. Host header
+    attacks can lead to web-cache poisoning and password reset attacks
+    (for more details, see e.g.
+     http://www.skeletonscribe.net/2013/05/practical-http-host-header-attacks.html)
+} {
+    #
+    # Check, if we have a host header field
+    #
+    set host [ns_set iget [ns_conn headers] Host]
+    if {$host eq ""} {
+        return ""
+    }
+    
+    #
+    # Check, if we have validated it before, or it belongs to the
+    # predefined accepted host header fields.
+    #
+    set key ::acs::validated($host)
+    if {[info exists $key]} {
+        return $host
+    }
+
+    if {![string match *//* $host]} {
+        set splithost [ns_conn protocol]://$host
+    } else {
+        set splithost $host
+    }
+    if {![util::split_location $splithost .proto hostName hostPort]} {
+        return ""
+    }
+
+    #
+    # Remove trailing dot, as this is allowed in fully qualified DNS
+    # names (see e.g. §3.2.2 of RFC 3976).
+    #
+    set hostName [string trimright $hostName .]
+    
+    #
+    # Check, if the provided host is the same as the configued host
+    # name for the current driver or one of its IP addresses. Should
+    # be true in most cases.
+    #
+    set driverInfo [util_driver_info]
+    set driverHostName [dict get $driverInfo hostname]
+    if {$hostName eq $driverHostName || $hostName in [ns_addrbyhost -all $driverHostName]} {
+        #
+        # port is currently ignored
+        #
+        set $key 1
+        return $host
+    }
+
+    #
+    # Check, if the provided host is the same in [ns_conn location]
+    # (will be used as default, but we do not want a warning in such
+    # cases).
+    #
+    if {[util::split_location [ns_conn location] proto locationHost locationPort]} {
+        if {$hostName eq $locationHost} {
+            #
+            # port is currently ignored
+            #
+            set $key 1
+            return $host            
+        }
+    }
+
+    #
+    # Check, if the provided host is the same as in the configured
+    # SystemURL.
+    #
+    if {[util::split_location [ad_url] .proto systemHost systemPort]} {
+        if {$hostName eq $systemHost
+            && ($hostPort eq $systemPort || $hostPort eq "") } {
+            set $key 1
+            return $host
+        }
+    }
+
+    #
+    # Check against the virtual server configuration of NaviServer. xxxx
+    #
+    if {[ns_info name] eq "NaviServer"} {
+        set s [ns_info server]
+        set driverInfo [security::configured_driver_info]
+        set drivers [lmap d $driverInfo {dict get $d driver}]
+        
+        foreach driver $drivers {
+            #
+            # Check global "servers" configuration for virtual servers for the driver
+            #
+            set ns [ns_configsection ns/module/$driver/servers]
+            if {$ns ne ""} {
+                #
+                # We have a global "servers" configuration for the driver
+                #
+                set names [lmap {key value} [ns_set array $ns] {
+                    if {$key ne $s} continue
+                    set value
+                }]
+                if {$host in $names} {
+                    ns_log notice "security::validated_host_header: found $host via global virtual server configuration for $driver"
+                    set $key 1
+                    return $host
+                }
+            }
+        }
+    }
+
+    #
+    # Check against host node map. Here we need as well protection
+    # against invalid utf-8 characters.
+    #
+    if {![regexp {^[\w.:@+/=$%!*~\[\]-]+$} $host]} {
+        ns_log Warning "host header field contains invalid characters: $host"
+        return ""
+    }
+    set result [db_list host_header_field_mapped {select 1 from host_node_map where host = :hostName}]
+    ns_log notice "checking entry <$hostName> from host_node_map -> $result"
+    if {$result == 1} {
+        #
+        # port is ignored
+        #
+        set $key 1
+        return $host
+    }
+
+    #
+    # Handle aliases for locations, which cannot be determined from
+    # config files, but which are supposed to be ok.
+    #
+    if {$hostName eq "localhost"} {
+        #
+        # This is not an attempt, where someone tries to lure us to a
+        # different host via redirect.
+        #
+        set $key 1
+        return $host
+    }
+    
+    #
+    # We could/should check as well against a white-list of additional
+    # host names (maybe via ::acs::validated, or via config file, or
+    # via additional package parameter). Probably the best way is to
+    # get alternate (alias) names from the driver section of the
+    # current driver [ns_conn driver] (maybe check global and local).
+    #
+    #ns_set array [ns_configsection ns/module/nssock/servers]
+
+    #
+    # Now we give up
+    #
+    ns_log warning "ignore untrusted host header field: '$host'"
+
+    return ""
+}
+
+namespace eval ::security::csp {
+
+    #
+    # Generate a nonce token as described in W3C Content Security Policy
+    # https://www.w3.org/TR/CSP/
+    #
+    ad_proc -public ::security::csp::nonce { {-tokenname __csp_nonce} } {
+    
+        Generate a Nonce token and return it. The nonce token can be used
+        in content security policies (CSP2) for "script" and "style"
+        elements. Desired Properties: generate a single unique value per
+        request which is hard for a hacker to predict, it should only
+        contain base64 characters (so hex is fine).
+        
+        For details, see https://www.w3.org/TR/CSP/
+        
+        @return nonce token
+        @author Gustaf Neumann
+    } {
+        #
+        # Compute the nonce value only once per requests. If it was
+        # already computed, pick it up and return the precomputed
+        # value. Otherwise, compute the value new.
+        #
+        set globalTokenName ::$tokenname
+        if {[info exists $globalTokenName]} {
+            set token [set $globalTokenName]
+        } else {
+            if {![ns_conn isconnected]} {
+                #
+                # Must be a background job, take the address
+                #
+                set session_id [ns_info address]
+            } else {
+                #
+                # Anonymous request, use a peer address as session_id
+                #
+                set session_id [ad_conn peeraddr]
+            }
+            set secret [ns_config "ns/server/[ns_info server]/acs" parametersecret ""]
+            
+            if {[info commands ::crypto::hmac] ne ""} {
+                set token  [::crypto::hmac string $secret $session_id-[clock clicks -microseconds]]
+            } else {
+                set token  [ns_sha1 "$secret-$session_id-[clock clicks -microseconds]"]
+            }
+            set $globalTokenName $token
+        }
+        return $token
+    }
+
+    # security::csp::require style-src 'unsafe-inline'
+    ad_proc -public ::security::csp::require {{-force:boolean} directive value} {
+        
+        Add a single value directive to the CSP rule-set. The
+        directices are picked up, when the pages is rendered, by the
+        CSP generator.
+        
+        @directive name of the directive (such as e.g. style-src)
+        @value allowed source for this page (such as e.g. unsafe-inline)
+        
+        @author Gustaf Neumann
+        @see    security::csp::render
+    } {
+        set var ::__csp__directive($directive)
+        if {![info exists $var] || $value ni [set $var]} {
+            lappend $var $value
+        }
+        if {$force_p} {
+            ns_log notice "CSP: forcing $directive $value"
+            set var ::__csp__directive_forced($directive)
+            if {![info exists $var] || $value ni [set $var]} {
+                lappend $var $value
+            }
+        }
+    }
+
+    ad_proc -public ::security::csp::render {} {
+        
+        This is the CSP generator. Collect the specified directives
+        and build from these directives the full CSP specification for
+        the current page.
+
+        @author Gustaf Neumann
+        @see    security::csp::require
+    } {
+        #
+        # Fetch the nonce token
+        #
+        set nonce [::security::nonce_token]
+
+        #
+        # Add 'self' rules
+        #
+        security::csp::require default-src 'self'
+        security::csp::require script-src 'self'
+        security::csp::require style-src 'self'
+        security::csp::require img-src 'self'
+        security::csp::require font-src 'self'
+
+        #
+        # Some browser (safari, chrome) need "font-src data:", maybe
+        # for plugins or diffent font settings. Seems safe enough.
+        #
+        security::csp::require font-src data:
+        
+        #
+        # Always add the nonce-token to script-src. Note, that nonce
+        # definition comes via CSP 2, which - at the current time - is
+        # not supported by all browsers interpreting CSPs. We could
+        # add a "unsafe-inline" here, since the spec defines that when
+        # 'unsafe-inline' and a 'nonce-source' is used, the
+        # 'unsafe-inline'" will have no effect
+        # (https://w3c.github.io/webappsec-csp/ § 6.6.2.2.). However,
+        # some security checkers just look for 'unsafe-inline' and
+        # downgrade the rating without honoring the 'nonce-src'.
+        #
+        # Another problem is mixed content. When we set the nonce-src
+        # and 'unsafe-inline', and a browser honoring nonces ignores
+        # the 'unsafe-inline', but some javascript framework requires
+        # it (e.g ckeditor4), we have a problem. Therefore, an
+        # application can force "'unsafe-inline'" which means that we
+        # do not set the nonce-src in such cases.
+        #
+        if {![info exists ::__csp__directive_forced(script-src)]
+            || "'unsafe-inline'" ni $::__csp__directive_forced(script-src)
+        } {
+            security::csp::require script-src 'nonce-$nonce'
+        }
+        
+        # We need for the time being 'unsafe-inline' for style-src,
+        # otherwise not even the style attribute (e.g. <p
+        # style="...">) would be allowed.
+        #
+        security::csp::require style-src 'unsafe-inline'
+
+        #
+        # Define a report URI to ease debugging. CSP 3 will support a
+        # "report-to" directive, but will still support "report-uri".
+        #
+        security::csp::require report-uri /SYSTEM/csp-collector.tcl
+
+        set policy ""
+        foreach directive {
+            child-src
+            connect-src
+            default-src
+            font-src
+            form-action
+            frame-src
+            frame-ancestors
+            img-src
+            media-src
+            object-src
+            plugin-types
+            report-uri
+            sandbox
+            script-src
+            style-src
+        } {
+            set var ::__csp__directive($directive)
+            if {[info exists $var]} {
+                append policy "$directive [join [set $var] { }];"
+            }
+        }
+        return $policy
+    }
+
+}
+
+#TODO remove me: just for a transition phase
+proc ::security::nonce_token args {uplevel ::security::csp::nonce {*}$args}
+
+
+namespace eval ::security::csrf {
+
+    #
+    # CSRF protection.
+    #
+    # High Level commands:
+    #
+    #    security::csrf::new
+    #    security::csrf::validate
+    
+    ad_proc -public ::security::csrf::new {{-tokenname __csrf_token} -user_id} {
+
+        Create a security token to protect against CSRF (Cross-Site
+        Request Forgery).  The token is set (and cached) in a global
+        per-thread variable an can be included in forms e.g. via the
+        following command.
+    
+        <if @::__csrf_token@ defined><input type="hidden" name="__csrf_token" value="@::__csrf_token;literal@"></if>
+
+        The token is automatically cleared together with other global
+        variables at the end of the processing of every request.
+    
+        @return csrf token
+        
+        @author Gustaf Neumann
+    } {
+        set globalTokenName ::$tokenname
+        if {[info exists $globalTokenName] && [set $globalTokenName] ne ""} {
+            return [set $globalTokenName]
+        }
+        
+        set token [token -tokenname $tokenname]
+        return [set $globalTokenName $token]
+    }
+
+    #
+    # validate
+    #
+    ad_proc -public ::security::csrf::validate {{-tokenname __csrf_token} {-allowempty false}} {
+        
+        Validate a CSRF token and call security::csrf::fail the request if
+        invalid.
+
+        @return nothing
+    } {
+        if {![info exists ::$tokenname] || ![ns_conn isconnected]} {
+            #
+            # If there is no global csrf token, or we are not in a
+            # connection thread, we accept everything.  If there is
+            # not csrf token, we assume, that its generation is
+            # deactivated,
+            #
+            return
+        }
+        
+        set oldToken [ns_queryget $tokenname]
+        if {$oldToken eq ""} {
+            #
+            # There is not token in the query/form parameters, we
+            # can't validate, since there is no token.
+            #
+            if {$allowempty} {
+                return
+            }
+            fail
+        }
+        
+        set token [token -tokenname $tokenname]
+        if {$oldToken ne $token} {
+            fail
+        }
+    }
+
+    #
+    # Compute a session id or the best equivalent
+    #
+    ad_proc -private ::security::csrf::session_id { } {
+
+        Return an ID for the current session for CSRF protection
+
+        @return session ID
+    } {
+        if {![ns_conn isconnected]} {
+            #
+            # Must be a background job, take the address
+            #
+            set session_id [ns_info address]
+        } elseif {[ad_conn untrusted_user_id] == 0} {
+            #
+            # Anonymous request, use a peer address as session_id
+            #
+            set session_id [ad_conn peeraddr]
+        } else {
+            #
+            # User is logged in, use a session token.
+            #
+            set session_id [ad_conn session_id]
+        }
+        return $session_id
+    }
+
+    #
+    # Generate CSRF token 
+    #
+    ad_proc -public ::security::csrf::token { {-tokenname __csrf_token} } {
+
+        Generate a CSRF token and return it
+
+        @return CSRF token
+        @author Gustaf Neumann
+    } {
+        #
+        # We compute the token only once per requests. If it was already
+        # computed, and we can pick it up and return it. Otherwise,
+        # we compute it new.
+        #
+        set globalTokenName ::$tokenname
+        if {[info exists $globalTokenName] && [set $globalTokenName] ne ""} {
+            set token [set $globalTokenName]
+        } else {
+            set secret [ns_config "ns/server/[ns_info server]/acs" parametersecret ""]
+            if {[info commands ::crypto::hmac] ne ""} {
+                set token [::crypto::hmac string $secret [session_id]]
+            } else {
+                set token [ns_sha1 $secret-[session_id]]
+            }
+            set $globalTokenName $token
+        }
+
+        return $token
+    }
+
+    #
+    # Failure handling
+    #
+    ad_proc -private ::security::csrf::fail {} {
+    
+        This function is called, when a csrf validation fails. Unless the
+        current user is swa, it aborts the current request.
+        
+    } {
+        ad_log Warning "CSRF failure"
+        if {[acs_user::site_wide_admin_p]} {
+            ns_log notice "would abort if not swa: [ns_conn request]"
+        } else {
+            ad_page_contract_handle_datasource_error "Invalid request token (potential Cross-Site Request Forgery)"
+            ad_script_abort
+        }
+    }
+}
+
 #
 # Local variables:
 #    mode: tcl