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 -N -r1.31 -r1.32 --- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 12 Sep 2003 13:00:31 -0000 1.31 +++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 12 Sep 2003 14:31:15 -0000 1.32 @@ -231,10 +231,30 @@ ad_proc -private auth::get_register_authority { } { - Get the ID of the authority in which accounts get created. + Get the ID of the authority in which accounts get created. Is based on the RegisterAuthority parameter + but will default to the local authority if that parameter has an invalid value. } { - # HACK while waiting for real account creation - return [auth::authority::local] + set parameter_value [parameter::get_from_package_key -parameter RegisterAuthority -package_key "acs-authentication"] + + # Catch the case where somebody has set the parameter to some non-existant authority + if { [lsearch [auth::authority::get_short_names] $parameter_value] != -1} { + # The authority exists + set authority_id [auth::authority::get_id -short_name $parameter_value] + + # Check that the authority has a register implementation + auth::authority::get -authority_id $authority_id -array authority + + if { [empty_string_p $authority(register_impl_id)] } { + ns_log Error "parameter value for RegisterAuthority is an authority without registration driver, defaulting to local authority" + set authority_id [auth::authority::local] + } + } else { + # The authority doesn't exist - use the local authority + ns_log Error "parameter RegisterAuthority has the invalid value $parameter_value. Defaulting to local authority" + set authority_id [auth::authority::local] + } + + return $authority_id } ad_proc -public auth::create_user { 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 -N -r1.14 -r1.15 --- openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 11 Sep 2003 16:11:11 -0000 1.14 +++ openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 12 Sep 2003 14:31:15 -0000 1.15 @@ -357,7 +357,16 @@ return $job_id } +ad_proc -public auth::authority::get_short_names {} { + Return a list of authority short names. + @author Peter Marklund +} { + return [db_list select_authority_short_names { + select short_name + from auth_authorities + }] +} @@ -495,5 +504,3 @@ } { return [auth::authority::get_id -short_name "local"] } - -