-
+
Don Baccus
Routines and data models providing the foundation for OpenACS-based Web services.
2003-02-18
OpenACS
-
+
@@ -43,7 +42,8 @@
-
+
+
@@ -62,10 +62,11 @@
-
-
-
+
+
+
+
Index: openacs-4/packages/acs-kernel/sql/oracle/community-core-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/oracle/community-core-create.sql,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-kernel/sql/oracle/community-core-create.sql 28 Aug 2003 09:41:38 -0000 1.8
+++ openacs-4/packages/acs-kernel/sql/oracle/community-core-create.sql 18 Sep 2003 17:11:36 -0000 1.9
@@ -539,6 +539,8 @@
password_question varchar2(1000),
password_answer varchar2(1000),
password_changed_date date,
+ -- used for the authentication cookie
+ auth_token varchar2(100),
-- table constraints
constraint users_authority_username_un
unique (authority_id, username)
Index: openacs-4/packages/acs-kernel/sql/oracle/upgrade/upgrade-5.0d6-5.0d7.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/oracle/upgrade/upgrade-5.0d6-5.0d7.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-kernel/sql/oracle/upgrade/upgrade-5.0d6-5.0d7.sql 18 Sep 2003 17:11:36 -0000 1.1
@@ -0,0 +1,12 @@
+--
+-- Upgrade script from 5.0d6 to 5.0d7
+--
+-- Adds auth_token to users table
+--
+-- @author Lars Pind (lars@collaboraid.biz)
+--
+-- @cvs-id $Id: upgrade-5.0d6-5.0d7.sql,v 1.1 2003/09/18 17:11:36 lars Exp $
+--
+
+alter table users add (auth_token varchar2(100));
+
Index: openacs-4/packages/acs-kernel/sql/postgresql/community-core-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/postgresql/community-core-create.sql,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/acs-kernel/sql/postgresql/community-core-create.sql 28 Aug 2003 09:41:38 -0000 1.15
+++ openacs-4/packages/acs-kernel/sql/postgresql/community-core-create.sql 18 Sep 2003 17:11:37 -0000 1.16
@@ -517,6 +517,8 @@
password_question varchar(1000),
password_answer varchar(1000),
password_changed_date timestamptz,
+ -- used for the authentication cookie
+ auth_token varchar(100),
-- table constraints
constraint users_authority_username_un
unique (authority_id, username)
Index: openacs-4/packages/acs-kernel/sql/postgresql/upgrade/upgrade-5.0d6-5.0d7.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/postgresql/upgrade/upgrade-5.0d6-5.0d7.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-kernel/sql/postgresql/upgrade/upgrade-5.0d6-5.0d7.sql 18 Sep 2003 17:11:37 -0000 1.1
@@ -0,0 +1,11 @@
+--
+-- Upgrade script from 5.0d6 to 5.0d7
+--
+-- Adds auth_token to users table
+--
+-- @author Lars Pind (lars@collaboraid.biz)
+--
+-- @cvs-id $Id: upgrade-5.0d6-5.0d7.sql,v 1.1 2003/09/18 17:11:37 lars Exp $
+--
+
+alter table users add auth_token varchar(100);
Index: openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl,v
diff -u -r1.29 -r1.30
--- openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 12 Sep 2003 12:34:55 -0000 1.29
+++ openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 18 Sep 2003 17:08:38 -0000 1.30
@@ -557,6 +557,20 @@
-privilege "admin"]
}
+
+ad_proc -public acs_user::ScreenName {} {
+ Get the value of the ScreenName parameter. Checked to ensure that it only returns none, solicit, or require.
+} {
+ set value [parameter::get -parameter ScreenName -package_id [ad_acs_kernel_id] -default "solicit"]
+ if { [lsearch { none solicit require } $value] == -1 } {
+ ns_log Error "acs-kernel.ScreenName parameter invalid. Set to '$value', should be one of none, solicit, or require."
+ return "solicit"
+ } else {
+ return $value
+ }
+
+}
+
ad_proc -public party::update {
{-party_id:required}
{-email}
Index: openacs-4/packages/acs-tcl/tcl/defs-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/defs-procs.tcl,v
diff -u -r1.29 -r1.30
--- openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 18 Sep 2003 13:44:30 -0000 1.29
+++ openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 18 Sep 2003 17:08:39 -0000 1.30
@@ -141,6 +141,7 @@
{-user_id:required}
} {
@return the url for the community member page of a particular user
+ @see acs_community_member_url
} {
return "[subsite::get_element -element url -notrailing][ad_parameter \
-package_id [ad_acs_kernel_id] CommunityMemberURL]?[export_vars user_id]"
@@ -151,6 +152,7 @@
{-label ""}
} {
@return the link of the community member page of a particular user
+ @see acs_community_member_url
} {
if {[empty_string_p $label]} {
set label [db_string select_community_member_link_label {
Index: openacs-4/packages/acs-tcl/tcl/security-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-init.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/security-init.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/security-init.tcl 18 Sep 2003 17:08:39 -0000 1.2
@@ -34,3 +34,8 @@
proc sec_session_renew {} "
return \"[expr [sec_session_timeout] - [ad_parameter -package_id [ad_acs_kernel_id] SessionRenew security 300]]\"
"
+
+proc sec_login_timeout {} "
+ return \"[ad_parameter -package_id [ad_acs_kernel_id] LoginTimeout security 28800]\"
+"
+
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.22 -r1.23
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl 18 Sep 2003 13:44:30 -0000 1.22
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl 18 Sep 2003 17:08:39 -0000 1.23
@@ -14,14 +14,20 @@
# cookies (all are signed cookies):
# cookie value max-age secure
-# ad_session_id session_id,user_id SessionTimeout no
-# ad_user_login user_id, never expires no
+# ad_session_id session_id,user_id,login_level SessionTimeout no
+# 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,user_id,random SessionLifetime yes
#
# the random data is used to hinder attack the secure hash.
# currently the random data is ns_time
+#
+# ad_user_login issue_time: [ns_time] at the time the user last authenticated
+#
+# ad_session_id login_level: 0 = none/expired, 1 = ok, 2 = auth ok, but account closed
+#
+
ad_proc -private sec_random_token {} {
Generates a random token.
} {
@@ -62,7 +68,7 @@
db_dml sessions_sweep {}
}
-proc_doc sec_handler {} {
+ad_proc -private sec_handler {} {
Reads the security cookies, setting fields in ad_conn accordingly.
@@ -72,136 +78,209 @@
if { [catch {
set cookie_list [ad_get_signed_cookie_with_expr "ad_session_id"]
} errmsg ] } {
-
- # ns_log notice "OACS= sec_handler:ad_get_signed_cookie failed $errmsg"
-
- # cookie is invalid because either:
+ # Cookie is invalid because either:
# -> it was never set
# -> it failed the cryptographic check
# -> it expired.
- set new_user_id 0
- # check for permanent login cookie
- if { ![security::secure_conn_p] } {
- catch {
- set new_user_id [ad_get_signed_cookie "ad_user_login"]
- }
- # ns_log notice "OACS= sec_handler:http, ad_user_login cookie user_id $new_user_id"
- } else {
- catch {
- set new_user_id [lindex [split [ad_get_signed_cookie "ad_user_login_secure"] {,}] 0]
- }
- # ns_log notice "OACS= sec_handler:https, ad_user_login_secure cookie user_id $new_user_id"
- }
- # ns_log Notice "OACS= sec_handler:setting up session"
- sec_setup_session $new_user_id
- # ns_log Notice "OACS= sec_handler:done setting up session"
+ # Now check for login cookie
+ sec_login_handler
} else {
- # The session already exists and is valid.
+ # The session cookie already exists and is valid.
set cookie_data [split [lindex $cookie_list 0] {,}]
set session_expr [lindex $cookie_list 1]
set session_id [lindex $cookie_data 0]
- set user_id [lindex $cookie_data 1]
+ set untrusted_user_id [lindex $cookie_data 1]
+ set login_level [lindex $cookie_data 2]
+ set user_id 0
+ set account_status closed
+
+ switch $login_level {
+ 1 {
+ set auth_level ok
+ set user_id $untrusted_user_id
+ set account_status ok
+ }
+ 2 {
+ set auth_level ok
+ }
+ default {
+ if { $untrusted_user_id == 0 } {
+ set auth_level none
+ } else {
+ set auth_level expired
+ }
+ }
+ }
- # ns_log notice "OACS= sec_handler:sess exists & is valid"
- # ns_log notice "OACS= sec_handler:cookie: $cookie_list, exp: $session_expr"
- # ns_log notice "OACS= sec_handler:sess_id: $session_id, user_id: $user_id"
+ 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"
- # If it's a secure page and not a login page, we check
- # secure token (can't check login page because they aren't
- # issued their secure tokens until after they pass through)
- # It is important to note that the entire secure login
- # system depends on these two functions
- if { [security::secure_conn_p] && ![ad_login_page] } {
+ # We're okay, insofar as the insecure session, check if it's also secure
+ if { [string equal $auth_level "ok"] && [ad_secure_conn_p] } {
+ catch {
+ set sec_token [split [ad_get_signed_cookie "ad_secure_token"] {,}]
+ if { [string equal [lindex $sec_token 0] $session_id] } {
+ 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 notice "OACS= sec_handler:secure but not login page"
-
- if { [catch { set sec_token [split [ad_get_signed_cookie "ad_secure_token"] {,}] } errmsg] } {
- # token is incorrect or nonexistent, so we force relogin.
-
- # cro@ncacasi.org 2002-08-01
- # but wait--does user have an ad_user_login_secure cookie?
- # If so, just generate a secure token because he
- # can't have that cookie unless he had logged in securely
- # at some time in the past.
- # So just call sec_setup_session to generate a new token.
- # Otherwise, force a trip to [subsite]/register
- if { [catch {
- set new_user_id [lindex [split [ad_get_signed_cookie "ad_user_login_secure"] {,}] 0] }] } {
- # ns_log notice "OACS= sec_handler:token invalid $errmsg"
-
-
- ad_returnredirect "[subsite::get_element \
- -element url]register/index?return_url=[ns_urlencode [ad_conn url]?[ad_conn query]]"
- return filter_break
- } else {
- sec_setup_session $new_user_id
- }
- } else {
- # need to check only one of the user_id and session_id
- # if the cookie had been tampered.
-# ns_log notice "OACS= sec_handler:token ok, $sec_token $session_id"
- if { ![string match [lindex $sec_token 0] $session_id] } {
- ad_returnredirect "/register/index?return_url=[ns_urlencode [ad_conn url]?[ad_conn query]]"
- return filter_break
- }
- }
- }
-
+ # Setup ad_conn
ad_conn -set session_id $session_id
- ad_conn -set user_id $user_id
+ ad_conn -set untrusted_user_id $untrusted_user_id
+ ad_conn -set user_id $user_id
+ ad_conn -set auth_level $auth_level
+ ad_conn -set account_status $account_status
+
# reissue session cookie so session doesn't expire if the
# renewal period has passed. this is a little tricky because
# the cookie doesn't know about sec_session_renew; it only
# knows about sec_session_timeout.
# [sec_session_renew] = SessionTimeout - SessionRenew (see security-init.tcl)
# $session_expr = PreviousSessionIssue + SessionTimeout
if { $session_expr - [sec_session_renew] < [ns_time] } {
- sec_generate_session_id_cookie
+
+ # LARS: We use sec_login_handler here instead, so that we check the authentication status again
+ # This prevents people from being logged in indefinitely just because they keep the session open
+ #sec_generate_session_id_cookie
+ sec_login_handler
}
}
}
+ad_proc -private sec_login_handler {} {
+
+ Reads the login cookie, setting fields in ad_conn accordingly.
+
+} {
+ set auth_level none
+ set new_user_id 0
+ set untrusted_user_id 0
+ set account_status closed
+
+ # check for permanent login cookie
+ catch {
+ # If over HTTPS, we look for a secure cookie, otherwise we look for the normal one
+ set login_list [list]
+ if { [ad_secure_conn_p] } {
+ catch {
+ set login_list [split [ad_get_signed_cookie "ad_user_login_secure"] ","]
+ }
+ }
+ if { [empty_string_p $login_list] } {
+ set login_list [split [ad_get_signed_cookie "ad_user_login"] ","]
+ }
+
+ set untrusted_user_id [lindex $login_list 0]
+ set login_expr [lindex $login_list 1]
+ set auth_token [lindex $login_list 2]
+
+ set auth_level expired
+ set account_status closed
+
+ # Check authentication cookie
+ # First, check expiration
+ if { [sec_login_timeout] == 0 || [ns_time] - $login_expr < [sec_login_timeout] } {
+ # Then check auth_token
+ if { [string equal $auth_token [sec_get_user_auth_token $untrusted_user_id]] } {
+ # Are we secure?
+ if { [ad_secure_conn_p] } {
+ # We retrieved the secure login cookie over HTTPS, we're secure
+ set auth_level secure
+ } else {
+ set auth_level ok
+ }
+ }
+ }
+
+ # Check account status
+ if { [auth::local_account_ok_p -user_id $untrusted_user_id] } {
+ set account_status ok
+ }
+ }
+
+ sec_setup_session $untrusted_user_id $auth_level $account_status
+}
+
+
ad_proc -public ad_user_login {
+ {-account_status "ok"}
-forever:boolean
user_id
} {
-
Logs the user in, forever (via the user_login cookie) if -forever
is true. This procedure assumes that the user identity has been
validated.
-
} {
set prev_user_id [ad_conn user_id]
-
+
# deal with the permanent login cookies (ad_user_login and ad_user_login_secure)
if { $forever_p } {
- # permanent login
- if { [security::secure_conn_p] } {
- ad_set_signed_cookie -max_age inf -secure t ad_user_login_secure "$user_id,[ns_time]"
- ad_set_signed_cookie -max_age inf -secure f ad_user_login "$user_id"
- } else {
- ad_set_signed_cookie -max_age inf -secure f ad_user_login "$user_id"
- # Hose the secure permanent login token if this user is different
- # from the previous one.
- if { $prev_user_id != $user_id } {
- ad_set_cookie -max_age 0 ad_user_login_secure ""
- }
- }
- } elseif { $prev_user_id == $user_id && [security::secure_conn_p] } {
- # nonpermanent secure login requested
- ad_set_cookie -max_age 0 ad_user_login_secure ""
+ set max_age inf
} else {
- ad_set_cookie -max_age 0 ad_user_login ""
- ad_set_cookie -max_age 0 ad_user_login_secure ""
+ set max_age [sec_login_timeout]
}
+ set auth_level "ok"
+
+ # If you're logged in over a secure connection, you're secure
+ if { [ad_secure_conn_p] } {
+ ad_set_signed_cookie \
+ -max_age $max_age \
+ -secure t \
+ ad_user_login_secure \
+ "$user_id,[ns_time],[sec_get_user_auth_token $user_id],[ns_time]"
+
+ # 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_set_cookie -max_age 0 ad_user_login_secure ""
+ }
+
+ ad_set_signed_cookie \
+ -max_age $max_age \
+ -secure f \
+ ad_user_login \
+ "$user_id,[ns_time],[sec_get_user_auth_token $user_id]"
+
# deal with the current session
- sec_setup_session $user_id
+ sec_setup_session $user_id $auth_level $account_status
}
+ad_proc -public sec_get_user_auth_token {
+ user_id
+} {
+ Get the user's auth token for verifying login cookies.
+} {
+ set auth_token [db_string select_auth_token {
+ select auth_token from users where user_id = :user_id
+ } -default {}]
+
+ if { [empty_string_p $auth_token] } {
+ set auth_token [sec_change_user_auth_token $user_id]
+ }
+
+ return $auth_token
+}
+
+ad_proc -public sec_change_user_auth_token {
+ user_id
+} {
+ Change the user's auth_token, which invalidates all existing login cookies.
+} {
+ set auth_token [ad_generate_random_string]
+ db_dml update_auth_token {
+ update users set auth_token = :auth_token where user_id = :user_id
+ }
+ return $auth_token
+}
+
+
ad_proc -public ad_user_logout {} {
Logs the user out.
} {
@@ -251,6 +330,8 @@
ad_proc -private sec_setup_session {
new_user_id
+ auth_level
+ account_status
} {
Set up the session, generating a new one if necessary,
@@ -277,7 +358,7 @@
}
} else {
# $session_id is an active verified session
- # this call to sec_setup_session is either a user logging in
+ # 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
@@ -298,17 +379,27 @@
}
}
- # su, set the session_id global var, and then generate the cookie
- ad_conn -set user_id $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 { ([string equal $auth_level "ok"] || [string equal $auth_level "secure"]) && [string equal $account_status "ok"] } {
+ set user_id $new_user_id
+ }
+
+ # Set ad_conn variables
+ ad_conn -set untrusted_user_id $new_user_id
ad_conn -set session_id $session_id
-
+ ad_conn -set auth_level $auth_level
+ ad_conn -set account_status $account_status
+ ad_conn -set user_id $user_id
+
# ns_log Notice "OACS= about to generate session id cookie"
sec_generate_session_id_cookie
# ns_log Notice "OACS= done generating session id cookie"
- if { [security::secure_conn_p] && $new_user_id != 0 } {
+ if { [string equal $auth_level "secure"] && [ad_secure_conn_p] && $new_user_id != 0 } {
# this is a secure session, so the browser needs
# a cookie marking it as such
sec_generate_secure_token_cookie
@@ -331,227 +422,89 @@
}
}
-ad_proc -private sec_lookup_property {
- id
- module
- name
-} {
-
- Used as a helper procedure for util_memoize to look up a
- particular property from the database. Returns
- [list $property_value $secure_p].
-
+ad_proc -private sec_generate_session_id_cookie {} {
+ Sets the ad_session_id cookie based on global variables.
} {
- if {
- ![db_0or1row property_lookup_sec {
- select property_value, secure_p
- from sec_session_properties
- where session_id = :id
- and module = :module
- and property_name = :name
- }]
- } {
- return ""
- }
-
- set new_last_hit [clock seconds]
-
- db_dml update_last_hit_dml {
- update sec_session_properties
- set last_hit = :new_last_hit
- where session_id = :id and
- property_name = :name
- }
-
- return [list $property_value $secure_p]
-}
-
-ad_proc -public ad_get_client_property {
- {-cache t}
- {-cache_only f}
- {-default ""}
- {-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
- 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.
-
- @param session_id controls which session is used
-
-} {
- if { [empty_string_p $session_id] } {
- set id [ad_conn session_id]
- } else {
- set id $session_id
- }
-
- set cmd [list sec_lookup_property $id $module $name]
-
- if { $cache_only == "t" && ![util_memoize_cached_p $cmd] } {
- return ""
- }
-
- if { $cache != "t" } {
- util_memoize_flush $cmd
- }
-
- set property [util_memoize $cmd [sec_session_timeout]]
- if { $property == "" } {
- return $default
- }
- set value [lindex $property 0]
- set secure_p [lindex $property 1]
+ set user_id [ad_conn untrusted_user_id]
+ set session_id [ad_conn session_id]
+ set auth_level [ad_conn auth_level]
+ set account_status [ad_conn account_status]
- if { $secure_p != "f" && ![security::secure_conn_p] } {
- return ""
+ set login_level 0
+ if { [string equal $auth_level "ok"] || [string equal $auth_level "secure"] } {
+ if { [string equal $account_status "ok"] } {
+ set login_level 1
+ } else {
+ set login_level 2
+ }
}
- return $value
+ ns_log Debug "Security: [ns_time] sec_generate_session_id_cookie setting session_id=$session_id, user_id=$user_id, login_level=$login_level"
+ ad_set_signed_cookie -replace t -max_age [sec_session_timeout] \
+ "ad_session_id" "$session_id,$user_id,$login_level"
}
-ad_proc -public ad_set_client_property {
- {-clob f}
- {-secure f}
- {-persistent t}
- {-session_id ""}
- module
- 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,
- 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
-
-} {
-
- if { $secure != "f" && ![security::secure_conn_p] } {
- error "Unable to set secure property in insecure or invalid session"
- }
-
- if { [empty_string_p $session_id] } {
- set session_id [ad_conn session_id]
- }
-
- if { $persistent == "t" } {
- # Write to database - either defer, or write immediately. First delete the old
- # value if any; then insert the new one.
-
- set last_hit [ns_time]
-
- db_transaction {
-
- # DRB: Older versions of this code did a delete/insert pair in an attempt
- # to guard against duplicate insertions. This didn't work if there was
- # no value for this property in the table and two transactions ran in
- # parallel. The problem is that without an existing row the delete had
- # nothing to lock on, thus allowing the two inserts to conflict. This
- # was discovered on a page built of frames, where the two requests from
- # the browser spawned two AOLserver threads to service them.
-
- # Oracle doesn't allow a RETURNING clause on an insert with a
- # subselect, so this code first inserts a dummy value if none exists
- # (ensuring it does exist afterwards) then updates it with the real
- # value. Ugh.
-
- set clob_update_dml [db_map prop_update_dml_clob]
-
- db_dml prop_insert_dml ""
-
- if { $clob == "t" && ![empty_string_p $clob_update_dml] } {
- db_dml prop_update_dml_clob "" -clobs [list $value]
- } else {
- db_dml prop_update_dml ""
- }
- }
- }
-
- # 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]
-}
-
ad_proc -private sec_generate_secure_token_cookie { } {
Sets the ad_secure_token cookie.
} {
ad_set_signed_cookie -secure t "ad_secure_token" "[ad_conn session_id],[ad_conn user_id],[ns_time]"
}
-ad_proc -private sec_generate_session_id_cookie {} {
- Sets the ad_session_id cookie based on global variables.
+ad_proc -public ad_secure_conn_p {} {
+ Returns true if the connection [ad_conn] is secure (HTTPS), or false otherwise.
} {
- set user_id [ad_conn user_id]
- set session_id [ad_conn session_id]
- ns_log Notice "Security: [ns_time] sec_generate_session_id_cookie setting $session_id, $user_id."
- ns_log Debug "Security: [ns_time] sec_generate_session_id_cookie setting $session_id, $user_id."
- ad_set_signed_cookie -replace t -max_age [sec_session_timeout] \
- "ad_session_id" "$session_id,$user_id"
+ return [string match "https:*" [util_current_location]]
}
-ad_proc -public -deprecated ad_get_user_id {} {
- Gets the user ID. 0 indicates the user is not logged in.
- Deprecated since user_id now provided via ad_conn user_id
+ad_proc -private sec_allocate_session {} {
- @see ad_conn
+ Returns a new session id
+
} {
- return [ad_conn user_id]
+
+ global tcl_max_value
+ global tcl_current_sequence_id
+
+ if { ![info exists tcl_max_value] || ![info exists tcl_current_sequence_id] || $tcl_current_sequence_id > $tcl_max_value } {
+ # Thread just spawned or we exceeded preallocated count.
+ set tcl_current_sequence_id [db_nextval sec_id_seq]
+ set tcl_max_value [expr $tcl_current_sequence_id + 100]
+ }
+
+ set session_id $tcl_current_sequence_id
+ incr tcl_current_sequence_id
+
+ return $session_id
}
-ad_proc -public -deprecated ad_verify_and_get_user_id {
- {-secure f}
+ad_proc -private ad_login_page {} {
+
+ Returns 1 if the page is used for logging in, 0 otherwise.
+
} {
- Returns the current user's ID. 0 indicates user is not logged in
- Deprecated since user_id now provided via ad_conn user_id
+ set url [ad_conn url]
+ if { [string match "*register/*" $url] || [string match "/index*" $url] || \
+ [string match "/index*" $url] || \
+ [string match "/" $url] || \
+ [string match "*password-update*" $url] } {
+ return 1
+ }
- @see ad_conn
-} {
- return [ad_conn user_id]
+ return 0
}
-ad_proc -public -deprecated ad_verify_and_get_session_id {
- {-secure f}
-} {
- Returns the current session's ID.
- Deprecated since session_id now provided via ad_conn session_id
- @param secure is ignored
- @see ad_conn
-} {
- return [ad_conn session_id]
-}
-# handling privacy
-ad_proc -public -deprecated ad_privacy_threshold {} {
- Pages that are consider whether to display a user's name or email
- address should test to make sure that a user's priv_ from the
- database is less than or equal to what ad_privacy_threshold returns.
-
- Now deprecated.
-} {
- set session_user_id [ad_get_user_id]
- if {$session_user_id == 0} {
- # viewer of this page isn't logged in, only show stuff
- # that is extremely unprivate
- set privacy_threshold 0
- } else {
- set privacy_threshold 5
- }
- return $privacy_threshold
-}
+#####
+#
+# Login/logout URLs, redirecting, etc.
+#
+#####
ad_proc -public ad_redirect_for_registration {} {
@@ -584,7 +537,7 @@
@author Lars Pind (lars@collaboraid.biz)
} {
if { [ad_conn isconnected] } {
- set url [site_node_closest_ancestor_package_url]
+ 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
@@ -632,8 +585,7 @@
@author Lars Pind (lars@collaboraid.biz)
} {
if { [ad_conn isconnected] } {
- set url [subsite::get_element -element url]
- } else {
+ # No reason to have logout URL be subsite-specified, it doesn't show any pages, anyway
set url /
}
@@ -646,25 +598,10 @@
return $url
}
-ad_proc -deprecated ad_maybe_redirect_for_registration {} {
-
- Checks to see if a user is logged in. If not, redirects to
- [subsite]/register/index to require the user to register.
- When registration is complete, the user will return to the current
- location. All variables in ns_getform (both posts and gets) will
- be maintained. Note that this will return out of its caller so that
- the caller need not explicitly call "return". Returns the user id
- if login was succesful.
-
- @see auth::require_login
-} {
- auth::require_login
-}
-
# JCD 20020915 I think this probably should not be deprecated since it is
# far more reliable than permissioning esp for a development server
-ad_proc -public -deprecated ad_restrict_entire_server_to_registered_users {
+ad_proc -public ad_restrict_entire_server_to_registered_users {
conn
args
why
@@ -684,389 +621,23 @@
return filter_ok
}
-proc_doc ad_generate_random_string {{length 8}} {
- Generates a random string made of numbers and letters
-} {
- return [string range [sec_random_token] 0 $length]
-}
-#
-# The filter below will block requests containing character sequences that
-# could be used to modify insecurely coded SQL queries in our Tcl scripts,
-# like " or 1=1" or "1 union select ...".
-#
-# Written by branimir@arsdigita.com and carsten@arsdigita.com on July 2, 2000.
-#
-# michael@arsdigita.com: A better name for this proc would be
-# "ad_block_sql_fragment_form_data", since "form data" is the
-# official term for query string (URL) variables and form input
-# variables.
-#
-ad_proc -public -deprecated ad_block_sql_urls {
- conn
- args
- why
-} {
- A filter that detect attempts to smuggle in SQL code through form data
- variables. The use of bind variables and ad_page_contract input
- validation to prevent SQL smuggling is preferred.
- @see ad_page_contract
-} {
- set form [ns_getform]
- if { [empty_string_p $form] } { return filter_ok }
- # Check each form data variable to see if it contains malicious
- # user input that we don't want to interpolate into our SQL
- # statements.
- #
- # We do this by scanning the variable for suspicious phrases; at
- # this time, the phrases we look for are: UNION, UNION ALL, and
- # OR.
- #
- # If one of these phrases is found, we construct a test SQL query
- # that incorporates the variable into its WHERE clause and ask
- # the database to parse it. If the query does parse successfully,
- # then we know that the suspicious user input would result in a
- # executing SQL that we didn't write, so we abort processing this
- # HTTP request.
- #
- set n_form_vars [ns_set size $form]
- for { set i 0 } { $i < $n_form_vars } { incr i } {
- set key [ns_set key $form $i]
- set value [ns_set value $form $i]
- # michael@arsdigita.com:
- #
- # Removed 4000-character length check, because that allowed
- # malicious users to smuggle SQL fragments greater than 4000
- # characters in length.
- #
- if {
- [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value] ||
- [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value]
- } {
- # Looks like the user has added "union [all] select" to
- # the variable, # or is trying to modify the WHERE clause
- # by adding "or ...".
- #
- # Let's see if Oracle would accept this variables as part
- # of a typical WHERE clause, either as string or integer.
- #
- # michael@arsdigita.com: Should we grab a handle once
- # outside of the loop?
- #
- set parse_result_integer [db_string sql_test_1 "select test_sql('select 1 from dual where 1=[DoubleApos $value]') from dual"]
- if { [string first "'" $value] != -1 } {
- #
- # The form variable contains at least one single
- # quote. This can be a problem in the case that
- # the programmer forgot to QQ the variable before
- # interpolation into SQL, because the variable
- # could contain a single quote to terminate the
- # criterion and then smuggled SQL after that, e.g.:
- #
- # set foo "' or 'a' = 'a"
- #
- # db_dml "delete from bar where foo = '$foo'"
- #
- # which would be processed as:
- #
- # delete from bar where foo = '' or 'a' = 'a'
- #
- # resulting in the effective truncation of the bar
- # table.
- #
- set parse_result_string [db_string sql_test_2 "select test_sql('select 1 from dual where 1=[DoubleApos "'$value'"]') from dual"]
- } else {
- set parse_result_string 1
- }
- if {
- $parse_result_integer == 0 ||
- $parse_result_integer == -904 ||
- $parse_result_integer == -1789 ||
- $parse_result_string == 0 ||
- $parse_result_string == -904 ||
- $parse_result_string == -1789
- } {
- # Code -904 means "invalid column", -1789 means
- # "incorrect number of result columns". We treat this
- # the same as 0 (no error) because the above statement
- # just selects from dual and 904 or 1789 only occur
- # after the parser has validated that the query syntax
- # is valid.
- ns_log Error "ad_block_sql_urls: Suspicious request from [ad_conn peeraddr]. Parameter $key contains code that looks like part of a valid SQL WHERE clause: [ad_conn url]?[ad_conn query]"
- # michael@arsdigita.com: Maybe we should just return a
- # 501 error.
- #
- ad_return_error "Suspicious Request" "Parameter $key looks like it contains SQL code. For security reasons, the system won't accept your request."
- return filter_return
- }
- }
- }
-
- return filter_ok
-}
-
-ad_proc -public -deprecated ad_set_typed_form_variable_filter {
- url_pattern
- args
-} {
-
- #
- # Register special rules for form variables.
- #
- # Example:
- #
- # ad_set_typed_form_variable_filter /my_module/* {a_id number} {b_id word} {*_id integer}
- #
- # For all pages under /my_module, set_form_variables would set
- # $a_id only if it was number, and $b_id only if it was a 'word'
- # (a string that contains only letters, numbers, dashes, and
- # underscores), and all other variables that match the pattern
- # *_id would be set only if they were integers.
- #
- # Variables not listed have no restrictions on them.
- #
- # By default, the three supported datatypes are 'integer', 'number',
- # and 'word', although you can add your own type by creating
- # functions named ad_var_type_check_${type_name}_p which should
- # return 1 if the value is a valid $type_name, or 0 otherwise.
- #
- # There's also a special datatype named 'nocheck', which will
- # return success regardless of the value. (See the docs for
- # ad_var_type_check_${type_name}_p to see how this might be
- # useful.)
- #
- # The default data_type is 'integer', which allows you shorten the
- # command above to:
- #
- # ad_set_typed_form_variable_filter /my_module/* a_id {b_id word}
- #
-
- ad_page_contract is the preferred mechanism to do automated
- validation of form variables.
-
- @see ad_page_contract
-} {
- ad_register_filter postauth GET $url_pattern ad_set_typed_form_variables $args
- ad_register_filter postauth POST $url_pattern ad_set_typed_form_variables $args
-}
-
-proc ad_set_typed_form_variables {conn args why} {
-
- global ad_typed_form_variables
-
- eval lappend ad_typed_form_variables [lindex $args 0]
-
- return filter_ok
-}
-
+#####
#
-# All the ad_var_type_check* procs get called from
-# check_for_form_variable_naughtiness. Read the documentation
-# for ad_set_typed_form_variable_filter for more details.
+# Signed cookie handling
+#
+#####
-proc_doc ad_var_type_check_integer_p {value} {
-
- #
- # return 1 if $value is an integer, 0 otherwise.
- #
-
-} {
-
- if { [regexp {[^0-9]} $value] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_safefilename_p {value} {
-
- #
- # return 0 if the file contains ".."
- #
-
-} {
-
- if { [string match *..* $value] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_dirname_p {value} {
-
- #
- # return 0 if $value contains a / or \, 1 otherwise.
- #
-
-} {
-
- if { [regexp {[/\\]} $value] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_number_p {value} {
-
- #
- # return 1 if $value is a valid number
- #
-
-} {
- if { [catch {expr 1.0 * $value}] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_word_p {value} {
-
- #
- # return 1 if $value contains only letters, numbers, dashes,
- # and underscores, otherwise returns 0.
- #
-
-} {
-
- if { [regexp {[^-A-Za-z0-9_]} $value] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_nocheck_p {{value ""}} {
-
- #
- # return 1 regardless of the value. This useful if you want to
- # set a filter over the entire site, then create a few exceptions.
- #
- # For example:
- #
- # ad_set_typed_form_variable_filter /my-dangerous-page.tcl {user_id nocheck}
- # ad_set_typed_form_variable_filter /*.tcl user_id
- #
-
-} {
- return 1
-}
-
-proc_doc ad_var_type_check_noquote_p {value} {
-
- #
- # return 1 if $value contains any single-quotes
- #
-
-} {
-
- if { [string match *'* $value] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_integerlist_p {value} {
-
- #
- # return 1 if list contains only numbers, spaces, and commas.
- # Example '5, 3, 1'. Note: it doesn't allow negative numbers,
- # because that could let people sneak in numbers that get
- # treated like math expressions like '1, 5-2'
- #
- #
-
-} {
-
- if { [regexp {[^ 0-9,]} $value] } {
- return 0
- } else {
- return 1
- }
-}
-
-proc_doc ad_var_type_check_fail_p {value} {
-
- #
- # A check that always returns 0. Useful if you want to disable all access
- # to a page.
- #
-
-} {
- return 0
-}
-
-proc_doc ad_var_type_check_third_urlv_integer_p {{args ""}} {
-
- #
- # Returns 1 if the third path element in the URL is integer.
- #
-
-} {
-
- set third_url_element [lindex [ad_conn urlv] 3]
-
- if { [regexp {[^0-9]} $third_url_element] } {
- return 0
- } else {
- return 1
- }
-}
-
-ad_proc -private sec_allocate_session {} {
-
- Returns a new session id
-
-} {
-
- global tcl_max_value
- global tcl_current_sequence_id
-
- if { ![info exists tcl_max_value] || ![info exists tcl_current_sequence_id] || $tcl_current_sequence_id > $tcl_max_value } {
- # Thread just spawned or we exceeded preallocated count.
- set tcl_current_sequence_id [db_nextval sec_id_seq]
- set tcl_max_value [expr $tcl_current_sequence_id + 100]
- }
-
- set session_id $tcl_current_sequence_id
- incr tcl_current_sequence_id
-
- return $session_id
-}
-
-ad_proc -private ad_login_page {} {
-
- 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] || \
- [string match "/" $url] || \
- [string match "*password-update*" $url] } {
- return 1
- }
-
- return 0
-}
-
-# signed cookies
-
ad_proc -public ad_sign {
{-secret ""}
{-token_id ""}
@@ -1206,8 +777,6 @@
}
-# signed cookies
-
ad_proc -public ad_get_signed_cookie {
{-include_set_cookies t}
{-secret ""}
@@ -1284,6 +853,7 @@
{-replace f}
{-secure f}
{-max_age ""}
+ {-signature_max_age ""}
{-domain ""}
{-path "/"}
{-secret ""}
@@ -1313,17 +883,19 @@
url-encoded.
} {
- if { $max_age == "inf" } {
- set signature_max_age ""
- } elseif { $max_age != "" } {
- set signature_max_age $max_age
- } else {
- # this means we want a session level cookie,
- # but that is a user interface expiration, that does
- # not give us a security expiration. (from the
- # security perspective, we use SessionLifetime)
- ns_log Debug "Security: SetSignedCookie: Using sec_session_lifetime [sec_session_lifetime]"
- set signature_max_age [sec_session_lifetime]
+ if { [empty_string_p $signature_max_age] } {
+ if { $max_age == "inf" } {
+ set signature_max_age ""
+ } elseif { $max_age != "" } {
+ set signature_max_age $max_age
+ } else {
+ # this means we want a session level cookie,
+ # but that is a user interface expiration, that does
+ # not give us a security expiration. (from the
+ # security perspective, we use SessionLifetime)
+ ns_log Debug "Security: SetSignedCookie: Using sec_session_lifetime [sec_session_lifetime]"
+ set signature_max_age [sec_session_lifetime]
+ }
}
set cookie_value [ad_sign -secret $secret -token_id $token_id -max_age $signature_max_age $value]
@@ -1335,6 +907,14 @@
+
+
+#####
+#
+# Token generation and handling
+#
+#####
+
ad_proc -private sec_get_token {
token_id
} {
@@ -1442,8 +1022,252 @@
}
+
+
+
#####
#
+# Client property procs
+#
+#####
+
+ad_proc -private sec_lookup_property {
+ id
+ module
+ name
+} {
+
+ Used as a helper procedure for util_memoize to look up a
+ particular property from the database. Returns
+ [list $property_value $secure_p].
+
+} {
+ if {
+ ![db_0or1row property_lookup_sec {
+ select property_value, secure_p
+ from sec_session_properties
+ where session_id = :id
+ and module = :module
+ and property_name = :name
+ }]
+ } {
+ return ""
+ }
+
+ set new_last_hit [clock seconds]
+
+ db_dml update_last_hit_dml {
+ update sec_session_properties
+ set last_hit = :new_last_hit
+ where session_id = :id and
+ property_name = :name
+ }
+
+ return [list $property_value $secure_p]
+}
+
+ad_proc -public ad_get_client_property {
+ {-cache t}
+ {-cache_only f}
+ {-default ""}
+ {-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
+ 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.
+
+ @param session_id controls which session is used
+
+} {
+ if { [empty_string_p $session_id] } {
+ set id [ad_conn session_id]
+ } else {
+ set id $session_id
+ }
+
+ set cmd [list sec_lookup_property $id $module $name]
+
+ if { $cache_only == "t" && ![util_memoize_cached_p $cmd] } {
+ return ""
+ }
+
+ if { $cache != "t" } {
+ util_memoize_flush $cmd
+ }
+
+ set property [util_memoize $cmd [sec_session_timeout]]
+ if { $property == "" } {
+ return $default
+ }
+ set value [lindex $property 0]
+ set secure_p [lindex $property 1]
+
+ if { $secure_p != "f" && ![ad_secure_conn_p] } {
+ return ""
+ }
+
+ return $value
+}
+
+ad_proc -public ad_set_client_property {
+ {-clob f}
+ {-secure f}
+ {-persistent t}
+ {-session_id ""}
+ module
+ 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,
+ 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
+
+} {
+
+ if { $secure != "f" && ![ad_secure_conn_p] } {
+ error "Unable to set secure property in insecure or invalid session"
+ }
+
+ if { [empty_string_p $session_id] } {
+ set session_id [ad_conn session_id]
+ }
+
+ if { $persistent == "t" } {
+ # Write to database - either defer, or write immediately. First delete the old
+ # value if any; then insert the new one.
+
+ set last_hit [ns_time]
+
+ db_transaction {
+
+ # DRB: Older versions of this code did a delete/insert pair in an attempt
+ # to guard against duplicate insertions. This didn't work if there was
+ # no value for this property in the table and two transactions ran in
+ # parallel. The problem is that without an existing row the delete had
+ # nothing to lock on, thus allowing the two inserts to conflict. This
+ # was discovered on a page built of frames, where the two requests from
+ # the browser spawned two AOLserver threads to service them.
+
+ # Oracle doesn't allow a RETURNING clause on an insert with a
+ # subselect, so this code first inserts a dummy value if none exists
+ # (ensuring it does exist afterwards) then updates it with the real
+ # value. Ugh.
+
+ set clob_update_dml [db_map prop_update_dml_clob]
+
+ db_dml prop_insert_dml ""
+
+ if { $clob == "t" && ![empty_string_p $clob_update_dml] } {
+ db_dml prop_update_dml_clob "" -clobs [list $value]
+ } else {
+ db_dml prop_update_dml ""
+ }
+ }
+ }
+
+ # 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]
+}
+
+
+
+
+
+
+
+
+#####
+#
+# Deprecated procs
+#
+#####
+
+ad_proc -public -deprecated ad_get_user_id {} {
+ Gets the user ID. 0 indicates the user is not logged in.
+
+ Deprecated since user_id now provided via ad_conn user_id
+
+ @see ad_conn
+} {
+ return [ad_conn user_id]
+}
+
+ad_proc -public -deprecated ad_verify_and_get_user_id {
+ {-secure f}
+} {
+ Returns the current user's ID. 0 indicates user is not logged in
+
+ Deprecated since user_id now provided via ad_conn user_id
+
+ @see ad_conn
+} {
+ return [ad_conn user_id]
+}
+
+ad_proc -public -deprecated ad_verify_and_get_session_id {
+ {-secure f}
+} {
+ Returns the current session's ID.
+
+ Deprecated since session_id now provided via ad_conn session_id
+
+ @param secure is ignored
+
+ @see ad_conn
+} {
+ return [ad_conn session_id]
+}
+
+# handling privacy
+
+ad_proc -public -deprecated ad_privacy_threshold {} {
+ Pages that are consider whether to display a user's name or email
+ address should test to make sure that a user's priv_ from the
+ database is less than or equal to what ad_privacy_threshold returns.
+
+ Now deprecated.
+} {
+ set session_user_id [ad_get_user_id]
+ if {$session_user_id == 0} {
+ # viewer of this page isn't logged in, only show stuff
+ # that is extremely unprivate
+ set privacy_threshold 0
+ } else {
+ set privacy_threshold 5
+ }
+ return $privacy_threshold
+}
+
+ad_proc -deprecated ad_maybe_redirect_for_registration {} {
+
+ Checks to see if a user is logged in. If not, redirects to
+ [subsite]/register/index to require the user to register.
+ When registration is complete, the user will return to the current
+ location. All variables in ns_getform (both posts and gets) will
+ be maintained. Note that this will return out of its caller so that
+ the caller need not explicitly call "return". Returns the user id
+ if login was succesful.
+
+ @see auth::require_login
+} {
+ auth::require_login
+}
+
+
+
+#####
+#
# security namespace public procs
#
#####
@@ -1630,3 +1454,4 @@
return $insecure_location
}
+
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -r1.40 -r1.41
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 18 Sep 2003 10:07:41 -0000 1.40
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 18 Sep 2003 17:08:39 -0000 1.41
@@ -2408,9 +2408,9 @@
procedure defaults to run on only the canonical server unless the
all_servers flag is set to true.
- @param thread If true run scheduled proc in its own thread
- @param once If true only run the scheduled proc once
- @param debug If true log debugging information
+ @param thread t/f If true run scheduled proc in its own thread
+ @param once t/f. If true only run the scheduled proc once
+ @param debug t/f If true log debugging information
@param all_servers If true run on all servers in a cluster
@param schedule_proc ns_schedule_daily, ns_schedule_weekly or blank
@param interval If schedule_proc is empty, the interval to run the proc
@@ -3947,3 +3947,348 @@
}
return $result
}
+
+ad_proc ad_generate_random_string {{length 8}} {
+ Generates a random string made of numbers and letters
+} {
+ return [string range [sec_random_token] 0 $length]
+}
+
+
+
+
+#####
+#
+# This is some old security crud from before we had ad_page_contract
+#
+#####
+
+
+# michael@arsdigita.com: A better name for this proc would be
+# "ad_block_sql_fragment_form_data", since "form data" is the
+# official term for query string (URL) variables and form input
+# variables.
+#
+ad_proc -public -deprecated ad_block_sql_urls {
+ conn
+ args
+ why
+} {
+
+ A filter that detect attempts to smuggle in SQL code through form data
+ variables. The use of bind variables and ad_page_contract input
+ validation to prevent SQL smuggling is preferred.
+
+ @see ad_page_contract
+} {
+ set form [ns_getform]
+ if { [empty_string_p $form] } { return filter_ok }
+
+ # Check each form data variable to see if it contains malicious
+ # user input that we don't want to interpolate into our SQL
+ # statements.
+ #
+ # We do this by scanning the variable for suspicious phrases; at
+ # this time, the phrases we look for are: UNION, UNION ALL, and
+ # OR.
+ #
+ # If one of these phrases is found, we construct a test SQL query
+ # that incorporates the variable into its WHERE clause and ask
+ # the database to parse it. If the query does parse successfully,
+ # then we know that the suspicious user input would result in a
+ # executing SQL that we didn't write, so we abort processing this
+ # HTTP request.
+ #
+ set n_form_vars [ns_set size $form]
+ for { set i 0 } { $i < $n_form_vars } { incr i } {
+ set key [ns_set key $form $i]
+ set value [ns_set value $form $i]
+
+ # michael@arsdigita.com:
+ #
+ # Removed 4000-character length check, because that allowed
+ # malicious users to smuggle SQL fragments greater than 4000
+ # characters in length.
+ #
+ if {
+ [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value] ||
+ [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value]
+ } {
+ # Looks like the user has added "union [all] select" to
+ # the variable, # or is trying to modify the WHERE clause
+ # by adding "or ...".
+ #
+ # Let's see if Oracle would accept this variables as part
+ # of a typical WHERE clause, either as string or integer.
+ #
+ # michael@arsdigita.com: Should we grab a handle once
+ # outside of the loop?
+ #
+ set parse_result_integer [db_string sql_test_1 "select test_sql('select 1 from dual where 1=[DoubleApos $value]') from dual"]
+
+ if { [string first "'" $value] != -1 } {
+ #
+ # The form variable contains at least one single
+ # quote. This can be a problem in the case that
+ # the programmer forgot to QQ the variable before
+ # interpolation into SQL, because the variable
+ # could contain a single quote to terminate the
+ # criterion and then smuggled SQL after that, e.g.:
+ #
+ # set foo "' or 'a' = 'a"
+ #
+ # db_dml "delete from bar where foo = '$foo'"
+ #
+ # which would be processed as:
+ #
+ # delete from bar where foo = '' or 'a' = 'a'
+ #
+ # resulting in the effective truncation of the bar
+ # table.
+ #
+ set parse_result_string [db_string sql_test_2 "select test_sql('select 1 from dual where 1=[DoubleApos "'$value'"]') from dual"]
+ } else {
+ set parse_result_string 1
+ }
+
+ if {
+ $parse_result_integer == 0 ||
+ $parse_result_integer == -904 ||
+ $parse_result_integer == -1789 ||
+ $parse_result_string == 0 ||
+ $parse_result_string == -904 ||
+ $parse_result_string == -1789
+ } {
+ # Code -904 means "invalid column", -1789 means
+ # "incorrect number of result columns". We treat this
+ # the same as 0 (no error) because the above statement
+ # just selects from dual and 904 or 1789 only occur
+ # after the parser has validated that the query syntax
+ # is valid.
+
+ ns_log Error "ad_block_sql_urls: Suspicious request from [ad_conn peeraddr]. Parameter $key contains code that looks like part of a valid SQL WHERE clause: [ad_conn url]?[ad_conn query]"
+
+ # michael@arsdigita.com: Maybe we should just return a
+ # 501 error.
+ #
+ ad_return_error "Suspicious Request" "Parameter $key looks like it contains SQL code. For security reasons, the system won't accept your request."
+
+ return filter_return
+ }
+ }
+ }
+
+ return filter_ok
+}
+
+ad_proc -public -deprecated ad_set_typed_form_variable_filter {
+ url_pattern
+ args
+} {
+
+ #
+ # Register special rules for form variables.
+ #
+ # Example:
+ #
+ # ad_set_typed_form_variable_filter /my_module/* {a_id number} {b_id word} {*_id integer}
+ #
+ # For all pages under /my_module, set_form_variables would set
+ # $a_id only if it was number, and $b_id only if it was a 'word'
+ # (a string that contains only letters, numbers, dashes, and
+ # underscores), and all other variables that match the pattern
+ # *_id would be set only if they were integers.
+ #
+ # Variables not listed have no restrictions on them.
+ #
+ # By default, the three supported datatypes are 'integer', 'number',
+ # and 'word', although you can add your own type by creating
+ # functions named ad_var_type_check_${type_name}_p which should
+ # return 1 if the value is a valid $type_name, or 0 otherwise.
+ #
+ # There's also a special datatype named 'nocheck', which will
+ # return success regardless of the value. (See the docs for
+ # ad_var_type_check_${type_name}_p to see how this might be
+ # useful.)
+ #
+ # The default data_type is 'integer', which allows you shorten the
+ # command above to:
+ #
+ # ad_set_typed_form_variable_filter /my_module/* a_id {b_id word}
+ #
+
+ ad_page_contract is the preferred mechanism to do automated
+ validation of form variables.
+
+ @see ad_page_contract
+} {
+ ad_register_filter postauth GET $url_pattern ad_set_typed_form_variables $args
+ ad_register_filter postauth POST $url_pattern ad_set_typed_form_variables $args
+}
+
+proc ad_set_typed_form_variables {conn args why} {
+
+ global ad_typed_form_variables
+
+ eval lappend ad_typed_form_variables [lindex $args 0]
+
+ return filter_ok
+}
+
+#
+# All the ad_var_type_check* procs get called from
+# check_for_form_variable_naughtiness. Read the documentation
+# for ad_set_typed_form_variable_filter for more details.
+
+proc_doc ad_var_type_check_integer_p {value} {
+
+ #
+ # return 1 if $value is an integer, 0 otherwise.
+ #
+
+} {
+
+ if { [regexp {[^0-9]} $value] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_safefilename_p {value} {
+
+ #
+ # return 0 if the file contains ".."
+ #
+
+} {
+
+ if { [string match *..* $value] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_dirname_p {value} {
+
+ #
+ # return 0 if $value contains a / or \, 1 otherwise.
+ #
+
+} {
+
+ if { [regexp {[/\\]} $value] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_number_p {value} {
+
+ #
+ # return 1 if $value is a valid number
+ #
+
+} {
+ if { [catch {expr 1.0 * $value}] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_word_p {value} {
+
+ #
+ # return 1 if $value contains only letters, numbers, dashes,
+ # and underscores, otherwise returns 0.
+ #
+
+} {
+
+ if { [regexp {[^-A-Za-z0-9_]} $value] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_nocheck_p {{value ""}} {
+
+ #
+ # return 1 regardless of the value. This useful if you want to
+ # set a filter over the entire site, then create a few exceptions.
+ #
+ # For example:
+ #
+ # ad_set_typed_form_variable_filter /my-dangerous-page.tcl {user_id nocheck}
+ # ad_set_typed_form_variable_filter /*.tcl user_id
+ #
+
+} {
+ return 1
+}
+
+proc_doc ad_var_type_check_noquote_p {value} {
+
+ #
+ # return 1 if $value contains any single-quotes
+ #
+
+} {
+
+ if { [string match *'* $value] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_integerlist_p {value} {
+
+ #
+ # return 1 if list contains only numbers, spaces, and commas.
+ # Example '5, 3, 1'. Note: it doesn't allow negative numbers,
+ # because that could let people sneak in numbers that get
+ # treated like math expressions like '1, 5-2'
+ #
+ #
+
+} {
+
+ if { [regexp {[^ 0-9,]} $value] } {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc ad_var_type_check_fail_p {value} {
+
+ #
+ # A check that always returns 0. Useful if you want to disable all access
+ # to a page.
+ #
+
+} {
+ return 0
+}
+
+proc_doc ad_var_type_check_third_urlv_integer_p {{args ""}} {
+
+ #
+ # Returns 1 if the third path element in the URL is integer.
+ #
+
+} {
+
+ set third_url_element [lindex [ad_conn urlv] 3]
+
+ if { [regexp {[^0-9]} $third_url_element] } {
+ return 0
+ } else {
+ return 1
+ }
+}