Index: openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl 17 Sep 2003 11:26:53 -0000 1.9
+++ openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl 8 Oct 2003 09:59:06 -0000 1.10
@@ -12,6 +12,7 @@
namespace eval auth::registration {}
namespace eval auth::get_doc {}
namespace eval auth::process_doc {}
+namespace eval auth::user_info {}
ad_proc -private auth::package_install {} {} {
@@ -23,6 +24,7 @@
auth::registration::create_contract
auth::get_doc::create_contract
auth::process_doc::create_contract
+ auth::user_info::create_contract
# Register local authentication implementations and update the local authority
auth::local::install
@@ -54,6 +56,7 @@
auth::registration::delete_contract
auth::get_doc::delete_contract
auth::process_doc::delete_contract
+ auth::user_info::delete_contract
}
}
@@ -422,3 +425,55 @@
+
+#####
+#
+# auth_user_info service contract
+#
+#####
+
+ad_proc -private auth::user_info::create_contract {} {
+ Create service contract for account registration.
+} {
+ set spec {
+ name "auth_user_info"
+ description "Get information about a user in real-time"
+ operations {
+ GetUserInfo {
+ description {
+ Request information about a user. Returns info_status 'ok', 'no_account', 'info_error', or 'failed_to_connect'.
+ info_message is a human-readable explanation to the user.
+ }
+ input {
+ username:string
+ parameters:string,multiple
+ }
+ output {
+ info_status:string
+ info_message:string
+ user_info:string,multiple
+ }
+ }
+ GetParameters {
+ description {
+ Get an array-list of the parameters required by this service contract implementation.
+ }
+ output {
+ parameters:string,multiple
+ }
+ }
+ }
+ }
+
+ acs_sc::contract::new_from_spec -spec $spec
+}
+
+
+ad_proc -private auth::user_info::delete_contract {} {
+ Delete service contract for account registration.
+} {
+ acs_sc::contract::delete -name "auth_user_info"
+}
+
+
+
Index: openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl,v
diff -u -r1.51 -r1.52
--- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 7 Oct 2003 14:11:02 -0000 1.51
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 8 Oct 2003 09:59:06 -0000 1.52
@@ -9,6 +9,7 @@
namespace eval auth {}
namespace eval auth::authentication {}
namespace eval auth::registration {}
+namespace eval auth::user_info {}
#####
@@ -248,6 +249,9 @@
-return_url $return_url \
-username $username \
-authority_id $authority_id]
+
+ ns_log Notice "LARS: [array get result]"
+
# Returns:
# result(account_status)
# result(account_message)
@@ -290,7 +294,7 @@
}
# Issue login cookie if login was successful
- if { [string equal $result(auth_status) "ok"] && !$no_cookie_p } {
+ if { [string equal $result(auth_status) "ok"] && !$no_cookie_p && [exists_and_not_null result(user_id)] } {
auth::issue_login \
-user_id $result(user_id) \
-persistent=$persistent_p \
@@ -660,7 +664,7 @@
array set labels [list \
username [_ acs-subsite.Username] \
- email [_ acs-subsite.Your_email_address] \
+ email [_ acs-subsite.Email] \
first_names [_ acs-subsite.First_names] \
last_name [_ acs-subsite.Last_name] \
screen_name [_ acs-subsite.Screen_name] \
@@ -1148,21 +1152,40 @@
}
if { !$account_found_p } {
- # Local user account doesn't exist
- set auth_info(account_status) "closed"
- auth::authority::get -authority_id $authority_id -array authority
- set auth_info(account_message) "You have successfully authenticated, but you do not have an account on [ad_system_name] yet.
"
+ # Try for an on-demand sync
+ array set info_result [auth::user_info::GetUserInfo \
+ -authority_id $authority_id \
+ -username $username]
- if { ![empty_string_p $authority(help_contact_text)] } {
- append auth_info(account_message) "
Help Information
"
- append auth_info(account_message) [ad_html_text_convert \
- -from $authority(help_contact_text_format) \
- -to "text/html" -- $authority(help_contact_text)]
- }
+ if { [string equal $info_result(info_status) "ok"] } {
+ array set user $info_result(user_info)
+ set user(user_id) [auth::create_local_account \
+ -authority_id $authority_id \
+ -username $username \
+ -array user]
+ acs_user::get -authority_id $authority_id -username $username -array user
+
+ } else {
- return [array get auth_info]
+ # Local user account doesn't exist
+ set auth_info(account_status) "closed"
+
+ # Used to get help contact info
+ auth::authority::get -authority_id $authority_id -array authority
+ set system_name [ad_system_name]
+ set auth_info(account_message) "You have successfully authenticated, but you do not have an account on $system_name yet."
+
+ if { ![empty_string_p $authority(help_contact_text)] } {
+ append auth_info(account_message) "Help Information
"
+ append auth_info(account_message) [ad_html_text_convert \
+ -from $authority(help_contact_text_format) \
+ -to "text/html" -- $authority(help_contact_text)]
+ }
+
+ return [array get auth_info]
+ }
}
# Check local account status
@@ -1514,10 +1537,7 @@
} {
Invoke the Register service contract operation for the given authority.
- @authority_id Id of the authority. Defaults to local authority.
- @url Any URL (homepage) associated with the new user
- @secret_question Question to ask on forgotten password
- @secret_answer Answer to forgotten password question
+ @authority_id Id of the authority.
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "register_impl_id"]
@@ -1573,3 +1593,37 @@
}
+
+#####
+#
+# auth::user_info
+#
+#####
+
+ad_proc -private auth::user_info::GetUserInfo {
+ {-authority_id:required}
+ {-username:required}
+} {
+ Invoke the Register service contract operation for the given authority.
+
+ @authority_id Id of the authority.
+} {
+ set impl_id [auth::authority::get_element -authority_id $authority_id -element "user_info_impl_id"]
+
+ if { [empty_string_p $impl_id] } {
+ # No implementation of authentication
+ return {
+ info_status no_account
+ }
+ }
+
+ set parameters [auth::driver::get_parameter_values \
+ -authority_id $authority_id \
+ -impl_id $impl_id]
+
+ return [acs_sc::invoke \
+ -error \
+ -impl_id $impl_id \
+ -operation GetUserInfo \
+ -call_args [list $username $parameters]]
+}
Index: openacs-4/packages/acs-authentication/tcl/authority-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authority-procs.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 16 Sep 2003 13:07:42 -0000 1.16
+++ openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 8 Oct 2003 09:59:06 -0000 1.17
@@ -30,36 +30,39 @@
- - short_name Short name for authority. Used as a key by applications to identify this authority.
+
- short_name Short name for authority. Used as a key by applications to identify this authority.
-
- pretty_name Label for the authority to be shown in a list to users picking a authority.
+
- pretty_name Label for the authority to be shown in a list to users picking a authority.
-
- enabled_p 't' if this authority available, 'f' if it's disabled. Defaults to 't'.
+
- enabled_p 't' if this authority available, 'f' if it's disabled. Defaults to 't'.
-
- sort_order Sort ordering determines the order in which authorities are listed in the user interface.
- Defaults to the currently highest sort order plus one.
+
- sort_order Sort ordering determines the order in which authorities are listed in the user interface.
+ Defaults to the currently highest sort order plus one.
-
- auth_impl_id The ID of the implementation of the 'auth_authentication' service contract.
- Defaults to none.
+
- auth_impl_id The ID of the implementation of the 'auth_authentication' service contract.
+ Defaults to none.
-
- pwd_impl_id The ID of the implementation of the 'auth_password' service contract. Defaults to none.
+
- pwd_impl_id The ID of the implementation of the 'auth_password' service contract. Defaults to none.
-
- forgotten_pwd_url An alternative URL to redirect to when the user has forgotten his/her password.
- Defaults to none.
+
- forgotten_pwd_url An alternative URL to redirect to when the user has forgotten his/her password.
+ Defaults to none.
-
- change_pwd_url An alternative URL to redirect to when the user wants to change his/her password.
- Defaults to none.
+
- change_pwd_url An alternative URL to redirect to when the user wants to change his/her password.
+ Defaults to none.
-
- register_impl_id The ID of the implementation of the 'auth_register' service contract.
- Defaults to none.
+
- register_impl_id The ID of the implementation of the 'auth_registration' service contract.
+ Defaults to none.
-
- register_url An alternative URL to redirect to when the user wants to register for an account.
- Defaults to none.
+
- register_url An alternative URL to redirect to when the user wants to register for an account.
+ Defaults to none.
-
- get_doc_impl_id Id of the batch sync GetDocument service contract implementation
+
- user_info_impl_id The ID of the implementation of the 'auth_user_info' service contract.
+ Defaults to none.
-
- process_doc_impl_id Id of the batch sync ProcessDocument service contract implementation
+
- get_doc_impl_id Id of the 'auth_sync_retrieve' service contract implementation
+
- process_doc_impl_id Id of the 'auth_sync_process' service contract implementation
+
- batch_sync_enabled_p Is batch sync enabled for the authority?
@@ -131,7 +134,15 @@
set authority_id [db_exec_plsql create_authority {}]
# Set the arguments not taken by the new function with an update statement
- foreach column {get_doc_impl_id process_doc_impl_id batch_sync_enabled_p help_contact_text_format} {
+ # LARS: Great, we had a nice abstraction going, so you only had to add a new column in
+ # one place, now that abstraction is broken, because you have to add it here as well
+ foreach column {
+ user_info_impl_id
+ get_doc_impl_id
+ process_doc_impl_id
+ batch_sync_enabled_p
+ help_contact_text_format
+ } {
set edit_columns($column) [set $column]
}
@@ -407,6 +418,7 @@
change_pwd_url ""
register_impl_id ""
register_url ""
+ user_info_impl_id ""
get_doc_impl_id ""
process_doc_impl_id ""
batch_sync_enabled_p "f"
@@ -431,15 +443,15 @@
@author Peter Marklund
} {
- return {auth_impl_id pwd_impl_id register_impl_id get_doc_impl_id process_doc_impl_id}
+ return {auth_impl_id pwd_impl_id register_impl_id user_info_impl_id get_doc_impl_id process_doc_impl_id}
}
ad_proc -private auth::authority::get_select_columns {} {
Get a list of the columns which can be selected from auth_authorities table.
@author Lars Pind (lars@collaboraid.biz)
} {
- return [concat [get_columns] auth_impl_name pwd_impl_name register_impl_name]
+ return [concat [get_columns] auth_impl_name pwd_impl_name register_impl_name user_info_impl_name get_doc_impl_name process_doc_impl_name]
}
@@ -466,9 +478,12 @@
} {
set columns [get_columns]
- lappend columns "(select impl_name from acs_sc_impls where impl_id = auth_impl_id) as auth_impl_name"
- lappend columns "(select impl_name from acs_sc_impls where impl_id = pwd_impl_id) as pwd_impl_name"
- lappend columns "(select impl_name from acs_sc_impls where impl_id = register_impl_id) as register_impl_name"
+ lappend columns "(select impl_pretty_name from acs_sc_impls where impl_id = auth_impl_id) as auth_impl_name"
+ lappend columns "(select impl_pretty_name from acs_sc_impls where impl_id = pwd_impl_id) as pwd_impl_name"
+ lappend columns "(select impl_pretty_name from acs_sc_impls where impl_id = register_impl_id) as register_impl_name"
+ lappend columns "(select impl_pretty_name from acs_sc_impls where impl_id = user_info_impl_id) as user_info_impl_name"
+ lappend columns "(select impl_pretty_name from acs_sc_impls where impl_id = get_doc_impl_id) as get_doc_impl_name"
+ lappend columns "(select impl_pretty_name from acs_sc_impls where impl_id = process_doc_impl_id) as process_doc_impl_name"
db_1row select_authority "
select [join $columns ",\n "]