--- loncom/lonnet/perl/lonnet.pm 2008/01/18 02:18:07 1.938 +++ loncom/lonnet/perl/lonnet.pm 2008/02/24 22:59:17 1.943 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.938 2008/01/18 02:18:07 raeburn Exp $ +# $Id: lonnet.pm,v 1.943 2008/02/24 22:59:17 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1064,6 +1064,10 @@ sub inst_rulecheck { $response=&unescape(&reply('instidrulecheck:'.&escape($udom). ':'.&escape($id).':'.$rulestr, $homeserver)); + } elsif ($item eq 'selfenroll') { + $response=&unescape(&reply('instselfenrollcheck:'. + &escape($udom).':'.&escape($uname). + ':'.$rulestr,$homeserver)); } if ($response ne 'refused') { my @pairs=split(/\&/,$response); @@ -1090,6 +1094,9 @@ sub inst_userrules { if ($check eq 'id') { $response=&reply('instidrules:'.&escape($udom), $homeserver); + } elsif ($check eq 'email') { + $response=&reply('instemailrules:'.&escape($udom), + $homeserver); } else { $response=&reply('instuserrules:'.&escape($udom), $homeserver); @@ -1115,6 +1122,35 @@ sub inst_userrules { return (\%ruleshash,\@ruleorder); } +# ------------------------- Get Authentication and Language Defaults for Domain + +sub get_domain_defaults { + my ($domain) = @_; + my $cachetime = 60*60*24; + my ($defauthtype,$defautharg,$deflang); + my ($result,$cached)=&is_cached_new('domdefaults',$domain); + if (defined($cached)) { + if (ref($result) eq 'HASH') { + return %{$result}; + } + } + my %domdefaults; + my %domconfig = + &Apache::lonnet::get_dom('configuration',['defaults'],$domain); + if (ref($domconfig{'defaults'}) eq 'HASH') { + $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; + $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; + $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; + } else { + $domdefaults{'lang_def'} = &domain($domain,'lang_def'); + $domdefaults{'auth_def'} = &domain($domain,'auth_def'); + $domdefaults{'auth_arg_def'} = &domain($domain,'auth_arg_def'); + } + &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults, + $cachetime); + return %domdefaults; +} + # --------------------------------------------------- Assign a key to a student sub assign_access_key { @@ -1650,9 +1686,21 @@ sub absolute_url { return $protocol.$host_name; } +# +# Server side include. +# Parameters: +# fn Possibly encrypted resource name/id. +# form Hash that describes how the rendering should be done +# and other things. +# r Optional reference that will be given the response. +# This is mostly provided so that the caller can implement +# error detection, recovery and retry policies. +# +# Returns: +# The content of the response. sub ssi { - my ($fn,%form)=@_; + my ($fn,%form, $r)=@_; my $ua=new LWP::UserAgent; @@ -1670,6 +1718,10 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response=$ua->request($request); + if ($r) { + $$r = $response; + } + return $response->content; } @@ -2462,7 +2514,7 @@ sub get_my_roles { } if (($tstart) && ($tstart<0)) { next; } my $status = 'active'; - if (($tend) && ($tend<$now)) { + if (($tend) && ($tend<=$now)) { $status = 'previous'; } if (($tstart) && ($now<$tstart)) { @@ -3527,7 +3579,7 @@ sub set_userprivs { } foreach my $role (keys(%{$allroles})) { my %thesepriv; - if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; } + if (($role=~/^au/) || ($role=~/^ca/) || ($role=~/^aa/)) { $author=1; } foreach my $item (split(/:/,$$allroles{$role})) { if ($item ne '') { my ($privilege,$restrictions)=split(/&/,$item); @@ -6751,10 +6803,14 @@ sub EXT { sub get_reply { my ($reply_value) = @_; - if (wantarray) { - return @$reply_value; + if (ref($reply_value) eq 'ARRAY') { + if (wantarray) { + return @$reply_value; + } + return $reply_value->[0]; + } else { + return $reply_value; } - return $reply_value->[0]; } sub check_group_parms { @@ -9342,6 +9398,18 @@ put_dom($namespace,$storehash,$udom,$uho domain level either on specified domain server ($uhome) or primary domain server ($udom and $uhome are optional) +=item * + +get_domain_defaults($target_domain) : returns hash with defaults for +authentication and language in the domain. Keys are: auth_def, auth_arg_def, +lang_def; corresponsing values are authentication type (internal, krb4, krb5, +or localauth), initial password or a kerberos realm, language (e.g., en-us). +Values are retrieved from cache (if current), or from domain's configuration.db +(if available), or lastly from values in lonTabs/dns_domain,tab, +or lonTabs/domain.tab. + +%domdefaults = &get_auth_defaults($target_domain); + =back =head2 Network Status Functions