--- loncom/lonnet/perl/lonnet.pm 2003/03/26 04:57:04 1.353
+++ loncom/lonnet/perl/lonnet.pm 2003/04/12 15:58:43 1.361
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.353 2003/03/26 04:57:04 www Exp $
+# $Id: lonnet.pm,v 1.361 2003/04/12 15:58:43 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -634,7 +634,7 @@ sub generate_access_keys {
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
$cnum=
$ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
- unless (&allowed('ccc',$cdom)) { return 0; }
+ unless (&allowed('mky',$cdom)) { return 0; }
unless (($cdom) && ($cnum)) { return 0; }
if ($number>10000) { return 0; }
sleep(2); # make sure don't get same seed twice
@@ -1149,6 +1149,14 @@ sub countacc {
}
}
+sub linklog {
+ my ($from,$to)=@_;
+ $from=&declutter($from);
+ $to=&declutter($to);
+ $accesshash{$from.'___'.$to.'___comefrom'}=1;
+ $accesshash{$to.'___'.$from.'___goto'}=1;
+}
+
sub userrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
if (($trole=~/^ca/) || ($trole=~/^in/) ||
@@ -1198,11 +1206,13 @@ sub courseidput {
sub courseiddump {
my ($domfilter,$descfilter,$sincefilter)=@_;
my %returnhash=();
+ unless ($domfilter) { $domfilter=''; }
foreach my $tryserver (keys %libserv) {
- if ($hostdom{$tryserver}=~/$domfilter/) {
+ if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
foreach (
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
- $sincefilter.':'.&escape($descfilter)))) {
+ $sincefilter.':'.&escape($descfilter),
+ $tryserver))) {
my ($key,$value)=split(/\=/,$_);
if (($key) && ($value)) {
$returnhash{&unescape($key)}=&unescape($value);
@@ -2548,7 +2558,7 @@ sub plaintext {
# ----------------------------------------------------------------- Assign Role
sub assignrole {
- my ($udom,$uname,$url,$role,$end,$start)=@_;
+ my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;
my $mrole;
if ($role =~ /^cr\//) {
unless (&allowed('ccr',$url)) {
@@ -2579,7 +2589,20 @@ sub assignrole {
$command.='_0_'.$start;
}
}
+# actually delete
+ if ($deleteflag) {
+ if (&allowed('dro',$udom)) {
+# modify command to delete the role
+ $command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:".
+ "$udom:$uname:$url".'_'."$mrole";
+# set start and finish to negative values for userrolelog
+ $start=-1;
+ $end=-1;
+ }
+ }
+# send command
my $answer=&reply($command,&homeserver($uname,$udom));
+# log new user role if status is ok
if ($answer eq 'ok') {
&userrolelog($mrole,$uname,$udom,$url,$start,$end);
}
@@ -2829,6 +2852,11 @@ sub createcourse {
return 'error: no such course';
}
# ----------------------------------------------------------------- Course made
+# log existance
+ &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description),
+ $uhome);
+ &flushcourselogs();
+# set toplevel url
my $topurl=$url;
unless ($nonstandard) {
# ------------------------------------------ For standard courses, make top url
@@ -2857,25 +2885,26 @@ ENDINITMAP
# ---------------------------------------------------------- Assign Custom Role
sub assigncustomrole {
- my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start)=@_;
+ my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag)=@_;
return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
- $end,$start);
+ $end,$start,$deleteflag);
}
# ----------------------------------------------------------------- Revoke Role
sub revokerole {
- my ($udom,$uname,$url,$role)=@_;
+ my ($udom,$uname,$url,$role,$deleteflag)=@_;
my $now=time;
- return &assignrole($udom,$uname,$url,$role,$now);
+ return &assignrole($udom,$uname,$url,$role,$now,$deleteflag);
}
# ---------------------------------------------------------- Revoke Custom Role
sub revokecustomrole {
- my ($udom,$uname,$url,$rdom,$rnam,$rolename)=@_;
+ my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag)=@_;
my $now=time;
- return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now);
+ return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now,
+ $deleteflag);
}
# ------------------------------------------------------------ Directory lister
@@ -3073,8 +3102,10 @@ sub EXT {
unless ($varname) { return ''; }
#get real user name/domain, courseid and symb
my $courseid;
+ my $publicuser;
if (!($uname && $udom)) {
- (my $cursymb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+ (my $cursymb,$courseid,$udom,$uname,$publicuser)=
+ &Apache::lonxml::whichuser();
if (!$symbparm) { $symbparm=$cursymb; }
} else {
$courseid=$ENV{'request.course.id'};
@@ -3097,7 +3128,12 @@ sub EXT {
if (defined($Apache::lonhomework::parsing_a_problem)) {
return $Apache::lonhomework::history{$qualifierrest};
} else {
- my %restored=&restore($symbparm,$courseid,$udom,$uname);
+ my %restored;
+ if ($publicuser || $ENV{'request.state'} eq 'construct') {
+ %restored=&tmprestore($symbparm,$courseid,$udom,$uname);
+ } else {
+ %restored=&restore($symbparm,$courseid,$udom,$uname);
+ }
return $restored{$qualifierrest};
}
# ----------------------------------------------------------------- user.access
@@ -3110,7 +3146,11 @@ sub EXT {
($udom eq $ENV{'user.domain'})) {
return $ENV{join('.',('environment',$qualifierrest))};
} else {
- my %returnhash=&userenvironment($udom,$uname,$qualifierrest);
+ my %returnhash;
+ if (!$publicuser) {
+ %returnhash=&userenvironment($udom,$uname,
+ $qualifierrest);
+ }
return $returnhash{$qualifierrest};
}
# ----------------------------------------------------------------- user.course
@@ -3134,8 +3174,11 @@ sub EXT {
return $uname;
# ---------------------------------------------------- Any other user namespace
} else {
- my %reply=&get($space,[$qualifierrest],$udom,$uname);
- return $reply{$qualifierrest};
+ my %reply;
+ if (!$publicuser) {
+ %reply=&get($space,[$qualifierrest],$udom,$uname);
+ }
+ return $reply{$qualifierrest};
}
} elsif ($realm eq 'query') {
# ---------------------------------------------- pull stuff out of query string
@@ -3154,7 +3197,7 @@ sub EXT {
return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};
} elsif ($realm eq 'resource') {
- if ($courseid eq $ENV{'request.course.id'}) {
+ if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {
#print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
@@ -3354,16 +3397,20 @@ sub metadata {
$value.=' [Part: '.$part.']';
}
my $unikey='parameter'.$keyroot.'_'.$name;
- if ($subp eq 'default') { $unikey='parameter_0_'.$name; }
- $metathesekeys{$unikey}=1;
- $metacache{$uri.':'.$unikey.'.part'}=$part;
+ if ($subp eq 'default') {
+ $unikey='parameter_0_'.$name;
+ $metacache{$uri.':'.$unikey.'.part'}='0';
+ } else {
+ $metacache{$uri.':'.$unikey.'.part'}=$part;
+ $metathesekeys{$unikey}=1;
+ }
unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
$metacache{$uri.':'.$unikey.'.'.$subp}=$value;
}
if (defined($metacache{$uri.':'.$unikey.'.default'})) {
$metacache{$uri.':'.$unikey}=
- $metacache{$uri.':'.$unikey.'.default'}
- }
+ $metacache{$uri.':'.$unikey.'.default'};
+ }
}
}
} else {
@@ -3459,7 +3506,7 @@ sub metadata_generate_part0 {
if ($metakey=~/^parameter\_(.*)/) {
my $part=$$metacache{$uri.':'.$metakey.'.part'};
my $name=$$metacache{$uri.':'.$metakey.'.name'};
- if (! exists($$metadata{'parameter_0_'.$name})) {
+ if (! exists($$metadata{'parameter_0_'.$name.'.name'})) {
$allnames{$name}=$part;
}
}