--- loncom/lonnet/perl/lonnet.pm 2006/05/30 12:47:18 1.740 +++ loncom/lonnet/perl/lonnet.pm 2006/06/07 18:41:57 1.745 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.740 2006/05/30 12:47:18 www Exp $ +# $Id: lonnet.pm,v 1.745 2006/06/07 18:41:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -38,7 +38,7 @@ use vars qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom %libserv %pr %prp $memcache %packagetab %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount - %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf + %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf %domaindescription %domain_auth_def %domain_auth_arg_def %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary $tmpdir $_64bit %env); @@ -1387,7 +1387,22 @@ sub userfileupload { open(my $fh,'>'.$fullpath.'/'.$fname); print $fh $env{'form.'.$formname}; close($fh); - return $fullpath.'/'.$fname; + return $fullpath.'/'.$fname; + } elsif (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) { #files uploaded to create course page are handled differently + my $filepath = 'tmp/addcourse/'.$destudom.'/web/'.$env{'user.name'}. + '_'.$env{'user.domain'}.'/pending'; + my @parts=split(/\//,$filepath); + my $fullpath = $perlvar{'lonDaemons'}; + for (my $i=0;$i<@parts;$i++) { + $fullpath .= '/'.$parts[$i]; + if ((-e $fullpath)!=1) { + mkdir($fullpath,0777); + } + } + open(my $fh,'>'.$fullpath.'/'.$fname); + print $fh $env{'form.'.$formname}; + close($fh); + return $fullpath.'/'.$fname; } # Create the directory if not present @@ -1651,11 +1666,11 @@ sub flushcourselogs { if ($courseidbuffer{$coursehombuf{$crsid}}) { $courseidbuffer{$coursehombuf{$crsid}}.='&'. &escape($crsid).'='.&escape($coursedescrbuf{$crsid}). - ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}); + ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid}); } else { $courseidbuffer{$coursehombuf{$crsid}}= &escape($crsid).'='.&escape($coursedescrbuf{$crsid}). - ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}); + ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid}); } } # @@ -1758,6 +1773,8 @@ sub courselog { $env{'course.'.$env{'request.course.id'}.'.internal.coursecode'}; $courseownerbuf{$env{'request.course.id'}}= $env{'course.'.$env{'request.course.id'}.'.internal.courseowner'}; + $coursetypebuf{$env{'request.course.id'}}= + $env{'course.'.$env{'request.course.id'}.'.type'}; if (defined $courselogs{$env{'request.course.id'}}) { $courselogs{$env{'request.course.id'}}.='&'.$what; } else { @@ -1928,7 +1945,7 @@ sub courseidput { } sub courseiddump { - my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref)=@_; + my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter)=@_; my %returnhash=(); unless ($domfilter) { $domfilter=''; } foreach my $tryserver (keys %libserv) { @@ -1937,7 +1954,7 @@ sub courseiddump { foreach ( split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. $sincefilter.':'.&escape($descfilter).':'. - &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter), + &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter), $tryserver))) { my ($key,$value)=split(/\=/,$_); if (($key) && ($value)) { @@ -2640,6 +2657,9 @@ sub coursedescription { $returnhash{'home'}= $chome; $returnhash{'domain'} = $cdomain; $returnhash{'num'} = $cnum; + if (!defined($returnhash{'type'})) { + $returnhash{'type'} = 'Course'; + } while (my ($name,$value) = each %returnhash) { $envhash{'course.'.$normalid.'.'.$name}=$value; } @@ -2696,7 +2716,7 @@ sub rolesinit { my %allroles=(); my %allgroups=(); my $now=time; - my $userroles="user.login.time=$now\n"; + my %userroles = ('user.login.time' => $now); my $group_privs; if ($rolesdump ne '') { @@ -2719,7 +2739,9 @@ sub rolesinit { } else { ($trole,$tend,$tstart)=split(/_/,$role); } - $userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username); + my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, + $username); + @userroles{keys(%new_role)} = @new_role{keys(%new_role)}; if (($tend!=0) && ($tend<$now)) { $trole=''; } if (($tstart!=0) && ($tstart>$now)) { $trole=''; } if (($area ne '') && ($trole ne '')) { @@ -2735,19 +2757,19 @@ sub rolesinit { } } } - my ($author,$adv) = &set_userprivs(\$userroles,\%allroles,\%allgroups); - $userroles.='user.adv='.$adv."\n". - 'user.author='.$author."\n"; + my ($author,$adv) = &set_userprivs(\%userroles,\%allroles,\%allgroups); + $userroles{'user.adv'} = $adv; + $userroles{'user.author'} = $author; $env{'user.adv'}=$adv; } - return $userroles; + 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"; + return ('user.role.'.$trole.'.'.$area => $tstart.'.'.$tend); } sub custom_roleprivs { @@ -2849,7 +2871,7 @@ sub set_userprivs { } my $thesestr=''; foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } - $$userroles.='user.priv.'.$_.'='.$thesestr."\n"; + $userroles->{'user.priv.'.$_} = $thesestr; } return ($author,$adv); } @@ -4077,8 +4099,25 @@ sub devalidate_getgroups_cache { # ------------------------------------------------------------------ Plain Text sub plaintext { - my $short=shift; - return &Apache::lonlocal::mt($prp{$short}); + my ($short,$type,$cid) = @_; + if (!defined($cid)) { + $cid = $env{'request.course.id'}; + } + if (defined($cid) && defined($env{'course.'.$cid.'.'.$short.'.plaintext'})) { + return &Apache::lonlocal::mt($env{'course.'.$cid.'.'.$short. + '.plaintext'}); + } + my %rolenames = ( + Course => 'std', + Group => 'alt1', + ); + if (defined($type) && + defined($rolenames{$type}) && + defined($prp{$short}{$rolenames{$type}})) { + return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}}); + } else { + return &Apache::lonlocal::mt($prp{$short}{'std'}); + } } # ----------------------------------------------------------------- Assign Role @@ -4407,7 +4446,8 @@ sub writecoursepref { # ---------------------------------------------------------- Make/modify course sub createcourse { - my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner)=@_; + my ($udom,$description,$url,$course_server,$nonstandard,$inst_code, + $course_owner,$crstype)=@_; $url=&declutter($url); my $cid=''; unless (&allowed('ccc',$udom)) { @@ -4444,7 +4484,8 @@ sub createcourse { # ----------------------------------------------------------------- Course made # log existence &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description). - ':'.&escape($inst_code).':'.&escape($course_owner),$uhome); + ':'.&escape($inst_code).':'.&escape($course_owner).':'. + &escape($crstype),$uhome); &flushcourselogs(); # set toplevel url my $topurl=$url; @@ -4515,8 +4556,19 @@ sub is_locked { my ($tmp)=keys(%locked); if ($tmp=~/^error:/) { undef(%locked); } + if (ref($locked{$file_name}) eq 'ARRAY') { - $is_locked = 'true'; + $is_locked = 'false'; + foreach my $entry (@{$locked{$file_name}}) { + if (ref($entry) eq 'ARRAY') { + if ($$entry[0] eq 'access' || $$entry[0] eq 'accesscount') { + next; + } else { + $is_locked = 'true'; + last; + } + } + } } else { $is_locked = 'false'; } @@ -4605,44 +4657,108 @@ sub files_not_in_path { return (@return_files); } -#--------------------------------------------------------------Get Marked as Read Only +#----------------------------------------------Get portfolio file permissions - -sub get_marked_as_readonly { - my ($domain,$user,$what) = @_; +sub get_portfile_permissions { + my ($domain,$user) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } + return \%current_permissions; +} + +#---------------------------------------------Get portfolio file access controls + +sub get_access_controls { + my ($current_permissions,$group,$file) = @_; + my @access_checks = (); + my %access; + if (defined($file)) { + @access_checks = ($file); + } else { + @access_checks = keys(%{$current_permissions}); + } + foreach my $file_name (@access_checks) { + my $value = $$current_permissions{$file_name}; + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } + if (ref($value) eq "ARRAY") { + foreach my $stored_what (@{$value}) { + if (ref($stored_what) eq 'ARRAY') { + if ($$stored_what[0] eq 'access') { + if (!defined($access{$file_name})) { + %{$access{$file_name}} = (); + } + $access{$file_name}{$$stored_what[1]}=$$stored_what[2]; + } else { + next; + } + } + } + } + } + return %access; +} + +#------------------------------------------------------Get Marked as Read Only + +sub get_marked_as_readonly { + my ($domain,$user,$what,$group) = @_; + my $current_permissions = &get_portfile_permissions($domain,$user); my @readonly_files; my $cmp1=$what; if (ref($what)) { $cmp1=join('',@{$what}) }; - while (my ($file_name,$value) = each(%current_permissions)) { + while (my ($file_name,$value) = each(%{$current_permissions})) { + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { my $cmp2=$stored_what; - if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) }; + if (ref($stored_what)) { + if ($$stored_what[0] eq 'access' || + $$stored_what[0] eq 'accesscount') { + next; + } else { + $cmp2=join('',@{$stored_what}); + } + } if ($cmp1 eq $cmp2) { push(@readonly_files, $file_name); + last; } elsif (!defined($what)) { push(@readonly_files, $file_name); + last; } } - } + } } return @readonly_files; } #-----------------------------------------------------------Get Marked as Read Only Hash sub get_marked_as_readonly_hash { - my ($domain,$user,$what) = @_; - my %current_permissions = &dump('file_permissions',$domain,$user); - my ($tmp)=keys(%current_permissions); - if ($tmp=~/^error:/) { undef(%current_permissions); } - + my ($current_permissions,$group,$what) = @_; my %readonly_files; - while (my ($file_name,$value) = each(%current_permissions)) { + while (my ($file_name,$value) = each(%{$current_permissions})) { + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { + if (ref($stored_what) eq 'ARRAY') { + if ($$stored_what[0] eq 'access' || + $$stored_what[0] eq 'accesscount') { + next; + } + } if ($stored_what eq $what) { $readonly_files{$file_name} = 'locked'; } elsif (!defined($what)) { @@ -4658,13 +4774,13 @@ sub get_marked_as_readonly_hash { sub unmark_as_readonly { # unmarks $file_name (if $file_name is defined), or all files locked by $what # for portfolio submissions, $what contains [$symb,$crsid] - my ($domain,$user,$what,$file_name) = @_; + my ($domain,$user,$what,$file_name,$group) = @_; my $symb_crs = $what; if (ref($what)) { $symb_crs=join('',@$what); } - my %current_permissions = &dump('file_permissions',$domain,$user); + my %current_permissions = &dump('file_permissions',$domain,$user,$group); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } - my @readonly_files = &get_marked_as_readonly($domain,$user,$what); + my @readonly_files = &get_marked_as_readonly($domain,$user,$what,$group); foreach my $file (@readonly_files) { if (defined($file_name) && ($file_name ne $file)) { next; } my $current_locks = $current_permissions{$file}; @@ -4673,7 +4789,14 @@ sub unmark_as_readonly { if (ref($current_locks) eq "ARRAY"){ foreach my $locker (@{$current_locks}) { my $compare=$locker; - if (ref($locker)) { $compare=join('',@{$locker}) }; + if (ref($locker) eq 'ARRAY') { + if ($$locker[0] eq 'access' || + $$locker[0] eq 'accesscount') { + push(@new_locks,$locker); + next; + } + $compare=join('',@{$locker}); + } if ($compare ne $symb_crs) { push(@new_locks, $locker); } @@ -5076,8 +5199,14 @@ sub EXT { if ( (defined($Apache::lonhomework::parsing_a_problem) || defined($Apache::lonhomework::parsing_a_task)) && - ($symbparm eq &symbread()) ) { - return $Apache::lonhomework::history{$qualifierrest}; + ($symbparm eq &symbread()) ) { + # if we are in the middle of processing the resource the + # get the value we are planning on committing + if (defined($Apache::lonhomework::results{$qualifierrest})) { + return $Apache::lonhomework::results{$qualifierrest}; + } else { + return $Apache::lonhomework::history{$qualifierrest}; + } } else { my %restored; if ($publicuser || $env{'request.state'} eq 'construct') { @@ -6757,8 +6886,14 @@ sub get_iphost { while (my $configline=<$config>) { chomp($configline); if ($configline) { - my ($short,$plain)=split(/:/,$configline); - if ($plain ne '') { $prp{$short}=$plain; } + my ($short,@plain)=split(/:/,$configline); + %{$prp{$short}} = (); + if (@plain > 0) { + $prp{$short}{'std'} = $plain[0]; + for (my $i=1; $i<@plain; $i++) { + $prp{$short}{'alt'.$i} = $plain[$i]; + } + } } } close($config);