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.126 -r1.127 --- openacs-4/packages/acs-tcl/tcl/security-procs.tcl 11 Feb 2019 11:52:48 -0000 1.126 +++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl 3 Sep 2024 15:37:34 -0000 1.127 @@ -1,7 +1,7 @@ ad_library { Provides methods for authorizing and identifying ACS users - (both logged in and not) and tracking their sessions. + (both logged-in and not) and tracking their sessions. @creation-date 16 Feb 2000 @author Jon Salz (jsalz@arsdigita.com) @@ -31,14 +31,15 @@ # Cookies (all are signed cookies): # cookie value max-age secure # -------------------------------------------------------------------------------------------- -# ad_session_id session_id,user_id,login_level SessionTimeout yes|no -# ad_user_login user_id,issue_time,auth_token,forever LoginTimeout|inf no -# ad_user_login_secure user_id,issue_time,auth_token,random,forever LoginTimeout|inf yes -# ad_secure_token session_id,random,peeraddr SessionLifetime yes +# ad_session_id session_id,user_id,login_level SessionTimeout yes|no +# ad_user_login user_id,issue_time,auth_token,forever,er LoginTimeout|inf no +# ad_user_login_secure user_id,issue_time,auth_token,random,forever,er LoginTimeout|inf yes +# ad_secure_token session_id,random,peeraddr SessionLifetime yes # # "random" is used to hinder attack the secure hash. Currently the # random data is ns_time. "peeraddr" is used to avoid session -# hijacking. +# hijacking. "er" stands for external_registry and is only +# nonempty, when an external registry is used. # # ad_user_login/ad_user_login_secure issue_time: # [ns_time] at the time the user last authenticated @@ -48,7 +49,7 @@ # 1 = ok, # 2 = auth ok, but account closed -ad_proc -private sec_random_token {} { +ad_proc -public sec_random_token {} { Generates a random token. } { # ::tcl_sec_seed is used to maintain a small subset of the previously @@ -63,12 +64,13 @@ set request "yoursponsoredadvertisementhere" set start_clicks "cvs.openacs.org" } - - if { ![info exists ::tcl_sec_seed] } { - set ::tcl_sec_seed "listentowmbr89.1" + if {[acs::icanuse "ns_crypto::randombytes"]} { + if {![info exists ::tcl_sec_seed]} { set ::tcl_sec_seed [ns_crypto::randombytes 16].$start_clicks } + set random_base [ns_sha1 "[ns_time][ns_crypto::randombytes -encoding binary 16]$start_clicks$request$::tcl_sec_seed"] + } else { + if {![info exists ::tcl_sec_seed]} { set ::tcl_sec_seed [ns_rand].$start_clicks } + set random_base [ns_sha1 "[ns_time][ns_rand]$start_clicks$request$::tcl_sec_seed"] } - - set random_base [ns_sha1 "[ns_time][ns_rand]$start_clicks$request$::tcl_sec_seed"] set ::tcl_sec_seed [string range $random_base 0 10] return [ns_sha1 [string range $random_base 11 39]] @@ -78,7 +80,10 @@ Returns the maximum lifetime, in seconds, for sessions. } { # default value is 7 days ( 7 * 24 * 60 * 60 ) - return [parameter::get -package_id [ad_acs_kernel_id] -parameter SessionLifetime -default 604800] + return [parameter::get \ + -package_id $::acs::kernel_id \ + -parameter SessionLifetime \ + -default 604800] } ad_proc -private sec_sweep_sessions {} { @@ -107,29 +112,29 @@ ns_log debug "OACS= sec_handler: enter" if {[info exists ::security::log(login_cookie)]} { - foreach c [list ad_session_id ad_secure_token ad_user_login ad_user_login_secure] { - lappend msg "$c '[ad_get_cookie $c]'" + foreach c [list session_id secure_token user_login user_login_secure] { + lappend msg "$c '[ad_get_cookie [security::cookie_name $c]]'" } ns_log notice "OACS [ns_conn url] cookies: $msg" } try { - ad_get_signed_cookie "ad_session_id" + ad_get_signed_cookie [security::cookie_name session_id] } trap {AD_EXCEPTION NO_COOKIE} {errorMsg} { # # We have no session cookie. Maybe we are running under # aa_test. # #if {[nsv_array exists aa_test]} { - # ns_log notice "nsv_array logindata [nsv_get aa_test logindata logindata]" - # ns_log notice "ns_conn peeraddr [ns_conn peeraddr]" - # ns_log notice "dict get $logindata peeraddr [dict get $logindata peeraddr]" + # ns_log notice "... nsv_array logindata [nsv_get aa_test logindata logindata]" + # ns_log notice "... ns_conn peeraddr [ns_conn peeraddr]" + # ns_log notice "... dict get $logindata peeraddr [ns_conn peeraddr]" #} if {[nsv_array exists aa_test] && [nsv_get aa_test logindata logindata] - && [ns_conn peeraddr] eq [dict get $logindata peeraddr] + && [ns_conn peeraddr] in [list [dict get $logindata peeraddr] 127.0.0.1 ::1] } { #ns_log notice logindata=$logindata if {[dict exists $logindata user_id]} { @@ -141,10 +146,10 @@ #ad_conn -set session_id [sec_allocate_session] set auth_level ok set untrusted_user_id $user_id - set ::__aa_testing_mode 1 + aa_test_start } } - if {![info exists ::__aa_testing_mode]} { + if {![aa_test_running_p]} { sec_login_handler } @@ -185,24 +190,33 @@ set persistent_login_p 0 if {$session_user_id > 0} { - try { - sec_login_read_cookie + set login_info [sec_login_read_cookie] + if {[dict get $login_info status] eq "OK"} { - } trap {AD_EXCEPTION NO_COOKIE} {errorMsg} { - # - # No login cookie. - # - ns_log notice "=== no login_cookie" + set auth_token [dict get $login_info auth_token] - } trap {AD_EXCEPTION INVALID_COOKIE} {errorMsg} { # - # Invalid login cookie (might be past validity) + # Verify currently stored user authentication token + # against the one on the login cookie. # - ns_log notice "=== invalid login_cookie" - - } on ok {login_list} { - set login_cookie_exists_p 1 - set persistent_login_p [lindex $login_list end] + if {$auth_token ne [sec_get_user_auth_token $session_user_id]} { + # + # Invalid user auth token in the login + # cookie. This happens e.g. when user changed + # their password, hence all logins on different + # devices must be invalidated. Make sure to log + # the current user out and update session cookie + # and ad_conn information. + # + ad_user_logout + sec_login_handler + } else { + set login_cookie_exists_p 1 + set persistent_login_p [dict get $login_info forever_p] + if {$persistent_login_p eq ""} { + set persistent_login_p 0 + } + } } } @@ -236,7 +250,7 @@ # after the logout this sesson_id is not accepted anymore, # even when below sec_session_renew time (default 5min). # - ns_log warning "downgrade login_level since session_id was invalidated" + ns_log warning "downgrade login_level of user $session_user_id since session_id was invalidated" set login_level 0 } @@ -246,7 +260,7 @@ # login cookie, somebody tries to hack around. # set login_level 0 - ns_log warning "downgrade login_level since there is no login cookie provided" + ns_log warning "downgrade login_level of user $session_user_id since there is no login cookie provided" } switch -- $login_level { @@ -287,7 +301,7 @@ && ([security::secure_conn_p] || [ad_conn behind_secure_proxy_p]) } { catch { - set sec_token [split [ad_get_signed_cookie "ad_secure_token"] {,}] + set sec_token [split [ad_get_signed_cookie [security::cookie_name secure_token]] {,}] if {[lindex $sec_token 0] eq $session_id && [lindex $sec_token 2] eq [ad_conn peeraddr] } { @@ -314,18 +328,7 @@ ::security::log timeout "SessionRefresh in [expr {($session_expr - [sec_session_renew]) - [ns_time]}] secs" if { $session_expr - [sec_session_renew] < [ns_time] } { - - # # LARS: We abandoned the use of sec_login_handler here. This lets people stay logged in forever - # # if only they keep requesting pages frequently enough, but the alternative was that - # # the situation where LoginTimeout = 0 (infinite) and the user unchecks the "Remember me" checkbox - # # would cause users' sessions to expire as soon as the session needed to be renewed sec_generate_session_id_cookie - - # apisano 2018-06-08: as discussed in - # https://openacs.org/forums/message-view?message_id=1691183#msg_1691183, - # this would break sec_change_user_auth_token as a mean to - # invalidate user login... - #sec_login_handler } } # @@ -361,27 +364,97 @@ ad_proc -private sec_login_read_cookie {} { - Fetches values either from ad_user_login_secure or ad_user_login, - depending whether we are in a secured connection or not. + Fetches values either from "user_login_secure" or "user_login" + cookies, depending whether we are in a secured connection or not. @author Victor Guerra - @return List of values read from cookie ad_user_login_secure or ad_user_login + @return dict of values from cookie "user_login_secure" or "user_login". + Additionally, the dict contains a member "status" with possible + values "OK", "NO_COOKIE" or "INVALID_COOKIE" } { # + # ad_user_login user_id,issue_time,auth_token,forever,external_registry + # ad_user_login_secure user_id,issue_time,auth_token,random,forever,external_registry + # # If over HTTPS, we look for the *_secure cookie # if { [security::secure_conn_p] || [ad_conn behind_secure_proxy_p]} { - set cookie_name "ad_user_login_secure" + set cookie_name [security::cookie_name user_login_secure] + set expect_elements 6 } else { - set cookie_name "ad_user_login" + set cookie_name [security::cookie_name user_login] + set expect_elements 5 } - return [split [ad_get_signed_cookie $cookie_name] ","] + + # + # Provide default values for the result. + # + set result { + user_id 0 + issue_time 0 + auth_token "" + forever_p 0 + external_registry "" + status NO_COOKIE + } + + try { + ad_get_signed_cookie $cookie_name + + } trap {AD_EXCEPTION NO_COOKIE} {errorMsg} { + dict set result status NO_COOKIE + + } trap {AD_EXCEPTION INVALID_COOKIE} {errorMsg} { + dict set result status INVALID_COOKIE + + } on ok {cookie_value} { + set login_list [split $cookie_value ","] + dict set result status OK + dict set result user_id [lindex $login_list 0] + dict set result issue_time [lindex $login_list 1] + dict set result auth_token [lindex $login_list 2] + + if {[llength $login_list] == $expect_elements} { + dict set result forever_p [lindex $login_list end-1] + dict set result external_registry [lindex $login_list end] + } else { + # + # Legacy case (no external registry is provided). This is + # just needed for the transition phase, while still old + # cookies are in use, having no "external_registry" + # defined. + # + dict set result forever_p [lindex $login_list end] + dict set result external_registry "" + } + } + return $result } +ad_proc -public sec_login_get_external_registry {} { -ad_proc -private sec_login_handler {} { + If the login was issued from an external_registry, use this as + well for refreshing. + @return registry object or the empty string when not applicable + +} { + set external_registry "" + if {[ns_conn isconnected]} { + set external_registry [dict get [sec_login_read_cookie] external_registry] + if {$external_registry ne "" && ![nsf::is object $external_registry]} { + ns_log warning "external registry object '$external_registry'" \ + "used for login of user [ad_conn untrusted_user_id]" \ + "does not exist. Ignored." + set external_registry "" + } + } + return $external_registry +} + +ad_proc -public sec_login_handler {} { + If a login cookie exists, it is checked for expiration (depending on LoginTimeout) and the account status is validated. In every case, the session info including [ad_conn] and the @@ -401,14 +474,8 @@ # # Check login cookie. # - try { - set login_list [sec_login_read_cookie] - set login_info [list \ - user_id [lindex $login_list 0] \ - issue_time [lindex $login_list 1] \ - auth_token [lindex $login_list 2] \ - forever [lindex $login_list end] ] - + set login_info [sec_login_read_cookie] + if {[dict get $login_info status] eq "OK"} { set untrusted_user_id [dict get $login_info user_id] set auth_level expired @@ -436,6 +503,18 @@ } else { set auth_level ok } + + # + # In case there is no session_id, do not trust the + # provided cookie, since it might be stolen. In + # general, session cookies are recreated on the fly + # for the current user, but we do not want this in + # cases, when we have already a "valid" login cookie. + # + if {[ad_conn session_id] eq ""} { + ns_log warning "downgrade auth_level of user $untrusted_user_id since session_id invalid" + set auth_level expired + } } else { ns_log notice "OACS= auth_token has changed" } @@ -451,16 +530,6 @@ set auth_level none set account_status "closed" } - } trap {AD_EXCEPTION NO_COOKIE} {errorMsg} { - # - # There is no such such cookie, no error to report. - # - } trap {AD_EXCEPTION INVALID_COOKIE} {errorMsg} { - # - # The cookie is not valid (might be past validity) - # - } on error {errorMsg} { - ns_log error "sec_login_handler: $errorMsg, $::errorCode" } sec_setup_session $untrusted_user_id $auth_level $account_status @@ -470,6 +539,7 @@ ad_proc -public ad_user_login { {-account_status "ok"} {-cookie_domain ""} + {-external_registry ""} -forever:boolean user_id } { @@ -479,11 +549,14 @@ } { set prev_user_id [ad_conn user_id] - # deal with the permanent login cookies (ad_user_login and ad_user_login_secure) + # + # Deal with the permanent login cookies (user_login and + # user_login_secure). + # if { $forever_p } { set max_age inf } else { - # ad_user_login cookie will live for as long as the maximum login time + # user_login cookie will live for as long as the maximum login time set max_age [sec_login_timeout] } @@ -493,35 +566,35 @@ 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 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 $cookie_domain \ - ad_user_login_secure \ - "$user_id,[ns_time],[sec_get_user_auth_token $user_id],[ns_time],$forever_p" + [security::cookie_name user_login_secure] \ + "$user_id,[ns_time],[sec_get_user_auth_token $user_id],[ns_time],$forever_p,$external_registry" # We're secure set auth_level "secure" } elseif { $prev_user_id != $user_id } { # Hose the secure login token if this user is different # from the previous one. - ad_unset_cookie -secure t ad_user_login_secure + ad_unset_cookie -secure t [security::cookie_name user_login_secure] } # - # Set "ad_user_login" Cookie always with secure=f for mixed + # Set "user_login" Cookie always with secure=f for mixed # content. # - ns_log Debug "ad_user_login: Setting new ad_user_login cookie with max_age $max_age" + ns_log Debug "ad_user_login: Setting new user_login cookie with max_age $max_age" ad_set_signed_cookie \ -expire [expr {$forever_p ? false : true}] \ -max_age $max_age \ -domain $cookie_domain \ -secure f \ - ad_user_login \ - "$user_id,[ns_time],[sec_get_user_auth_token $user_id],$forever_p" + [security::cookie_name user_login] \ + "$user_id,[ns_time],[sec_get_user_auth_token $user_id],$forever_p,$external_registry" # deal with the current session sec_setup_session -cookie_domain $cookie_domain $user_id $auth_level $account_status @@ -547,7 +620,8 @@ ad_proc -public sec_change_user_auth_token { user_id } { - Change the user's auth_token, which invalidates all existing login cookies, i.e. forces user logout at the server. + Change the user's auth_token, which invalidates all existing login cookies, + i.e. forces user logout at the server. } { set auth_token [ad_generate_random_string] @@ -559,14 +633,29 @@ return $auth_token } - ad_proc -public ad_user_logout { {-cookie_domain ""} } { Logs the user out. } { + + set external_registry [sec_login_get_external_registry] + if {$external_registry ne ""} { + # + # If we were logged in via an external identity provider, try + # to logout from there as well. Note that not every external + # identity provider supports a logout (e.g. GitHub), and maybe + # in some cases, the external logout is not wanted. This + # should be provided by the implementation of the external + # registry. + # + $external_registry logout + } + if {$cookie_domain eq ""} { - set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id] + set cookie_domain [parameter::get \ + -parameter CookieDomain \ + -package_id $::acs::kernel_id] } # @@ -581,54 +670,220 @@ # "SecureSessionCookie" was altered during a session, but this # should be a seldom border case. # - ad_unset_cookie -domain $cookie_domain -secure [expr {[parameter::get \ + ad_unset_cookie \ + -domain $cookie_domain \ + -secure [expr {[parameter::get \ + -boolean \ -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 + -package_id $::acs::kernel_id \ + -default 0] ? "t" : "f"}] \ + [security::cookie_name session_id] + + set external_registry [dict get [sec_login_read_cookie] external_registry] + if {$external_registry ne "" && [nsf::is object $external_registry]} { + # + # Logout from external registry + # + ns_log notice "logout from external registry: $external_registry" + $external_registry logout + } + + ad_unset_cookie -domain $cookie_domain -secure f [security::cookie_name user_login] + ad_unset_cookie -domain $cookie_domain -secure t [security::cookie_name secure_token] + ad_unset_cookie -domain $cookie_domain -secure t [security::cookie_name user_login_secure] } +namespace eval ::security { + ad_proc -private preferred_password_hash_algorithm {} { + + Check the list of preferred password hash algorithms and the + return the best which is available (or "salted-sha1" if + nothing applies). + + @return password preferred hash algorithm + } { + + set preferences [parameter::get \ + -parameter PasswordHashAlgorithm \ + -package_id $::acs::kernel_id \ + -default "salted-sha1"] + foreach algo $preferences { + if {[info commands ::security::hash::$algo] ne ""} { + # + # This preference is available. + # + return $algo + } else { + ns_log warning "PasswordHashAlgorithm '$algo' was specified," \ + "but is not available in your setup." + } + } + # + # General fallback (only necessary for invalid parameter settings) + # + ns_log warning "No valid PasswordHashAlgorithm was specified: '$preferences'." \ + "Fall back to default." + + return "salted-sha1" + } +} + +namespace eval ::security::hash { + ad_proc -private salted-sha1 {password salt} { + + Classical OpenACS password hash algorithm. This algorithm must + be always available and is independent of the + NaviServer/AOLserver version. + + @return hex encoded password hash + + } { + set salt [string trim $salt] + return [ns_sha1 ${password}${salt}] + } + + if {[::acs::icanuse "ns_crypto::pbkdf2_hmac"]} { + ad_proc -private scram-sha-256 {password salt} { + + SCRAM hash function using sha256 as digest function. The + SCRAM hash function is PBKDF2 [RFC2898] with HMAC as the + pseudo-random function and where the output key length == + hash length. We use 15K iterations for PBKDF2 as + recommended in RFC 7677. + + @return hex encoded password hash (64 bytes) + } { + return [::ns_crypto::pbkdf2_hmac \ + -digest sha256 \ + -iterations 15000 \ + -secret $password \ + -salt $salt] + } + } + + if {[::acs::icanuse "ns_crypto::scrypt"]} { + ad_proc -private scrypt-16384-8-1 {password salt} { + + Compute a "password hash" using the scrypt password based + key derivation function (RFC 7914) + + @return hex encoded password hash (128 bytes) + } { + return [::ns_crypto::scrypt -secret $password -salt $salt -n 16384 -r 8 -p 1] + } + } + + if {[::acs::icanuse "ns_crypto::argon2"]} { + ad_proc -private argon2-12288-3-1 {password salt} { + + Compute a "password hash" using the Argon2 hash algorithm + key derivation function (RFC 9106). + + Parameterization recommendation from OWASP: m=12288 (12 MiB), t=3, p=1 + + @return hex encoded password hash (128 bytes) + } { + return [::ns_crypto::argon2 -variant argon2id \ + -password $password -salt $salt \ + -memcost 12288 -iter 3 -lanes 1 -threads 1 -outlen 64] + } + + ad_proc -private argon2-rfc9106-high-mem {password salt} { + + Compute a "password hash" using the Argon2 hash algorithm + key derivation function (RFC 9106). + + Parameterization first recommendation from RFC 9106: + t=1, m=2GiB, p=4 (2 GiB = 2,097,152 KB) + + @return hex encoded password hash (128 bytes) + } { + return [::ns_crypto::argon2 -variant argon2id \ + -password $password -salt $salt \ + -memcost 2097152 -iter 1 -lanes 4 -threads 4 -outlen 64] + } + + ad_proc -private argon2-rfc9106-low-mem {password salt} { + + Compute a "password hash" using the Argon2 hash algorithm + key derivation function (RFC 9106). + + Parameterization second recommendation from RFC 9106 (low memory): + t=3, m=64 MiB, p=4 (64 MiB = 65,536 KB) + + @return hex encoded password hash (128 bytes) + } { + return [::ns_crypto::argon2 -variant argon2id \ + -password $password -salt $salt \ + -memcost 65536 -iter 3 -lanes 4 -threads 4 -outlen 64] + } + + } +} + ad_proc -public ad_check_password { user_id password_from_form } { - Returns 1 if the password is correct for the given user ID. + + Check if the provided password is correct. OpenACS never stores + password, but uses salted hashes for identification. Different + algorithm can be used. When the stored hash is from another hash + algorithm, which is preferred, this function updates the password + hash automatically, but only, when the password is correct. + + @return Returns 1 if the password is correct for the given user ID. } { - set found_p [db_0or1row password_select {select password, salt from users where user_id = :user_id}] - db_release_unused_handles + set found_p [db_0or1row password_select { + select password, salt, password_hash_algorithm from users where user_id = :user_id + }] if { !$found_p } { return 0 } - set salt [string trim $salt] - - if {$password ne [ns_sha1 "$password_from_form$salt"] } { + if {$password ne [::security::hash::$password_hash_algorithm $password_from_form $salt] } { return 0 } + set preferred_hash_algorithm [security::preferred_password_hash_algorithm] + if {$preferred_hash_algorithm ne $password_hash_algorithm} { + ns_log notice "upgrade password hash for user $user_id from" \ + "$password_hash_algorithm to $preferred_hash_algorithm" + ad_change_password \ + -password_hash_algorithm $preferred_hash_algorithm \ + $user_id \ + $password_from_form + } return 1 } ad_proc -public ad_change_password { + {-password_hash_algorithm "salted-sha1"} user_id new_password } { Change the user's password } { - # In case someone wants to change the salt from now on, you can do - # this and still support old users by changing the salt below. - if { $user_id eq "" } { error "No user_id supplied" } + # + # The hash algorithms are called in standard OpenACS with a salt + # size of 20 bytes (in hex format), which corresponds to 160-bit. + # set salt [sec_random_token] - set new_password [ns_sha1 "$new_password$salt"] - db_dml password_update {} - db_release_unused_handles + set new_password [::security::hash::$password_hash_algorithm $new_password $salt] + + db_dml password_update { + update users + set password = :new_password, + salt = :salt, + password_hash_algorithm = :password_hash_algorithm, + password_changed_date = current_timestamp + where user_id = :user_id + } } ad_proc -private sec_setup_session { @@ -653,7 +908,7 @@ ns_log debug "OACS= empty session_id" set session_id [sec_allocate_session] - # if we have a user on an newly allocated session, update + # if we have a user on a newly allocated session, update # users table ns_log debug "OACS= newly allocated session $session_id" @@ -664,40 +919,44 @@ ns_log debug "OACS= done updating user session info, user_id NONZERO" } } else { - # $session_id is an active verified session - # this call is either a user logging in - # on an active unidentified session, or a change in identity - # for a browser that is already logged in - - # this is an active session [ad_conn user_id] will not return - # the empty string + # + # $session_id is an active verified session this call is + # either a user doing a log-in on an active unidentified + # session, or a change in identity for a browser that is + # already logged-in. + # set prev_user_id [ad_conn user_id] # # Change the session id for all user_id changes, also on # changes from user_id 0, since owasp recommends to renew the - # session_id after any privilege level change + # session_id after any privilege level change. # 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" + # + # This is a change in identity so we create + # a new session_id to avoid sharing of session-level data + # 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 + # + # 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 } } set user_id 0 - - # If both auth_level and account_status are 'ok' or better, we have a solid user_id + # + # If both auth_level and account_status are 'ok' or better, we + # have a solid user_id. + # if { ($auth_level eq "ok" || $auth_level eq "secure") && $account_status eq "ok" } { set user_id $new_user_id } @@ -719,8 +978,10 @@ && ([security::secure_conn_p] || [ad_conn behind_secure_proxy_p]) && $new_user_id != 0 } { - # this is a secure session, so the browser needs - # a cookie marking it as such + # + # This is a secure session, so the browser needs + # a cookie marking it as such. + # sec_generate_secure_token_cookie } } @@ -736,10 +997,21 @@ db_release_unused_handles } +ad_proc security::cookie_name {plain_name} { + @return the supplied cookie name, but potentially prefixed + according to the NaviServer CookieNamespace parameter, to + make it unique for this particular domain. +} { + # + # Setting a cookie always requires a connection. + # + return [ns_config "ns/server/[ns_info server]/acs" CookieNamespace "ad_"]$plain_name +} + ad_proc -private sec_generate_session_id_cookie { {-cookie_domain ""} } { - Sets the ad_session_id cookie based on global variables. + Sets the "session_id" cookie based on global variables. } { set user_id [ad_conn untrusted_user_id] # @@ -758,41 +1030,50 @@ } } - ns_log Debug "Security: [ns_time] sec_generate_session_id_cookie setting session_id=$session_id, user_id=$user_id, login_level=$login_level" + ns_log Debug "Security: [ns_time] sec_generate_session_id_cookie setting" \ + "session_id=$session_id, user_id=$user_id, login_level=$login_level" if {$cookie_domain eq ""} { - set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id] + set cookie_domain [parameter::get \ + -parameter CookieDomain \ + -package_id $::acs::kernel_id] } - # Fetch the last value element of ad_user_login cookie (or - # ad_user_login_secure) that indicates if user wanted to be + # Fetch the last value element of "user_login" or + # "user_login_secure" cookie that indicates if user wanted to be # remembered when logging in. set discard t set max_age [sec_session_timeout] - catch { - set login_list [sec_login_read_cookie] - if {[lindex $login_list end] == 1} { - set discard f - set max_age inf - } + set login_info [sec_login_read_cookie] + if {[dict get $login_info status] eq "OK" + && [dict get $login_info forever_p] + } { + set discard f + set max_age inf } + ad_set_signed_cookie \ -secure [expr {[parameter::get \ + -boolean \ -parameter SecureSessionCookie \ - -package_id [ad_acs_kernel_id] \ + -package_id $::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]" + [security::cookie_name session_id] \ + "$session_id,$user_id,$login_level,[ns_time]" } ad_proc -private sec_generate_secure_token_cookie { } { - Sets the ad_secure_token cookie. + Sets the "secure_token" cookie. } { - ad_set_signed_cookie -secure t "ad_secure_token" "[ad_conn session_id],[ns_time],[ad_conn peeraddr]" + ad_set_signed_cookie \ + -secure t \ + [security::cookie_name secure_token] \ + "[ad_conn session_id],[ns_time],[ad_conn peeraddr]" } ad_proc -private sec_allocate_session {} { @@ -823,7 +1104,6 @@ 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] } { @@ -855,11 +1135,12 @@ # 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] + set mapping [acs::misc_cache eval ad_get_host_node_map { + db_list_of_lists get_node_host_names {select host, node_id from host_node_map} + }] + set p [lsearch -index 0 -exact $mapping $hostname] if {$p != -1} { - set result [lindex $lists $p 1] + set result [lindex $mapping $p 1] } else { set result 0 } @@ -910,7 +1191,7 @@ return $location/[join $elements /] } -ad_proc -private security::get_register_subsite {} { +ad_proc security::get_register_subsite {} { Returns a URL pointing to the subsite, on which the register/unregister should be performed. If there is no current @@ -954,9 +1235,9 @@ 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 + # the URL to the configured hostname, since # get_qualified prepends the [ad_conn location], which - # points to the virtual host name. + # points to the virtual hostname. set url [security::replace_host_in_url -hostname $config_hostname $url] } } else { @@ -979,11 +1260,11 @@ # # We are on normal subsite # - if { [ad_conn isconnected] } { + if { [ns_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) + # 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. # @@ -1017,54 +1298,155 @@ host_node_id $host_node_id] } +ad_proc security::safe_tmpfile_p { + -must_exist:boolean + tmpfile +} { + Checks that a file is a safe tmpfile, that is, it belongs to the + configured tmpdir. + + When the file exists, we also enforce additional criteria: + - file must belong to the current system user + - file must be readable and writable by the current system user + + @param tmpfile absolute path to a possibly existing tmpfile + @param must_exist make sure the file exists + + @return boolean +} { + # + # Ensure no ".." in the path + # + set tmpfile [ns_normalizepath $tmpfile] + set tmpdir [string trimright [ns_config ns/parameters tmpdir] /] + + if {[ad_file dirname $tmpfile] ne $tmpdir} { + # + # File is not a direct child of the tmpfolder: not safe + # + return false + } + + if {![ad_file exists $tmpfile]} { + # + # File does not exist yet: safe, unless we demand for the file + # to exist. + # + return [expr {!$must_exist_p}] + } + + if {![ad_file owned $tmpfile]} { + # + # File does not belong to us: not safe + # + return false + } + + if {![ad_file readable $tmpfile]} { + # + # We cannot read the file: not safe + # + return false + } + + if {![ad_file writable $tmpfile]} { + # + # We cannot write the file: not safe + # + return false + } + + # + # The file is safe + # + return true +} + ad_proc -public ad_get_login_url { {-authority_id ""} {-username ""} -return:boolean + {-external_registry ""} } { - Returns a URL to the login page of the closest subsite, or the main site, if there's no current connection. + 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. + @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) @author Gustaf Neumann } { + # + # Get the login_url 'url' and some more parameters form the + # register subsite for this registry. + # set subsite_info [security::get_register_subsite] foreach var {url require_qualified_return_url host_node_id} { set $var [dict get $subsite_info $var] } - append url "register/" - - # - # 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 { [ns_conn isconnected] + && $return_p + } { # # 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] || [ad_conn behind_secure_proxy_p] || ![security::RestrictLoginToSSLP]) + && ([security::secure_conn_p] + || [ad_conn behind_secure_proxy_p] + || ![security::RestrictLoginToSSLP] + ) } { set return_url [ad_return_url] } else { set return_url [ad_return_url -qualified] } } - 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}] + if {$external_registry ne ""} { + ns_log notice "the external registry $external_registry is used" + # + # We get here in cases of a refresh of a login, since we know + # that the current user_id is expired, and the user has + # registered via an external registry. Therefore, we use + # the same external registry for the refresh. + # + # In general, we have two options: (a) redirect directly to + # the external registry login page, or (b) redirect to an + # external registry enhanced classical OpenACS login page. We + # are here on the (a) path, since potentially, the external + # identity managers allows one to continue without even showing a + # login page (when it says, the login is still valid). + # + # The path (b) might be chosen via a future package parameter. + # + set url [$external_registry login_url -return_url $return_url] + } else { + append url "register/" + + # + # Don't add a return_url if you're already under /register, + # because that will frequently interfere with the normal login + # procedure. + # + if { [string match "register/*" [ad_conn extra_url]] } { + set return_url "" + } + 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 + }] + } ::security::log login_url "ad_get_login_url: final login_url <$url>" return $url @@ -1075,9 +1457,10 @@ {-return_url ""} } { - Returns a URL to the logout page of the closest subsite, or the main site, if there's no current connection. + Returns a URL to the logout 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 logout is complete + @option return If set, will export the current form, so when the logout is complete the user will be returned to the current location. All variables in ns_getform (both posts and gets) will be maintained. @@ -1099,6 +1482,47 @@ return $url } +ad_proc -public ad_get_external_registries { + {-subsite_id ""} +} { + + Return for the specified subsite (or the current registry subsite) + the external authority interface objs. Per default, all defined + external registries are returned, but a subsite might restrict this. + +} { + if {$subsite_id eq ""} { + set subsite_id [dict get [security::get_register_subsite] subsite_id] + } + set offered_registries [parameter::get \ + -parameter OfferedRegistries \ + -package_id $subsite_id \ + -default *] + + set result {} + if {[nsf::is object ::xo::Authorize]} { + foreach auth_obj [::xo::Authorize info instances -closure] { + # + # Don't list on the general available pages the external + # authorization objects when these are configured in debugging + # mode. + # + if {[$auth_obj cget -debug]} { + continue + } + + if {$offered_registries eq "*" + || $auth_obj in $offered_registries + } { + lappend result $auth_obj + } + } + } + return $result +} + + + # JCD 20020915 I think this probably should not be deprecated since it is # far more reliable than permissioning esp for a development server @@ -1148,6 +1572,7 @@ {-secret ""} {-token_id ""} {-max_age ""} + {-binding 0} value } { Returns a digital signature of the value. Negative token_ids are @@ -1161,8 +1586,18 @@ @param secret allows the caller to specify a known secret external to the random secret management mechanism. - @param token_id allows the caller to specify a token_id which is then ignored so don't use it. + @param token_id allows the caller to specify a token_id which + is then ignored so don't use it. + @param binding allows the caller to bind a signature to a user/session. + A value of 0 (default) means no additional binding. + When the value is "-1" only the user who created the signature can + obtain the value again. + When the value is "-2" only the user with the same csrf token can + obtain the value again. + + The permissible values might be extended in the future. + @param value the value to be signed. } { if {$token_id eq ""} { @@ -1185,7 +1620,22 @@ set expire_time [expr {$max_age + [ns_time]}] } - set hash [ns_sha1 "$value$token_id$expire_time$secret_token"] + switch $binding { + -1 { + set binding_value [ad_conn user_id] + append token_id :$binding + } + -2 { + set binding_value [::security::csrf::new] + append token_id :$binding + } + 0 { + set binding_value "" + } + default {error "invalid binding"} + } + + set hash [ns_sha1 "$value$token_id$expire_time$secret_token$binding_value"] set signature [list $token_id $expire_time $hash] return $signature @@ -1203,6 +1653,10 @@ @param secret specifies an external secret to use instead of the one provided by the ACS signature mechanism. } { + if {![string is list $signature]} { + ns_log warning "signature is not a list '$signature'" + return 0 + } lassign $signature token_id expire_time hash return [__ad_verify_signature $value $token_id $secret $expire_time $hash] } @@ -1218,6 +1672,10 @@ @param secret specifies an external secret to use instead of the one provided by the ACS signature mechanism. } { + if {![string is list $signature]} { + ns_log warning "signature is not a list '$signature'" + return 0 + } lassign $signature token_id expire_time hash if { [__ad_verify_signature $value $token_id $secret $expire_time $hash] } { return $expire_time @@ -1239,26 +1697,44 @@ } { + lassign [split $token_id :] raw_token_id binding + if { $secret eq "" } { - if { $token_id eq "" } { + if { $raw_token_id eq "" } { ns_log Debug "__ad_verify_signature: Neither secret, nor token_id supplied" return 0 - } elseif {![string is integer -strict $token_id]} { - ns_log Warning "__ad_verify_signature: token_id <$token_id> is not an integer" + } elseif {![string is integer -strict $raw_token_id]} { + ns_log Warning "__ad_verify_signature: token_id <$raw_token_id> is not an integer" return 0 } - set secret_token [sec_get_token $token_id] + try { + set secret_token [sec_get_token $raw_token_id] + } on error {errmsg} { + ns_log Warning "__ad_verify_signature: token_id <$raw_token_id> validation returns '$errmsg'" + return 0 + } + } else { set secret_token $secret } ns_log Debug "__ad_verify_signature: Getting token_id $token_id, value $secret_token ; " ns_log Debug "__ad_verify_signature: Expire_Time is $expire_time (compare to [ns_time]), hash is $hash" - # validate cookie: verify hash and expire_time - set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token"] + if {$binding == -1} { + set binding_value [ad_conn user_id] + } elseif {$binding == -2} { + set binding_value [::security::csrf::new] + } else { + set binding_value "" + } + # + # Compute hash based on tokes, expire_time and user_id/csrf token + # + set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token$binding_value"] + # Need to verify both hash and expiration set hash_ok_p 0 set expiration_ok_p 0 @@ -1267,14 +1743,20 @@ ns_log Debug "__ad_verify_signature: Hash matches - Hash check OK" set hash_ok_p 1 } else { - # check to see if IE is lame (and buggy!) and is expanding \n to \r\n + # + # Check to see if IE is lame (and buggy!) and is expanding \n to \r\n # See: http://rhea.redhat.com/bboard-archive/webdb/000bfF.html + # set value [string map [list \r ""] $value] set org_computed_hash $computed_hash - set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token"] + set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token$binding_value"] if {$computed_hash eq $hash} { - ns_log Debug "__ad_verify_signature: Hash matches after correcting for IE bug - Hash check OK" + # + # Not sure, the comments for IE are still true, so issue + # warnings in the error.log when this happens. + # + ns_log warning "__ad_verify_signature: Hash matches after correcting for IE bug - Hash check OK" set hash_ok_p 1 } else { ns_log Debug "__ad_verify_signature: Hash ($hash) doesn't match what we expected ($org_computed_hash) - Hash check FAILED" @@ -1308,10 +1790,14 @@ validation fails (maybe due to expiration). @return cookie value + + @see ad_get_cookie + @see ad_set_signed_cookie + @see ad_get_signed_cookie_with_expr } { set cookie_value [ad_get_cookie -include_set_cookies $include_set_cookies $name] - if { $cookie_value eq "" } { + if { $cookie_value eq "" || ![string is list $cookie_value]} { throw {AD_EXCEPTION NO_COOKIE} {Cookie does not exist} } @@ -1335,14 +1821,18 @@ Retrieves a signed cookie. Validates a cookie against its cryptographic signature and ensures that the cookie has not - expired. Returns a two-element list, the first element of which is - the cookie data, and the second element of which is the expiration - time. Throws an exception if validation fails. + expired. Throws an exception when cookie does not exist or + validation fails. + @return Two-element list containing cookie data and expiration time + + @see ad_get_cookie + @see ad_get_signed_cookie + @see ad_set_signed_cookie } { set cookie_value [ad_get_cookie -include_set_cookies $include_set_cookies $name] - if { $cookie_value eq "" } { + if { $cookie_value eq "" || ![string is list $cookie_value]} { throw {AD_EXCEPTION NO_COOKIE} {Cookie does not exist} } @@ -1370,6 +1860,7 @@ {-path "/"} {-secret ""} {-token_id ""} + {-samesite lax} name value } { @@ -1396,6 +1887,10 @@ @param value the value for the cookie. This is automatically url-encoded. + @see ad_set_cookie + @see ad_get_signed_cookie + @see ad_get_signed_cookie_with_expr + } { if { $signature_max_age eq "" } { if { $max_age in {"inf" 0} } { @@ -1425,6 +1920,7 @@ -max_age $max_age \ -domain $domain \ -path $path \ + -samesite $samesite \ $name $data } @@ -1438,7 +1934,33 @@ # ##### -ad_proc -private sec_get_token { +if {[ns_info name] eq "NaviServer"} { + ad_proc -private sec_get_token_from_nsv {token_id token_var} { + + Just for compatibility with AOLserver, which does not support + an atomic check and get operation for nsv. + + } { + upvar $token_var token + return [nsv_get secret_tokens $token_id token] + } +} else { + ad_proc -private sec_get_token_from_nsv {token_id token_var} { + + Compatibility function for AOLserver, which does not support + nsv_get with the optional output variable. + + } { + upvar $token_var token + if {[nsv_exists secret_tokens $token_id]} { + set token [nsv_get secret_tokens $token_id] + return 1 + } + return 0 + } +} + +ad_proc -public sec_get_token { token_id } { @@ -1454,92 +1976,109 @@ } { + # + # First check the per-thread cache to obtain a token from the + # token_id. + # set key ::security::tcl_secret_tokens($token_id) - if { [info exists $key] } { return [set $key] } + if { [info exists $key] } { + return [set $key] + } + # + # If there is no secret token available per thread, + # get it and try again. + # if {[array size ::security::tcl_secret_tokens] == 0} { - populate_secret_tokens_thread_cache - if { [info exists $key] } { return [set $key] } + sec_populate_secret_tokens_thread_cache + if { [info exists $key] } { + return [set $key] + } } # # We might get token_ids from previous runs, so we have fetch these - # in case of a validation + # from the secret tokens cache, or from the data base. # - set token [ns_cache eval secret_tokens $token_id { + if {![sec_get_token_from_nsv $token_id token]} { set token [db_string get_token {select token from secret_tokens where token_id = :token_id} -default 0] - - # Very important to throw the error here if $token == 0 - - if { $token == 0 } { + if {$token ne 0} { + nsv_set secret_tokens $token_id $token + } else { + # + # Very important to throw the error here if $token == 0 + # error "Invalid token ID" } + } - return $token - }] - set $key $token return $token } -ad_proc -private sec_get_random_cached_token_id {} { +ad_proc -public sec_get_random_cached_token_id {} { Randomly returns a token_id from the token cache } { #set list_of_names [ns_cache names secret_tokens] set list_of_names [array names ::security::tcl_secret_tokens] if {[llength $list_of_names] == 0} { - populate_secret_tokens_thread_cache + sec_populate_secret_tokens_thread_cache set list_of_names [array names ::security::tcl_secret_tokens] } set random_seed [ns_rand [llength $list_of_names]] return [lindex $list_of_names $random_seed] } -ad_proc -private populate_secret_tokens_thread_cache {} { +ad_proc -private sec_populate_secret_tokens_thread_cache {} { Copy secret_tokens cache to per-thread variables } { - set ids [ns_cache names secret_tokens] - if {[llength $ids] == 0} { - populate_secret_tokens_cache - set ids [ns_cache names secret_tokens] + set secret_tokens [nsv_array get secret_tokens] + if {[llength $secret_tokens] == 0} { + sec_populate_secret_tokens_cache + set secret_tokens [nsv_array get secret_tokens] } - foreach name $ids { - set ::security::tcl_secret_tokens($name) [ns_cache get secret_tokens $name] + foreach {id token} $secret_tokens { + set ::security::tcl_secret_tokens($id) $token } } -ad_proc -private populate_secret_tokens_cache {} { +ad_proc -private sec_populate_secret_tokens_cache {} { Randomly populates the secret_tokens cache. } { + set num_tokens [parameter::get \ + -package_id $::acs::kernel_id \ + -parameter NumberOfCachedSecretTokens \ + -default 100] - set num_tokens [parameter::get -package_id [ad_acs_kernel_id] -parameter NumberOfCachedSecretTokens -default 100] - # 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 {} { - ns_cache set secret_tokens $token_id $token + nsv_set secret_tokens $token_id $token } } db_release_unused_handles } -ad_proc -private populate_secret_tokens_db {} { +ad_proc -private sec_populate_secret_tokens_db {} { Populates the secret_tokens table. Note that this will take a while to run. } { - set num_tokens [parameter::get -package_id [ad_acs_kernel_id] -parameter NumberOfCachedSecretTokens -default 100] + set num_tokens [parameter::get \ + -package_id $::acs::kernel_id \ + -parameter NumberOfCachedSecretTokens \ + -default 100] # we assume sample size of 10%. set num_tokens [expr {$num_tokens * 10}] set counter 0 @@ -1566,14 +2105,14 @@ # ##### -ad_proc -private sec_lookup_property { +ad_proc -private sec_lookup_property_not_cached { id module name } { - Used as a helper procedure for util_memoize to look up a - particular property from the database. + Look up a particular session property from the database and record + the last hit when found. @return empty, when no property is recorded or a list containing property_value and secure_p @@ -1614,7 +2153,7 @@ 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 HTTPS. + over HTTPS or the default is returned. @param session_id controls which session is used @param module typically the name of the package to which the property @@ -1637,7 +2176,7 @@ set id $session_id } - set cmd [list sec_lookup_property $id $module $name] + set cmd [list sec_lookup_property_not_cached $id $module $name] if { $cache_only == "t" && ![util_memoize_cached_p $cmd] } { return $default @@ -1694,7 +2233,7 @@ } if { $session_id eq "" } { - ns_log warning "could not obtain a session_id via 'ad_conn session_id'" + ad_log warning "could not obtain a session_id via 'ad_conn session_id'" } else { if { $persistent == "t" } { @@ -1734,17 +2273,62 @@ # # Perform an upsert operation via stored procedure # - db_exec_plsql prop_upsert {} + if {[db_driverkey ""] eq "oracle"} { + acs::dc call sec_session_property upsert \ + -p_session_id $session_id \ + -p_module $module \ + -p_name $name \ + -p_value $value \ + -p_secure $secure \ + -p_last_hit $last_hit + } else { + acs::dc call sec_session_property upsert \ + -session_id $session_id \ + -module $module \ + -name $name \ + -value $value \ + -secure $secure \ + -last_hit $last_hit + } } } } # Remember the new value, seeding the memoize cache with the proper value. - util_memoize_seed [list sec_lookup_property $session_id $module $name] [list $value $secure] + util_memoize_seed \ + [list sec_lookup_property_not_cached $session_id $module $name] \ + [list $value $secure] } +# +# Provide a global variable for devopers to activate/deactivate +# client_property_password in case a site has good reasons not to +# using the client property (e.g. site specific code). This is meant +# to be transitional code. +# +set ::acs::pass_password_as_query_variable 0 +ad_proc -public security::set_client_property_password {password} { + + Convenience function for remembering user password as client property + rather than passing it as query parameter. + + @see security::get_client_property_password +} { + ad_set_client_property -persistent f acs-admin user-password $password +} + +ad_proc -public security::get_client_property_password {password} { + + Convenience function for retrieving user password from client property + + @see security::set_client_property_password + +} { + return [ad_get_client_property acs-admin user-password] +} + ##### # # security namespace public procs @@ -1780,7 +2364,7 @@ return [parameter::get \ -boolean \ -parameter RestrictLoginToSSLP \ - -package_id [ad_acs_kernel_id]] + -package_id $::acs::kernel_id] } ad_proc -public security::require_secure_conn {} { @@ -1862,7 +2446,7 @@ } -ad_proc -private security::get_qualified_url { url } { +ad_proc -public security::get_qualified_url { url } { @return secure or insecure qualified url } { if { [security::secure_conn_p] || [ad_conn behind_secure_proxy_p] } { @@ -1925,7 +2509,7 @@ return $uri } -ad_proc -private security::get_secure_location {} { +ad_proc -public security::get_secure_location {} { Return the current location in secure (https) mode. @author Peter Marklund @@ -1943,6 +2527,7 @@ # SuppressHttpPort is set. # set suppress_http_port [parameter::get -parameter SuppressHttpPort \ + -boolean \ -package_id [apm_package_id_from_key acs-tcl] \ -default 0] set secure_location [util::join_location \ @@ -1975,6 +2560,7 @@ # SuppressHttpPort is set. # set suppress_http_port [parameter::get -parameter SuppressHttpPort \ + -boolean \ -package_id [apm_package_id_from_key acs-tcl] \ -default 0] set insecure_location [util::join_location \ @@ -1990,28 +2576,31 @@ if {[ns_info name] ne "NaviServer"} { # - # 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. + # Compatibility function for AOLserver, which abstracts from the + # configuration section in the config files. NaviServer supports + # in general global and per-server defined drivers. # + # In the emulated version for AOLserver just report the per-server + # configurations, since these are the only ones supported by + # AOLserver. + # ad_proc -public ns_driversection { {-driver "nssock"} {-server ""} } { - Return the section name in the config file containing configuration information about the - network connection. + Return the section name in the config file containing + configuration information about the network connection. + @param driver (e.g. nssock) - @param server symobolic server name + @param server symbolic server name @return name of section of the drive in the config file } { if {$server eq ""} {set server [ns_info server]} return "ns/server/$server/module/$driver" } } -ad_proc -public ad_server_modules {} { +ad_proc -private ad_server_modules {} { Return the list of the available server modules @author Gustaf Neumann } { @@ -2048,43 +2637,69 @@ return $::acs::sdriver } -if {[info commands ns_driver] ne ""} { +if {[namespace which ns_driver] ne ""} { - ad_proc -private security::configured_driver_info {} { + ad_proc -public security::configured_driver_info {} { Return a list of dicts containing type, driver, location and port of all configured drivers @see util_driver_info } { - set defaultport {http 80 https 433} + set protos {http 80 https 443} 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 {$location ne ""} { + set li [ns_parseurl $location] - if {[dict exists $li port]} { - set port [dict get $li port] - set suffix ":$port" + if {[dict exists $li port]} { + set port [dict get $li port] + set suffix ":$port" + } else { + set port [dict get $protos $proto] + set suffix "" + } } else { - set port [dict get $defaultport $proto] - set suffix "" + # + # In case we have no "location" defined (e.g. virtual + # hosting), get "port" and suffix directly from the + # driver. + # + if {[dict exists $i port]} { + set port [lindex [dict get $i port] 0] + set defaultport [dict get $i defaultport] + } else { + set driver_section [ns_driversection -driver [dict exists $i module]] + set port [ns_config -int $driver_section port] + set defaultport [dict get $protos $proto] + } + # + # Newer versions of NaviServer support multiple ports + # per driver. For now, take the first one (similar with "address" below). + # + set port [lindex [dict get $i port] 0] + if {$port eq $defaultport} { + set suffix "" + } else { + set suffix ":$port" + } } lappend result [list \ proto $proto \ driver [dict get $i module] \ - host [dict get $li host] \ + host [lindex [dict get $i address] 0] \ location $location port $port suffix $suffix] } return $result } } else { - ad_proc -private security::configured_driver_info {} { + ad_proc -public security::configured_driver_info {} { set result "" # # Find the first insecure driver based on driver names from @@ -2174,95 +2789,108 @@ } } -ad_proc -public security::locations {} { +ad_proc -private security::configured_locations { + {-suppress_http_port:boolean false} + {-secure_conn:boolean false} +} { - This function returns the configured locations and the current - location and the vhost locations, potentially in HTTP or in HTTPs - variants. + This function returns the configured locations. 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. - The term location refers to protocol://domain:port for - website. + The term location refers to "protocol://domain:port" for website. - @return insecure location and secure location followed possibly by alternate location(s) as a list. + @return list of locations } { set locations [list] set portless_locations {} # - # Get Information from configured servers + # Get configuration information from the 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 + # port == 0 means that the driver is just used for sending, + # but not for receiving. In this case, this entry is not + # regarded as a valid location. # if {[dict get $d port] != 0} { + # + # Add configured locations (deprecated, since this + # conflicts with the concept of virtual servers). + # 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 + if {$location ne "" && $location ni $locations} { + lappend locations $location } - append location :[dict get $d port] - if {$location ni $locations} {lappend locations $location} - } - } - if {[ns_conn isconnected]} { - # - # Is the current connection secure? - # - set secure_conn_p [expr {[security::secure_conn_p] || [ad_conn behind_secure_proxy_p]}] - - 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 + set hosts [dict get $d host] + if {[acs::icanuse "ns_set values"]} { + set virtualservers \ + [ns_configsection ns/module/[dict get $d driver]/servers] + if {$virtualservers ne ""} { + lappend hosts {*}[ns_set values $virtualservers] + } } + foreach entry $hosts { + # + # The value of the "DRIVER/servers" section might + # contain also a port. + # + set d1 [dict merge $d [ns_parsehostport $entry]] + set proto [dict get $d proto] + set host [dict get $d1 host] + set port [dict get $d1 port] + if {$host in {0.0.0.0 ::}} { + # + # Don't add INADDR_ANY to locations + # + continue + } + # + # Add always a variant with the omitted default port. + # + if {($proto eq "https" && $port eq "443") + || ($proto eq "http" && $port eq "80") + } { + set location [util::join_location -proto $proto -hostname $host] + if {$location ni $locations} { + lappend locations $location + } + } + # + # Add a variant with the omitted port to + # portless_locations. + # + set location [util::join_location -proto $proto -hostname $host] + if {$location ni $portless_locations + && $location ni $locations + } { + lappend portless_locations $location + } + # + # Add always a variant with the port to locations. + # + set location [util::join_location -proto $proto -hostname $host -port $port] + if {$location ni $locations} { + lappend locations $location + } + } } - } else { - set secure_conn_p 0 } # - # 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 {$suppress_http_port} { - lappend locations {*}$portless_locations - } - - - # # 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}] + set host_node_map_hosts_list \ + [db_list get_node_host_names {select host from host_node_map}] if { [llength $host_node_map_hosts_list] > 0 } { - if { $suppress_http_port } { + if { $suppress_http_port_p } { foreach hostname $host_node_map_hosts_list { lappend locations "http://${hostname}" if {$secure_conn_p} { @@ -2286,6 +2914,103 @@ } } } + + if {$suppress_http_port_p} { + lappend locations {*}$portless_locations + } + + return $locations +} + +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. + + The term location refers to protocol://domain:port for + website. + + @return insecure location and secure location followed possibly by alternate location(s) as a list. + +} { + # + # Is the current connection secure? + # + set secure_conn_p [expr {[ns_conn isconnected] + ? ([security::secure_conn_p] || [ad_conn behind_secure_proxy_p]) + : 0}] + # + # 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_p [parameter::get -parameter SuppressHttpPort \ + -boolean \ + -package_id [apm_package_id_from_key acs-tcl] \ + -default 0] + # + # Get Information from configured servers + # + set locations [acs::misc_cache eval security-configure-locations-$suppress_http_port_p-$secure_conn_p { + set locations [security::configured_locations -suppress_http_port=$suppress_http_port_p -secure_conn=$secure_conn_p] + # + # The configured values values do not change at runtime. Set + # it also once in the nsv array when setting the cache value. + # + foreach location $locations { + nsv_set validated_location $location 1 + } + set locations + }] + + # + # Add the previously validated locations + # + foreach location [nsv_array names validated_location] { + if {$location ni $locations} { + lappend locations $location + } + } + + + # + # When we are connected, add the current location if is not there + # already, also potentially in a secure fashion. + # + # This is probably not needed, but is kept here for backwards + # compatibility. For the time being, add log statements when this + # happens. + # + if {[ns_conn isconnected]} { + + set current_location [util_current_location] + if {$current_location ni $locations} { + ns_log notice "security::locations add connected location <$current_location>" + lappend locations $current_location + nsv_set validated_location $current_location 1 + } + + # + # 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] + if {$secure_current_location ni $locations} { + ns_log notice "security::locations add connected secure location <$secure_current_location>" + lappend locations $secure_current_location + nsv_set validated_location $secure_current_location 1 + } + } + } + #ns_log notice "security::locations <$locations>" return $locations } @@ -2296,21 +3021,76 @@ @param host host from host header field. } { # - # The global variable takes care of outputting error message only + # The per-request cache takes care of outputting error message only # once per request. # - set key ::__security_provided_host_validated($host) - if {![info exists $key]} { - set $key 1 + return [acs::per_request_cache eval -key acs-tcl.security_provided_host_validated-$host { + set result 1 if {$host ne ""} { if {![regexp {^[\w.:@+/=$%!*~\[\]-]+$} $host]} { + # + # Don't use "ad_log", since this might leed to a recursive loop. + # binary scan [encoding convertto utf-8 $host] H* hex - ad_log warning "provided host <$host> (hex $hex) contains invalid characters" - set $key 0 + ns_log warning "provided host <$host> (hex $hex) contains invalid characters\n\ + URL: [ns_conn url]\npeer addr:[ad_conn peeraddr]" + set result 0 } } + set result + }] +} + +ad_proc security::secure_hostname_p {host} { + + Check, if the content of host is a "secure" value, which means, it + is either white-listed or belongs to a non-public IP address, + such it cannot harm in redirect operations. + + @return boolean value +} { + # + # If the host has an non-public IP address (such as + # e.g. "localhost") it is regarded as "secure". The first test is + # the most simple case, working for all versions of NaviServer or + # AOLserver. + # + if {$host in {localhost 127.0.0.1 ::1}} { + return 1 } - return [set $key] + + set validationOk 0 + if {[acs::icanuse "ns_ip"]} { + # + # Check, if the address is not public. It resolves the + # $hostName and checks the properties of the first IP address + # returned. + # + set validationOk [expr {![ns_ip public [ns_addrbyhost $host]]}] + + } elseif {[acs::icanuse "ns_subnetmatch"]} { + # + # Test for older versions of NaviServer testing if value is an + # IP address belonging to a "private network". + # + try { + ns_subnetmatch 0.0.0.0/0 $host + } on error {errorMsg} { + set ip_address_p 0 + } on ok {ip_address_p} { + } + if {$ip_address_p} { + if {[ns_subnetmatch 10.0.0.0/8 $host] + || [ns_subnetmatch 172.16.0.0/12 $host] + || [ns_subnetmatch 192.168.0.0/16 $host] + || [ns_subnetmatch fd00::/8 $host] + } { + return 1 + } + } + } + + return 0 } ad_proc -public security::validated_host_header {} { @@ -2321,85 +3101,67 @@ 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) + or to unintended redirects to different sites. + + The validated host header most be syntactically correct, and it + must be either configured/white-listed or it must be from a + non-routable IP address. White-listed hosts are taken from the + alternate host names specified in the "ns/module/DRIVER/servers" + section, or via the configuration variable "hostname" (e.g., + "openacs.org www.openacs.org") which is added the the "/server" + section during startup. + } { # # Check, if we have a host header field # - set host [ns_set iget [ns_conn headers] Host] - if {$host eq ""} { + set hostHeaderValue [ns_set iget [ns_conn headers] Host] + if {$hostHeaderValue eq ""} { return "" } + # + # Domain names are case insensitive. So convert it to lower to + # avoid surprises. + # + set hostHeaderValue [string tolower $hostHeaderValue] # # Check, if we have validated it before, or it belongs to the # predefined accepted host header fields. # - set key ::acs::validated($host) + set key ::acs::validated_host_header($hostHeaderValue) if {[info exists $key]} { - return $host + return $hostHeaderValue } - if {![string match *//* $host]} { - set splithost [ns_conn protocol]://$host - } else { - set splithost $host - } - if {![util::split_location $splithost .proto hostName hostPort]} { - return "" - } - + set hostHeaderDict [ns_parsehostport $hostHeaderValue] # # 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 .] + set hostName [string trimright [dict get $hostHeaderDict host] .] + set hostPort [expr {[dict exists $hostHeaderDict port] ? [dict get $hostHeaderDict port] : ""}] - # - # Check, if the provided host is the same as the configured 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 - } + set normalizedHostHeaderValue [util::join_location -host $hostName -port $hostPort] + set validationOk 0 # - # 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). + # Check if the value in "hostName" can be regarded as safe. # - if {[util::split_location [ns_conn location] proto locationHost locationPort]} { - if {$hostName eq $locationHost} { + # The host header value is one of the names registered for + # this server. + # + if {[acs::icanuse "ns_server hosts"]} { + if {$normalizedHostHeaderValue in [ns_server hosts]} { # - # port is currently ignored # - set $key 1 - return $host + set validationOk 1 } - } - - # - # 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. - # - if {[ns_info name] eq "NaviServer"} { + } elseif {[ns_info name] eq "NaviServer"} { + # + # As a replacement for "ns_server hosts" check against the + # virtual server configuration of NaviServer. + # set s [ns_info server] set driverInfo [security::configured_driver_info] set drivers [lmap d $driverInfo {dict get $d driver}] @@ -2417,60 +3179,118 @@ 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 + if {$normalizedHostHeaderValue in $names} { + ns_log notice "security::validated_host_header: found $hostHeaderValue" \ + "in global virtual server configuration for $driver" + return 1 } } } } - # - # Check against host node map. Here we need as well protection - # against invalid utf-8 characters. - # - if {![security::provided_host_valid $hostName]} { - return "" + if {$validationOk == 0} { + set validationOk [security::secure_hostname_p $hostName] } - set result [db_list host_header_field_mapped {select 1 from host_node_map where host = :hostName}] - #ns_log notice "security::validated_host_header: checking entry <$hostName> from host_node_map -> $result" - if {$result == 1} { + if {$validationOk == 0} { # - # port is ignored + # Check against the white-listed hosts from # - set $key 1 - #ns_log notice "security::validated_host_header: checking entry <$hostName> from host_node_map return host <$host>" - return $host + # ns_section ns/server/$server/acs { + # ns_param whitelistedHosts {...} + # } + # + # of the configuration file. + # + if {$hostHeaderValue in [ns_config "ns/server/[ns_info server]/acs" whitelistedHosts {}]} { + set validationOk 1 + } } - # - # Handle aliases for locations, which cannot be determined from - # config files, but which are supposed to be ok. - # - if {$hostName eq "localhost"} { + if {$validationOk == 0} { # - # This is not an attempt, where someone tries to lure us to a - # different host via redirect. + # Check against host node map. Here we need as well protection + # against invalid utf-8 characters. # - set $key 1 - return $host + if {![security::provided_host_valid $hostName]} { + return "" + } + + set validationOk [db_0or1row host_header_field_mapped { + select 1 from host_node_map where host = :hostName + }] } + if {$validationOk == 0} { + # + # Validation is OK, when the hostName is either the same as + # configured hostname. This is a legacy branch for very old + # versions of NaviServer or AOLserver. + # + set driverInfo [util_driver_info] + set driverHostName [dict get $driverInfo hostname] + if {$hostName eq $driverHostName} { + set validationOk 1 + } + } + if {$validationOk == 0 && [info exists driverHostName]} { + # + # Validation is OK, when the hostName is one of the IP + # addresses of the configured host name. + # + try { + ns_addrbyhost -all $driverHostName + } on error {errorMsg} { + # + # Name resolution of the hostname configured for this + # driver failed, we cannot validate incoming IP addresses. + # + ns_log error "security::validated_host_header: configuration error:" \ + "name resolution for configured hostname '$driverHostName'" \ + "of driver '[ad_conn driver]' failed" + } on ok {result} { + set validationOk [expr {$hostName in $result}] + } + } + # - # 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). + # 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). This is also a legacy case. # - #ns_set array [ns_configsection ns/module/nssock/servers] + if {$validationOk == 0 + && [util::split_location [ns_conn location] proto locationHost locationPort]} { + set validationOk [expr {$hostName eq $locationHost}] + } # + # Check, if the provided host is the same as in the configured + # SystemURL. Legacy case. + # + if {$validationOk == 0 && [util::split_location [ad_url] .proto systemHost systemPort]} { + set validationOk [expr {$hostName eq $systemHost + && ($hostPort eq $systemPort || $hostPort eq "") }] + } + + + # + # When any of the validation attempts above were successful, we + # are done. We keep the logic for successful lookups + # centralized. Performance of the individual tests are not + # critical, since the lookups are cache per thread. + # + if {$validationOk} { + set $key 1 + return $hostHeaderValue + } + + + # # Now we give up # - ns_log warning "ignore untrusted host header field: '$host'" + ns_log warning "ignore untrusted host header field: '$hostHeaderValue'." \ + "Consider adding this value to 'whitelistedHosts' in the" \ + "section 'ns/server/\$server/acs' of your configuration file" return "" } @@ -2514,9 +3334,9 @@ # set session_id [ad_conn peeraddr] } - set secret [ns_config "ns/server/[ns_info server]/acs" parametersecret ""] + set secret [ns_config "ns/server/[ns_info server]/acs" parameterSecret ""] - if {[info commands ::crypto::hmac] ne ""} { + if {[namespace which ::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]"] @@ -2544,9 +3364,9 @@ 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]} { + ns_log notice "CSP: forcing $directive $value" lappend $var $value } } @@ -2571,14 +3391,15 @@ # security::csp::require default-src 'self' security::csp::require script-src 'self' + #security::csp::require script-src 'strict-dynamic' security::csp::require style-src 'self' security::csp::require img-src 'self' security::csp::require font-src 'self' security::csp::require base-uri 'self' - + security::csp::require connect-src 'self' # # Some browser (safari, chrome) need "font-src data:", maybe - # for plugins or diffent font settings. Seems safe enough. + # for plugins or different font settings. Seems safe enough. # security::csp::require font-src data: @@ -2596,7 +3417,7 @@ # 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 + # 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. # @@ -2613,34 +3434,45 @@ 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". + # Use newer "report-to" will be preferred and "report-uri" + # deprecated. As of May 2020: no support for "report-to" for + # FF (75, or forthcoming 66 and 77) or Safari. + # https://caniuse.com/#search=report-to # security::csp::require report-uri /SYSTEM/csp-collector.tcl + #ns_set [ns_conn outputheaders] Report-To "{'url':'/SYSTEM/csp-collector.tcl','group':'csp-endpoint','max-age':10886400}" + #security::csp::require report-to csp-endpoint # # We do not need object-src # security::csp::require object-src 'none' + security::csp::require form-action 'self' + security::csp::require frame-ancestors 'self' + + #security::csp::require require-trusted-types-for 'script' + set policy "" foreach directive { + base-uri child-src connect-src default-src font-src form-action - frame-src frame-ancestors + frame-src img-src media-src object-src plugin-types report-uri + require-trusted-types-for sandbox script-src style-src - base-uri + trusted-types } { set var ::__csp__directive($directive) if {[info exists $var]} { @@ -2650,8 +3482,67 @@ return $policy } + ad_proc -public ::security::csp::add_static_resource_header { + {-mime_type:required} + } { + + Set the CSP rule on the current connection for a static + resource depending on the MIME type. + + @param mime_type MIME type of the resource to be delivered + } { + if {![ns_conn isconnected]} { + error "Content-Security-Policy headers can be only set for active connections" + } + if {[dict exists $::security::csp::static_csp $mime_type]} { + ns_set iupdate [ns_conn outputheaders] \ + "Content-Security-Policy" [dict get $::security::csp::static_csp $mime_type] + ns_log notice "STATIC $mime_type: Content-Security-Policy [dict get $::security::csp::static_csp $mime_type]" + } else { + #ns_log notice "STATIC $mime_type: no Content-Security-Policy defined for this MIME type" + } + } } +namespace eval ::security::parameter { + + ad_proc -public signed {{-max_age ""} value} { + + Compute a compact single-token signed value based on the + parameterSecret. + + @see ::security::parameter::validated + } { + set token_id [sec_get_random_cached_token_id] + set secret [ns_config "ns/server/[ns_info server]/acs" parameterSecret ""] + set signature [ad_sign -max_age $max_age -secret $secret -token_id $token_id $value] + return [ns_base64urlencode [list $value $signature]] + } + + ad_proc -public validated {input} { + + Validate the single-token signed value and return its content value. + Raise an exception, when the signature is broken. + + @see ::security::parameter::signed + + } { + set success 0 + set pair [ns_base64urldecode $input] + if {[string is list -strict $pair] && [llength $pair] == 2} { + lassign $pair value signature + set secret [ns_config "ns/server/[ns_info server]/acs" parameterSecret ""] + set success [ad_verify_signature -secret $secret $value $signature] + } + if {$success} { + return $value + } else { + ad_raise invalid_signature + } + } +} + + #TODO remove me: just for a transition phase proc ::security::nonce_token args {uplevel ::security::csp::nonce {*}$args} @@ -2666,21 +3557,27 @@ # security::csrf::new # security::csrf::validate - ad_proc -public ::security::csrf::new {{-tokenname __csrf_token} -user_id} { + 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 + per-thread variable and 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. - +

The optional argument user_id is currently ignored, but it is there, since there are algorithms published to calculate the - CSRF token based on an user_id. So far, i found no evidence + CSRF token based on a user_id. So far, i found no evidence that these should be used, but the argument is there as a reminder, such the interface does not have to be used, when we switch to such an algorithm. @@ -2701,10 +3598,13 @@ # # validate # - ad_proc -public ::security::csrf::validate {{-tokenname __csrf_token} {-allowempty false}} { + ad_proc -public ::security::csrf::validate { + {-tokenname __csrf_token} + {-allowempty false} + } { - Validate a CSRF token and call security::csrf::fail the request if - invalid. + Validate a CSRF token and call security::csrf::fail the + request if invalid. @return nothing } { @@ -2721,7 +3621,7 @@ set oldToken [ns_queryget $tokenname] if {$oldToken eq ""} { # - # There is not token in the query/form parameters, we + # There is no token in the query/form parameters, we # can't validate, since there is no token. # if {$allowempty} { @@ -2757,7 +3657,7 @@ set session_id [ad_conn peeraddr] } else { # - # User is logged in, use a session token. + # User is logged-in, use a session token. # set session_id [ad_conn session_id] } @@ -2767,7 +3667,9 @@ # # Generate CSRF token # - ad_proc -private ::security::csrf::token { {-tokenname __csrf_token} } { + ad_proc -private ::security::csrf::token { + {-tokenname __csrf_token} + } { Generate a CSRF token and return it @@ -2783,8 +3685,8 @@ 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 secret [ns_config "ns/server/[ns_info server]/acs" parameterSecret ""] + if {[namespace which ::crypto::hmac] ne ""} { set token [::crypto::hmac string $secret [session_id]] } else { set token [ns_sha1 $secret-[session_id]] @@ -2814,6 +3716,7 @@ } } +nsv_set validated_location http://localhost 1 # # Local variables: # mode: tcl