--- loncom/lonnet/perl/lonnet.pm 2007/10/03 19:57:26 1.918 +++ loncom/lonnet/perl/lonnet.pm 2008/02/26 10:39:44 1.944 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.918 2007/10/03 19:57:26 raeburn Exp $ +# $Id: lonnet.pm,v 1.944 2008/02/26 10:39:44 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -513,7 +513,6 @@ sub get_env_multiple { } # ------------------------------------------ Find out current server userload -# there is a copy in lond sub userload { my $numusers=0; { @@ -521,7 +520,8 @@ sub userload { my $filename; my $curtime=time; while ($filename=readdir(LONIDS)) { - if ($filename eq '.' || $filename eq '..') {next;} + next if ($filename eq '.' || $filename eq '..'); + next if ($filename =~ /publicuser_\d+\.id/); my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9]; if ($curtime-$mtime < 1800) { $numusers++; } } @@ -1047,7 +1047,7 @@ sub get_instuser { } sub inst_rulecheck { - my ($udom,$uname,$rules) = @_; + my ($udom,$uname,$id,$item,$rules) = @_; my %returnhash; if ($udom ne '') { if (ref($rules) eq 'ARRAY') { @@ -1055,9 +1055,20 @@ sub inst_rulecheck { my $rulestr = join(':',@{$rules}); my $homeserver=&domain($udom,'primary'); if (($homeserver ne '') && ($homeserver ne 'no_host')) { - my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'. - &escape($uname).':'.$rulestr, + my $response; + if ($item eq 'username') { + $response=&unescape(&reply('instrulecheck:'.&escape($udom). + ':'.&escape($uname).':'.$rulestr, $homeserver)); + } elsif ($item eq 'id') { + $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); foreach my $item (@pairs) { @@ -1074,14 +1085,24 @@ sub inst_rulecheck { } sub inst_userrules { - my ($udom) = @_; + my ($udom,$check) = @_; my (%ruleshash,@ruleorder); if ($udom ne '') { my $homeserver=&domain($udom,'primary'); if (($homeserver ne '') && ($homeserver ne 'no_host')) { - my $response=&reply('instuserrules:'.&escape($udom), + my $response; + 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); + } if (($response ne 'refused') && ($response ne 'error') && + ($response ne 'unknown_cmd') && ($response ne 'no_such_host')) { my ($hashitems,$orderitems) = split(/:/,$response); my @pairs=split(/\&/,$hashitems); @@ -1101,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 { @@ -1383,13 +1433,15 @@ sub do_cache_new { $memcache->disconnect_all(); } # need to make a copy of $value - #&make_room($id,$value,$debug); + &make_room($id,$value,$debug); return $value; } sub make_room { my ($id,$value,$debug)=@_; - $remembered{$id}=$value; + + $remembered{$id}= (ref($value)) ? &Storable::dclone($value) + : $value; if ($to_remember<0) { return; } $accessed{$id}=[&gettimeofday()]; if (scalar(keys(%remembered)) <= $to_remember) { return; } @@ -1619,7 +1671,7 @@ sub ssi_body { &ssi($filelink,%form)); $output=~s|//(\s*)?\s||gs; $output=~s/^.*?\]*\>//si; - $output=~s/(.*)\<\/body\s*\>.*?$/$1/si; + $output=~s/\<\/body\s*\>.*?$//si; return $output; } @@ -1634,9 +1686,23 @@ 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. +# Returns: +# Scalar context: The content of the reply. +# Array context: 2 element list of the content and the full response variable. +# +# Returns: +# The content of the response. sub ssi { my ($fn,%form)=@_; + my $count = scalar(@_); + my $ua=new LWP::UserAgent; @@ -1653,8 +1719,13 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response=$ua->request($request); + my $status = $response->code; - return $response->content; + if (wantarray) { + return ($response->content, $response); + } else { + return $response->content; + } } sub externalssi { @@ -2170,7 +2241,7 @@ sub flushcourselogs { # times and course titles for all courseids # my %courseidbuffer=(); - foreach my $crsid (keys %courselogs) { + foreach my $crsid (keys(%courselogs)) { if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'. &escape($courselogs{$crsid}), $coursehombuf{$crsid}) eq 'ok') { @@ -2183,12 +2254,12 @@ sub flushcourselogs { delete $courselogs{$crsid}; } } - $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = ( - 'description' => &escape($coursedescrbuf{$crsid}), - 'instcode' => &escape($courseinstcodebuf{$crsid}), - 'type' => &escape($coursetypebuf{$crsid}), - 'owner' => &escape($courseownerbuf{$crsid}), - ); + $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = { + 'description' => $coursedescrbuf{$crsid}, + 'inst_code' => $courseinstcodebuf{$crsid}, + 'type' => $coursetypebuf{$crsid}, + 'owner' => $courseownerbuf{$crsid}, + }; } # # Write course id database (reverse lookup) to homeserver of courses @@ -2196,7 +2267,8 @@ sub flushcourselogs { # foreach my $crs_home (keys(%courseidbuffer)) { my $response = &courseidput(&host_domain($crs_home), - $courseidbuffer{$crs_home},$crs_home); + $courseidbuffer{$crs_home}, + $crs_home,'timeonly'); } # # File accesses @@ -2382,7 +2454,11 @@ sub get_course_adv_roles { my %coursehash=&coursedescription($cid); my %nothide=(); foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { - $nothide{join(':',split(/[\@\:]/,$user))}=1; + if ($user !~ /:/) { + $nothide{join(':',split(/[\@]/,$user))}=1; + } else { + $nothide{$user}=1; + } } my %returnhash=(); my %dumphash= @@ -2410,15 +2486,25 @@ sub get_course_adv_roles { } sub get_my_roles { - my ($uname,$udom,$context,$types,$roles,$roledoms)=@_; + my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_; unless (defined($uname)) { $uname=$env{'user.name'}; } unless (defined($udom)) { $udom=$env{'user.domain'}; } - my %dumphash; + my (%dumphash,%nothide); if ($context eq 'userroles') { %dumphash = &dump('roles',$udom,$uname); } else { %dumphash= &dump('nohist_userroles',$udom,$uname); + if ($hidepriv) { + my %coursehash=&coursedescription($udom.'_'.$uname); + foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { + if ($user !~ /:/) { + $nothide{join(':',split(/[\@]/,$user))} = 1; + } else { + $nothide{$user} = 1; + } + } + } } my %returnhash=(); my $now=time; @@ -2431,7 +2517,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)) { @@ -2460,10 +2546,27 @@ sub get_my_roles { } if (ref($roles) eq 'ARRAY') { if (!grep(/^\Q$role\E$/,@{$roles})) { + if ($role =~ /^cr\//) { + if (!grep(/^cr$/,@{$roles})) { + next; + } + } else { + next; + } + } + } + if ($hidepriv) { + if ((&privileged($username,$domain)) && + (!$nothide{$username.':'.$domain})) { next; } } - $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; + if ($withsec) { + $returnhash{$username.':'.$domain.':'.$role.':'.$section} = + $tstart.':'.$tend; + } else { + $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; + } } return %returnhash; } @@ -2502,21 +2605,32 @@ sub getannounce { # sub courseidput { - my ($domain,$storehash,$coursehome)=@_; - my $items=''; - my $now = time; - foreach my $item (keys(%$storehash)) { - $storehash->{$item}{'lasttime'} = $now; - $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; + my ($domain,$storehash,$coursehome,$caller) = @_; + my $outcome; + if ($caller eq 'timeonly') { + my $cids = ''; + foreach my $item (keys(%$storehash)) { + $cids.=&escape($item).'&'; + } + $cids=~s/\&$//; + $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$cids, + $coursehome); + } else { + my $items = ''; + foreach my $item (keys(%$storehash)) { + $items.= &escape($item).'='. + &freeze_escape($$storehash{$item}).'&'; + } + $items=~s/\&$//; + $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$items, + $coursehome); } - $items=~s/\&$//; - my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome); if ($outcome eq 'unknown_cmd') { my $what; foreach my $cid (keys(%$storehash)) { $what .= &escape($cid).'='; - foreach my $item ('description','instcode','owner','type') { - $what .= $storehash->{$item}.':'; + foreach my $item ('description','inst_code','owner','type') { + $what .= &escape($storehash->{$cid}{$item}).':'; } $what =~ s/\:$/&/; } @@ -2528,7 +2642,8 @@ sub courseidput { } sub courseiddump { - my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; + my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, + $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; my $as_hash = 1; my %returnhash; if (!$domfilter) { $domfilter=''; } @@ -2545,7 +2660,7 @@ sub courseiddump { $sincefilter.':'.&escape($descfilter).':'. &escape($instcodefilter).':'.&escape($ownerfilter). ':'.&escape($coursefilter).':'.&escape($typefilter). - ':'.&escape($regexp_ok).':'.$as_hash,$tryserver); + ':'.&escape($regexp_ok).':'.$as_hash,$tryserver); my @pairs=split(/\&/,$rep); foreach my $item (@pairs) { my ($key,$value)=split(/\=/,$item,2); @@ -2555,10 +2670,10 @@ sub courseiddump { if (ref($result) eq 'HASH') { $returnhash{$key}=$result; } else { - my @responses = split(/:/,$result); - my @items = ('description','instcode','owner','type'); + my @responses = split(/:/,$value); + my @items = ('description','inst_code','owner','type'); for (my $i=0; $i<@responses; $i++) { - $returnhash{$key}{$items[$i]} = $responses[$i]; + $returnhash{$key}{$items[$i]} = &unescape($responses[$i]); } } } @@ -2606,7 +2721,10 @@ sub get_domain_roles { if (undef($enddate) || $enddate eq '') { $enddate = '.'; } - my $rolelist = join(':',@{$roles}); + my $rolelist; + if (ref($roles) eq 'ARRAY') { + $rolelist = join(':',@{$roles}); + } my %personnel = (); my %servers = &get_servers($dom,'library'); @@ -2632,7 +2750,9 @@ sub get_first_access { my ($symb,$courseid,$udom,$uname)=&whichuser(); if ($argsymb) { $symb=$argsymb; } my ($map,$id,$res)=&decode_symb($symb); - if ($type eq 'map') { + if ($type eq 'course') { + $res='course'; + } elsif ($type eq 'map') { $res=&symbread($map); } else { $res=$symb; @@ -2645,7 +2765,9 @@ sub set_first_access { my ($type)=@_; my ($symb,$courseid,$udom,$uname)=&whichuser(); my ($map,$id,$res)=&decode_symb($symb); - if ($type eq 'map') { + if ($type eq 'course') { + $res='course'; + } elsif ($type eq 'map') { $res=&symbread($map); } else { $res=$symb; @@ -3460,7 +3582,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); @@ -4801,8 +4923,15 @@ sub auto_run { $response = 1; } } else { - my $homeserver = &homeserver($cnum,$cdom); - $response = &reply('autorun:'.$cdom,$homeserver); + my $homeserver; + if (&is_course($cdom,$cnum)) { + $homeserver = &homeserver($cnum,$cdom); + } else { + $homeserver = &domain($cdom,'primary'); + } + if ($homeserver ne 'no_host') { + $response = &reply('autorun:'.$cdom,$homeserver); + } } return $response; } @@ -5208,11 +5337,21 @@ sub assignrole { } else { my $cwosec=$url; $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; - unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { - &logthis('Refused assignrole: '. - $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. - $env{'user.name'}.' at '.$env{'user.domain'}); - return 'refused'; + if (!(&allowed('c'.$role,$cwosec)) && !(&allowed('c'.$role,$udom))) { + my $refused; + if (($env{'request.course.sec'} ne '') && ($role eq 'st')) { + if (!(&allowed('c'.$role,$url))) { + $refused = 1; + } + } else { + $refused = 1; + } + if ($refused) { + &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. + ' '.$role.' '.$end.' '.$start.' by '. + $env{'user.name'}.' at '.$env{'user.domain'}); + return 'refused'; + } } $mrole=$role; } @@ -5546,14 +5685,13 @@ sub createcourse { # log existence my $newcourse = { $udom.'_'.$uname => { - description => &escape($description), - inst_code => &escape($inst_code), - owner => &escape($course_owner), - type => &escape($crstype), + description => $description, + inst_code => $inst_code, + owner => $course_owner, + type => $crstype, }, }; - &courseidput($udom,$newcourse); - &flushcourselogs(); + &courseidput($udom,$newcourse,$uhome,'notime'); # set toplevel url my $topurl=$url; unless ($nonstandard) { @@ -6355,8 +6493,8 @@ sub resdata { } if (!ref($result)) { return $result; } foreach my $item (@which) { - if (defined($result->{$item})) { - return $result->{$item}; + if (defined($result->{$item->[0]})) { + return [$result->{$item->[0]},$item->[1]]; } } return undef; @@ -6568,24 +6706,27 @@ sub EXT { # ----------------------------------------------------------- first, check user my $userreply=&resdata($uname,$udom,'user', - ($courselevelr,$courselevelm, - $courselevel)); - if (defined($userreply)) { return $userreply; } + ([$courselevelr,'resource'], + [$courselevelm,'map' ], + [$courselevel, 'course' ])); + if (defined($userreply)) { return &get_reply($userreply); } # ------------------------------------------------ second, check some of course my $coursereply; if (@groups > 0) { $coursereply = &check_group_parms($courseid,\@groups,$symbparm, $mapparm,$spacequalifierrest); - if (defined($coursereply)) { return $coursereply; } + if (defined($coursereply)) { return &get_reply($coursereply); } } $coursereply=&resdata($env{'course.'.$courseid.'.num'}, - $env{'course.'.$courseid.'.domain'}, - 'course', - ($seclevelr,$seclevelm,$seclevel, - $courselevelr)); - if (defined($coursereply)) { return $coursereply; } + $env{'course.'.$courseid.'.domain'}, + 'course', + ([$seclevelr, 'resource'], + [$seclevelm, 'map' ], + [$seclevel, 'course' ], + [$courselevelr,'resource'])); + if (defined($coursereply)) { return &get_reply($coursereply); } # ------------------------------------------------------ third, check map parms my %parmhash=(); @@ -6596,7 +6737,7 @@ sub EXT { $thisparm=$parmhash{$symbparm}; untie(%parmhash); } - if ($thisparm) { return $thisparm; } + if ($thisparm) { return &get_reply([$thisparm,'resource']); } } # ------------------------------------------ fourth, look in resource metadata @@ -6609,18 +6750,19 @@ sub EXT { $filename=$env{'request.filename'}; } my $metadata=&metadata($filename,$spacequalifierrest); - if (defined($metadata)) { return $metadata; } + if (defined($metadata)) { return &get_reply([$metadata,'resource']); } $metadata=&metadata($filename,'parameter_'.$spacequalifierrest); - if (defined($metadata)) { return $metadata; } + if (defined($metadata)) { return &get_reply([$metadata,'resource']); } -# ---------------------------------------------- fourth, look in rest pf course +# ---------------------------------------------- fourth, look in rest of course if ($symbparm && defined($courseid) && $courseid eq $env{'request.course.id'}) { my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, $env{'course.'.$courseid.'.domain'}, 'course', - ($courselevelm,$courselevel)); - if (defined($coursereply)) { return $coursereply; } + ([$courselevelm,'map' ], + [$courselevel, 'course'])); + if (defined($coursereply)) { return &get_reply($coursereply); } } # ------------------------------------------------------------------ Cascade up unless ($space eq '0') { @@ -6628,14 +6770,13 @@ sub EXT { my $id=pop(@parts); my $part=join('_',@parts); if ($part eq '') { $part='0'; } - my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, + my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, $symbparm,$udom,$uname,$section,1); - if (defined($partgeneral)) { return $partgeneral; } + if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); } } if ($recurse) { return undef; } my $pack_def=&packages_tab_default($filename,$varname); - if (defined($pack_def)) { return $pack_def; } - + if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); } # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { # ----------------------------------------------------------------- environment @@ -6663,15 +6804,27 @@ sub EXT { return ''; } +sub get_reply { + my ($reply_value) = @_; + if (ref($reply_value) eq 'ARRAY') { + if (wantarray) { + return @$reply_value; + } + return $reply_value->[0]; + } else { + return $reply_value; + } +} + sub check_group_parms { my ($courseid,$groups,$symbparm,$mapparm,$what) = @_; my @groupitems = (); my $resultitem; - my @levels = ($symbparm,$mapparm,$what); + my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$what,'course']); foreach my $group (@{$groups}) { foreach my $level (@levels) { - my $item = $courseid.'.['.$group.'].'.$level; - push(@groupitems,$item); + my $item = $courseid.'.['.$group.'].'.$level->[0]; + push(@groupitems,[$item,$level->[1]]); } } my $coursereply = &resdata($env{'course.'.$courseid.'.num'}, @@ -6764,8 +6917,11 @@ sub metadata { if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || - ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || - ($uri =~ m|home/$match_username/public_html/|)) { + ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) ) { + return undef; + } + if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) + && &Apache::lonxml::get_state('target') =~ /^(|meta)$/) { return undef; } my $filename=$uri; @@ -6786,6 +6942,7 @@ sub metadata { # if (! exists($metacache{$uri})) { # $metacache{$uri}={}; # } + my $cachetime = 60*60; if ($liburi) { $liburi=&declutter($liburi); $filename=$liburi; @@ -6796,7 +6953,13 @@ sub metadata { my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } my $metastring; - if ($uri !~ m -^(editupload)/-) { + if ($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) { + my $which = &hreflocation('','/'.($liburi || $uri)); + $metastring = + &Apache::lonnet::ssi_body($which, + ('grade_target' => 'meta')); + $cachetime = 1; # only want this cached in the child not long term + } elsif ($uri !~ m -^(editupload)/-) { my $file=&filelocation('',&clutter($filename)); #push(@{$metaentry{$uri.'.file'}},$file); $metastring=&getfile($file); @@ -6963,7 +7126,7 @@ sub metadata { $metaentry{':keys'} = join(',',keys(%metathesekeys)); &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); - &do_cache_new('meta',$uri,\%metaentry,60*60); + &do_cache_new('meta',$uri,\%metaentry,$cachetime); # this is the end of "was not already recently cached } return $metaentry{':'.$what}; @@ -7911,7 +8074,13 @@ sub filelocation { } } $location=~s://+:/:g; # remove duplicate / - while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. + while ($location=~m{/\.\./}) { + if ($location =~ m{/[^/]+/\.\./}) { + $location=~ s{/[^/]+/\.\./}{/}g; + } else { + $location=~ s{/\.\./}{/}g; + } + } #remove dir/.. while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./ return $location; } @@ -8777,14 +8946,15 @@ explanation of a user role term =item * -get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) : +get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) : All arguments are optional. Returns a hash of a roles, either for co-author/assistant author roles for a user's Construction Space (default), or if $context is 'userroles', roles for the user himself, -In the hash, keys are set to colon-sparated $uname,$udom,and $role, -and value is set to colon-separated start and end times for the role. -If no username and domain are specified, will default to current -user/domain. Types, roles, and roledoms are references to arrays, +In the hash, keys are set to colon-separated $uname,$udom,$role, and +(optionally) if $withsec is true, a fourth colon-separated item - $section. +For each key, value is set to colon-separated start and end times for +the role. If no username and domain are specified, will default to +current user/domain. Types, roles, and roledoms are references to arrays of role statuses (active, future or previous), roles (e.g., cc,in, st etc.) and domains of the roles which can be used to restrict the list of roles reported. If no array ref is @@ -9231,6 +9401,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