--- loncom/lonnet/perl/lonnet.pm 2004/11/08 19:19:12 1.564 +++ loncom/lonnet/perl/lonnet.pm 2004/12/04 02:14:19 1.572 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.564 2004/11/08 19:19:12 albertel Exp $ +# $Id: lonnet.pm,v 1.572 2004/12/04 02:14:19 banghart 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); @@ -1188,8 +1188,7 @@ sub ssi_body { my ($filelink,%form)=@_; my $output=($filelink=~/^http\:/?&externalssi($filelink): &ssi($filelink,%form)); - $output=~ - s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs; + $output=~s|//(\s*)?\s||gs; $output=~s/^.*?\]*\>//si; $output=~s/(.*)\<\/body\s*\>.*?$/$1/si; return $output; @@ -1408,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 # @@ -1491,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 @@ -1571,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 { @@ -1714,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) { @@ -1722,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)) { @@ -2388,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)) { @@ -2399,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; @@ -2494,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 { @@ -3685,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)) { @@ -3720,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; @@ -3781,6 +3786,20 @@ sub diskusage { return $listing; } +sub is_locked { + my ($file_name, $domain, $user) = @_; + my @check; + my $is_locked; + push @check, $file_name; + my %locked = &Apache::lonnet::get('file_permissions',\@check, + $ENV{'user.domain'},$ENV{'user.name'}); + if (ref($locked{$file_name}) eq 'ARRAY') { + $is_locked = 'true'; + } else { + $is_locked = 'false'; + } +} + # ------------------------------------------------------------- Mark as Read Only sub mark_as_readonly { @@ -3793,6 +3812,52 @@ sub mark_as_readonly { return; } +# ------------------------------------------------------------Save Selected Files + +sub save_selected_files { + my ($user, $path, @files) = @_; + my $filename = $user."savedfiles"; + open OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; + foreach (@files) { + print OUT $ENV{'form.currentpath'}.$_."\n"; + } + close OUT; + return 'ok'; +} + +sub files_in_path { + my ($user, $path) = @_; + my $filename = $user."savedfiles"; + my %return_files; + open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; + return \%return_files; +} + +# called in portfolio select mode, to show files selected NOT in current directory +sub files_not_in_path { + my ($user, $path) = @_; + my $filename = $user."savedfiles"; + my @return_files; + my $path_part; + open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; + while () { + #ok, I know it's clunky, but I want it to work + my @paths_and_file = split m!/!, $_; + my $file_part = pop @paths_and_file; + my $path_part = join '/', @paths_and_file; + $path_part .= '/'; + my $path_and_file = $path_part.$file_part; + if ($path_part ne $path) { + push @return_files, ($path_and_file); + &logthis("path part is $path_part file is $file_part"); + } else { + &logthis("path part is $path_part file is $file_part"); + } + } + close OUT; + return @return_files; +} + #--------------------------------------------------------------Get Marked as Read Only sub get_marked_as_readonly { @@ -3800,16 +3865,12 @@ sub get_marked_as_readonly { my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); my @readonly_files; while (my ($file_name,$value) = each(%current_permissions)) { - &logthis("found $file_name"); if (ref($value) eq "ARRAY"){ - &logthis("found array"); foreach my $stored_what (@{$value}) { if ($stored_what eq $what) { push(@readonly_files, $file_name); - &logthis("defined pushed $file_name"); } elsif (!defined($what)) { push(@readonly_files, $file_name); - &logthis("undef pushed $file_name"); } } } @@ -4698,7 +4759,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\_\_\_/; @@ -4719,7 +4780,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)); } @@ -4768,6 +4831,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)) { @@ -5318,6 +5382,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\///; @@ -5553,7 +5618,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)"); } }