--- loncom/lonnet/perl/lonnet.pm 2004/11/10 06:02:11 1.566
+++ loncom/lonnet/perl/lonnet.pm 2004/11/27 17:23:08 1.571
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.566 2004/11/10 06:02:11 banghart Exp $
+# $Id: lonnet.pm,v 1.571 2004/11/27 17:23:08 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -38,7 +38,7 @@ use vars
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom
%libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
%courselogs %accesshash %userrolehash $processmarker $dumpcount
- %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache
+ %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache
%userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);
@@ -1407,9 +1407,9 @@ sub finishuserfileupload {
# Save the file
{
#&Apache::lonnet::logthis("Saving to $filepath $file");
- open(my $fh,'>'.$filepath.'/'.$file);
- print $fh $ENV{'form.'.$formname};
- close($fh);
+ open(FH,'>'.$filepath.'/'.$file);
+ print FH $ENV{'form.'.$formname};
+ close(FH);
}
# Notify homeserver to grep it
#
@@ -1490,12 +1490,12 @@ sub flushcourselogs {
if ($courseidbuffer{$coursehombuf{$crsid}}) {
$courseidbuffer{$coursehombuf{$crsid}}.='&'.
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
- '='.&escape($courseinstcodebuf{$crsid});
+ ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid});
} else {
$courseidbuffer{$coursehombuf{$crsid}}=
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
- '='.&escape($courseinstcodebuf{$crsid});
- }
+ ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid});
+ }
}
#
# Write course id database (reverse lookup) to homeserver of courses
@@ -1570,6 +1570,8 @@ sub courselog {
$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
$courseinstcodebuf{$ENV{'request.course.id'}}=
$ENV{'course.'.$ENV{'request.course.id'}.'.internal.coursecode'};
+ $courseownerbuf{$ENV{'request.course.id'}}=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.internal.courseowner'};
if (defined $courselogs{$ENV{'request.course.id'}}) {
$courselogs{$ENV{'request.course.id'}}.='&'.$what;
} else {
@@ -1713,7 +1715,7 @@ sub courseidput {
}
sub courseiddump {
- my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_;
+ my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_;
my %returnhash=();
unless ($domfilter) { $domfilter=''; }
foreach my $tryserver (keys %libserv) {
@@ -1721,7 +1723,8 @@ sub courseiddump {
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
foreach (
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
- $sincefilter.':'.&escape($descfilter),
+ $sincefilter.':'.&escape($descfilter).':'.
+ &escape($instcodefilter).':'.&escape($ownerfilter),
$tryserver))) {
my ($key,$value)=split(/\=/,$_);
if (($key) && ($value)) {
@@ -2387,10 +2390,8 @@ sub rolesinit {
my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
my %allroles=();
- my %thesepriv=();
my $now=time;
my $userroles="user.login.time=$now\n";
- my $thesestr;
if ($rolesdump ne '') {
foreach (split(/&/,$rolesdump)) {
@@ -2398,94 +2399,21 @@ sub rolesinit {
my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;
my ($trole,$tend,$tstart)=split(/_/,$role);
- $userroles.='user.role.'.$trole.'.'.$area.'='.
- $tstart.'.'.$tend."\n";
-# log the associated role with the area
- &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
- if ($tend!=0) {
- if ($tend<$now) {
- $trole='';
- }
- }
- if ($tstart!=0) {
- if ($tstart>$now) {
- $trole='';
- }
- }
+ $userroles.=&set_arearole($trole,$area,$tstart,$tend);
+ if (($tend!=0) && ($tend<$now)) { $trole=''; }
+ if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
if (($area ne '') && ($trole ne '')) {
my $spec=$trole.'.'.$area;
my ($tdummy,$tdomain,$trest)=split(/\//,$area);
if ($trole =~ /^cr\//) {
- my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
- my $homsvr=homeserver($rauthor,$rdomain);
- if ($hostname{$homsvr} ne '') {
- my ($rdummy,$roledef)=
- &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
-
- if (($rdummy ne 'con_lost') && ($roledef ne '')) {
- my ($syspriv,$dompriv,$coursepriv)=
- split(/\_/,$roledef);
- if (defined($syspriv)) {
- $allroles{'cm./'}.=':'.$syspriv;
- $allroles{$spec.'./'}.=':'.$syspriv;
- }
- if ($tdomain ne '') {
- if (defined($dompriv)) {
- $allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
- $allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
- }
- if ($trest ne '') {
- if (defined($coursepriv)) {
- $allroles{'cm.'.$area}.=':'.$coursepriv;
- $allroles{$spec.'.'.$area}.=':'.$coursepriv;
- }
- }
- }
- }
- }
+ &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
} else {
- if (defined($pr{$trole.':s'})) {
- $allroles{'cm./'}.=':'.$pr{$trole.':s'};
- $allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
- }
- if ($tdomain ne '') {
- if (defined($pr{$trole.':d'})) {
- $allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
- $allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
- }
- if ($trest ne '') {
- if (defined($pr{$trole.':c'})) {
- $allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
- $allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
- }
- }
- }
+ &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
}
}
}
}
- my $adv=0;
- my $author=0;
- foreach (keys %allroles) {
- %thesepriv=();
- if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
- foreach (split(/:/,$allroles{$_})) {
- if ($_ ne '') {
- my ($privilege,$restrictions)=split(/&/,$_);
- if ($restrictions eq '') {
- $thesepriv{$privilege}='F';
- } else {
- if ($thesepriv{$privilege} ne 'F') {
- $thesepriv{$privilege}.=$restrictions;
- }
- }
- if ($thesepriv{'adv'} eq 'F') { $adv=1; }
- }
- }
- $thesestr='';
- foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
- $userroles.='user.priv.'.$_.'='.$thesestr."\n";
- }
+ my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
$userroles.='user.adv='.$adv."\n".
'user.author='.$author."\n";
$ENV{'user.adv'}=$adv;
@@ -2493,6 +2421,84 @@ sub rolesinit {
return $userroles;
}
+sub set_arearole {
+ my ($trole,$area,$tstart,$tend,$domain,$username) = @_;
+# log the associated role with the area
+ &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
+ return 'user.role.'.$trole.'.'.$area.'='.$tstart.'.'.$tend."\n";
+}
+
+sub custom_roleprivs {
+ my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
+ my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
+ my $homsvr=homeserver($rauthor,$rdomain);
+ if ($hostname{$homsvr} ne '') {
+ my ($rdummy,$roledef)=
+ &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
+ if (($rdummy ne 'con_lost') && ($roledef ne '')) {
+ my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
+ if (defined($syspriv)) {
+ $$allroles{'cm./'}.=':'.$syspriv;
+ $$allroles{$spec.'./'}.=':'.$syspriv;
+ }
+ if ($tdomain ne '') {
+ if (defined($dompriv)) {
+ $$allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
+ $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
+ }
+ if (($trest ne '') && (defined($coursepriv))) {
+ $$allroles{'cm.'.$area}.=':'.$coursepriv;
+ $$allroles{$spec.'.'.$area}.=':'.$coursepriv;
+ }
+ }
+ }
+ }
+}
+
+
+sub standard_roleprivs {
+ my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
+ if (defined($pr{$trole.':s'})) {
+ $$allroles{'cm./'}.=':'.$pr{$trole.':s'};
+ $$allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
+ }
+ if ($tdomain ne '') {
+ if (defined($pr{$trole.':d'})) {
+ $$allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
+ $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
+ }
+ if (($trest ne '') && (defined($pr{$trole.':c'}))) {
+ $$allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
+ $$allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
+ }
+ }
+}
+
+sub set_userprivs {
+ my ($userroles,$allroles) = @_;
+ my $author=0;
+ my $adv=0;
+ foreach (keys %{$allroles}) {
+ my %thesepriv=();
+ if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
+ foreach (split(/:/,$$allroles{$_})) {
+ if ($_ ne '') {
+ my ($privilege,$restrictions)=split(/&/,$_);
+ if ($restrictions eq '') {
+ $thesepriv{$privilege}='F';
+ } elsif ($thesepriv{$privilege} ne 'F') {
+ $thesepriv{$privilege}.=$restrictions;
+ }
+ if ($thesepriv{'adv'} eq 'F') { $adv=1; }
+ }
+ }
+ my $thesestr='';
+ foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
+ $$userroles.='user.priv.'.$_.'='.$thesestr."\n";
+ }
+ return ($author,$adv);
+}
+
# --------------------------------------------------------------- get interface
sub get {
@@ -3684,7 +3690,7 @@ sub writecoursepref {
# ---------------------------------------------------------- Make/modify course
sub createcourse {
- my ($udom,$description,$url,$course_server,$nonstandard,$inst_code)=@_;
+ my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner)=@_;
$url=&declutter($url);
my $cid='';
unless (&allowed('ccc',$udom)) {
@@ -3719,7 +3725,7 @@ sub createcourse {
# ----------------------------------------------------------------- Course made
# log existence
&courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).
- '='.&escape($inst_code),$uhome);
+ ':'.&escape($inst_code).':'.&escape($course_owner),$uhome);
&flushcourselogs();
# set toplevel url
my $topurl=$url;
@@ -4707,7 +4713,7 @@ sub symbverify {
sub symbclean {
my $symb=shift;
-
+ if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); }
# remove version from map
$symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/;
@@ -4728,7 +4734,9 @@ sub encode_symb {
}
sub decode_symb {
- my ($map,$resid,$url)=split(/\_\_\_/,shift);
+ my $symb=shift;
+ if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); }
+ my ($map,$resid,$url)=split(/___/,$symb);
return (&fixversion($map),$resid,&fixversion($url));
}
@@ -4777,6 +4785,7 @@ sub symbread {
}
$thisfn=$ENV{'request.filename'};
}
+ if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
# is that filename actually a symb? Verify, clean, and return
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
if (&symbverify($thisfn,$1)) {
@@ -5327,6 +5336,7 @@ sub current_machine_ids {
sub declutter {
my $thisfn=shift;
+ if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$thisfn=~s/^\///;
$thisfn=~s/^res\///;
@@ -5562,7 +5572,7 @@ $readit=1;
{
use integer;
my $test=(2**32)+1;
- if ($test != 0) { $_64bit=1; }
+ if ($test != 0) { $_64bit=1; } else { $_64bit=0; }
&logthis(" Detected 64bit platform ($_64bit)");
}
}