--- loncom/lonnet/perl/lonnet.pm 2006/01/05 19:39:52 1.683.2.5 +++ loncom/lonnet/perl/lonnet.pm 2005/11/22 02:24:55 1.684 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.683.2.5 2006/01/05 19:39:52 albertel Exp $ +# $Id: lonnet.pm,v 1.684 2005/11/22 02:24:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,8 +40,8 @@ qw(%perlvar %hostname %badServerCache %i %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %domaindescription %domain_auth_def %domain_auth_arg_def - %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary - $tmpdir $_64bit %env); + %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit + %env); use IO::Socket; use GDBM_File; @@ -1853,25 +1853,28 @@ sub courseiddump { # ---------------------------------------------------------- DC e-mail sub dcmailput { - my ($domain,$msgid,$message,$server)=@_; + my ($domain,$msgid,$contents,$server)=@_; my $status = &Apache::lonnet::critical( 'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($message),$server); + &Apache::lonnet::escape($$contents{$server}),$server); return $status; } sub dcmaildump { my ($dom,$startdate,$enddate,$senders) = @_; - my %returnhash=(); - if (exists($domain_primary{$dom})) { - my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'. - &escape($enddate).':'; - my @esc_senders=map { &escape($_)} @$senders; - $cmd.=&escape(join('&',@esc_senders)); - foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) { - my ($key,$value) = split(/\=/,$_); - if (($key) && ($value)) { - $returnhash{&unescape($key)} = &unescape($value); + my %returnhash=(); + foreach my $tryserver (keys(%libserv)) { + if ($hostdom{$tryserver} eq $dom) { + %{$returnhash{$tryserver}}=(); + my $cmd='dcmaildump:'.$dom.':'. + &escape($startdate).':'.&escape($enddate).':'; + my @esc_senders=map { &escape($_)} @$senders; + $cmd.=&escape(join('&',@esc_senders)); + foreach (split(/\&/,&reply($cmd,$tryserver))) { + my ($key,$value) = split(/\=/,$_); + if (($key) && ($value)) { + $returnhash{$tryserver}{&unescape($key)} = &unescape($value); + } } } } @@ -3010,9 +3013,8 @@ sub tmpput { # ------------------------------------------------------------ tmpget interface sub tmpget { - my ($token,$server)=@_; - if (!defined($server)) { $server = $perlvar{'lonHostID'}; } - my $rep=&reply("tmpget:$token",$server); + my ($token)=@_; + my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'}); my %returnhash; foreach my $item (split(/\&/,$rep)) { my ($key,$value)=split(/=/,$item); @@ -3021,13 +3023,6 @@ sub tmpget { return %returnhash; } -# ------------------------------------------------------------ tmpget interface -sub tmpdel { - my ($token,$server)=@_; - if (!defined($server)) { $server = $perlvar{'lonHostID'}; } - return &reply("tmpdel:$token",$server); -} - # ---------------------------------------------- Custom access rule evaluation sub customaccess { @@ -3346,21 +3341,17 @@ sub allowed { my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} =~/\Q$rolecode\E/) { - if ($priv ne 'pch') { - &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. - 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. - $env{'request.course.id'}); - } + &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. + 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. + $env{'request.course.id'}); return ''; } if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} =~/\Q$unamedom\E/) { - if ($priv ne 'pch') { - &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. - 'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. - $env{'request.course.id'}); - } + &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. + 'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. + $env{'request.course.id'}); return ''; } } @@ -3370,11 +3361,9 @@ sub allowed { if ($thisallowed=~/R/) { my $rolecode=(split(/\./,$env{'request.role'}))[0]; if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { - if ($priv ne 'pch') { - &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. - 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); - } - return ''; + &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. + 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); + return ''; } } @@ -3729,6 +3718,10 @@ sub modify_group_roles { my $role = 'gr/'.&escape($userprivs); my ($uname,$udom) = split(/:/,$user); my $result = &assignrole($udom,$uname,$url,$role,$end,$start); + if ($result eq 'ok') { + &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum); + } + return $result; } @@ -4812,7 +4805,8 @@ sub EXT { return $env{'course.'.$courseid.'.'.$spacequalifierrest}; } elsif ($realm eq 'resource') { - my $section; + my ($section,$group); + my @groups = (); if (defined($courseid) && $courseid eq $env{'request.course.id'}) { if (!$symbparm) { $symbparm=&symbread(); } } @@ -4832,14 +4826,29 @@ sub EXT { if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { $section=$env{'request.course.sec'}; + @groups=split(/:/,$env{'request.course.groups'}); + if (@groups > 0) { + @groups = sort(@groups); + $group = $groups[0]; + } } else { if (! defined($usection)) { $section=&getsection($udom,$uname,$courseid); } else { $section = $usection; } + my $grouplist = &get_users_groups($udom,$uname,$courseid); + if ($grouplist) { + @groups = split(/:/,$grouplist); + @groups = sort(@groups); + $group = $groups[0]; + } } + my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest; + my $grplevelr=$courseid.'.['.$group.'].'.$symbparm; + my $grplevelm=$courseid.'.['.$group.'].'.$mapparm; + my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; my $seclevelr=$courseid.'.['.$section.'].'.$symbparm; my $seclevelm=$courseid.'.['.$section.'].'.$mapparm; @@ -4857,8 +4866,17 @@ sub EXT { if (defined($userreply)) { return $userreply; } # ------------------------------------------------ second, check some of course + my $coursereply; + if (defined($group)) { + $coursereply = &resdata($env{'course.'.$courseid.'.num'}, + $env{'course.'.$courseid.'.domain'}, + 'course', + ($grplevelr,$grplevelm,$grplevel, + $courselevelr)); + if (defined($coursereply)) { return $coursereply; } + } - my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, + $coursereply=&resdata($env{'course.'.$courseid.'.num'}, $env{'course.'.$courseid.'.domain'}, 'course', ($seclevelr,$seclevelm,$seclevel, @@ -5423,9 +5441,6 @@ sub symbread { if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { $targetfn = 'adm/wrapper/'.$thisfn; } - if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) { - $targetfn=$1; - } if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', &GDBM_READER(),0640)) { $syval=$hash{$targetfn}; @@ -6199,7 +6214,7 @@ BEGIN { # next if /^\#/; chomp; my ($domain, $domain_description, $def_auth, $def_auth_arg, - $def_lang, $city, $longi, $lati, $primary) = split(/:/,$_); + $def_lang, $city, $longi, $lati) = split(/:/,$_); $domain_auth_def{$domain}=$def_auth; $domain_auth_arg_def{$domain}=$def_auth_arg; $domaindescription{$domain}=$domain_description; @@ -6207,7 +6222,6 @@ BEGIN { $domain_city{$domain}=$city; $domain_longi{$domain}=$longi; $domain_lati{$domain}=$lati; - $domain_primary{$domain}=$primary; # &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}"); # &logthis("Domain.tab: $domain ".$domaindescription{$domain} ); @@ -6234,7 +6248,7 @@ BEGIN { } close($config); # FIXME: dev server don't want this, production servers _do_ want this - &get_iphost(); + #&get_iphost(); } sub get_iphost {