--- loncom/lonnet/perl/lonnet.pm 2005/03/16 21:35:17 1.607 +++ loncom/lonnet/perl/lonnet.pm 2005/03/31 15:55:47 1.618 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.607 2005/03/16 21:35:17 raeburn Exp $ +# $Id: lonnet.pm,v 1.618 2005/03/31 15:55:47 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -931,6 +931,19 @@ sub userenvironment { return %returnhash; } +# ---------------------------------------------------------- Get a studentphoto +sub studentphoto { + my ($udom,$unam,$ext) = @_; + my $home=&Apache::lonnet::homeserver($unam,$udom); + my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext",$home); + my $url="/uploaded/$udom/$unam/internal/studentphoto.".$ext; + if ($ret ne 'ok') { + return '/adm/lonKaputt/lonlogo_broken.gif'; + } + my $tokenurl=&Apache::lonnet::tokenwrapper($url); + return $tokenurl; +} + # -------------------------------------------------------------------- New chat sub chatsend { @@ -997,7 +1010,7 @@ sub repcopy { if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; } if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; } if ($filename=~m|^/home/httpd/html/userfiles/| or - $filename=~m|^/*uploaded/|) { + $filename=~m -^/*(uploaded|editupload)/-) { return &repcopy_userfile($filename); } $filename=~s/[\n\r]//g; @@ -1199,10 +1212,6 @@ sub process_coursefile { return $fetchresult; } -# --------------- Take an uploaded file and put it into the userfiles directory -# input: name of form element, coursedoc=1 means this is for the course -# output: url of file in userspace - sub clean_filename { my ($fname)=@_; # Replace Windows backslashes by forward slashes @@ -1219,6 +1228,11 @@ sub clean_filename { return $fname; } +# --------------- Take an uploaded file and put it into the userfiles directory +# input: name of form element, coursedoc=1 means this is for the course +# output: url of file in userspace + + sub userfileupload { my ($formname,$coursedoc,$subdir)=@_; if (!defined($subdir)) { $subdir='unknown'; } @@ -1292,7 +1306,6 @@ sub finishuserfileupload { } # Notify homeserver to grep it # - &Apache::lonnet::logthis("fetching ".$path.$file); my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); if ($fetchresult eq 'ok') { # @@ -1308,7 +1321,7 @@ sub finishuserfileupload { sub removeuploadedurl { my ($url)=@_; my (undef,undef,$udom,$uname,$fname)=split('/',$url,5); - return &Apache::lonnet::removeuserfile($uname,$udom,$fname); + return &removeuserfile($uname,$udom,$fname); } sub removeuserfile { @@ -2706,7 +2719,7 @@ sub allowed { # Free bre access to user's own portfolio contents my ($space,$domain,$name,$dir)=split('/',$uri); - if (('uploaded' eq $space) && ($ENV{'user.name'} eq $name) && + if (($space=~/^(uploaded|ediupload)$/) && ($ENV{'user.name'} eq $name) && ($ENV{'user.domain'} eq $domain) && ('portfolio' eq $dir)) { return 'F'; } @@ -2775,7 +2788,7 @@ sub allowed { } # URI is an uploaded document for this course - +# not allowing 'edit' access (editupload) to uploaded course docs if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { my $refuri=$ENV{'httpref.'.$orguri}; if ($refuri) { @@ -3715,8 +3728,11 @@ sub is_locked { my @check; my $is_locked; push @check, $file_name; - my %locked = &Apache::lonnet::get('file_permissions',\@check, - $ENV{'user.domain'},$ENV{'user.name'}); + my %locked = &get('file_permissions',\@check, + $ENV{'user.domain'},$ENV{'user.name'}); + my ($tmp)=keys(%locked); + if ($tmp=~/^error:/) { undef(%locked); } + if (ref($locked{$file_name}) eq 'ARRAY') { $is_locked = 'true'; } else { @@ -3728,11 +3744,14 @@ sub is_locked { sub mark_as_readonly { my ($domain,$user,$files,$what) = @_; - my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + my %current_permissions = &dump('file_permissions',$domain,$user); + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } + foreach my $file (@{$files}) { push(@{$current_permissions{$file}},$what); } - &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user); + &put('file_permissions',\%current_permissions,$domain,$user); return; } @@ -3809,7 +3828,10 @@ sub files_not_in_path { sub get_marked_as_readonly { my ($domain,$user,$what) = @_; - my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + my %current_permissions = &dump('file_permissions',$domain,$user); + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } + my @readonly_files; while (my ($file_name,$value) = each(%current_permissions)) { if (ref($value) eq "ARRAY"){ @@ -3828,7 +3850,10 @@ sub get_marked_as_readonly { sub get_marked_as_readonly_hash { my ($domain,$user,$what) = @_; - my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + my %current_permissions = &dump('file_permissions',$domain,$user); + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } + my %readonly_files; while (my ($file_name,$value) = each(%current_permissions)) { if (ref($value) eq "ARRAY"){ @@ -3849,8 +3874,11 @@ sub unmark_as_readonly { # unmarks all files locked by $what # for portfolio submissions, $what contains $crsid and $symb my ($domain,$user,$what) = @_; - my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); - my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what); + my %current_permissions = &dump('file_permissions',$domain,$user); + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } + + my @readonly_files = &get_marked_as_readonly($domain,$user,$what); foreach my $file(@readonly_files){ my $current_locks = $current_permissions{$file}; my @new_locks; @@ -3865,12 +3893,12 @@ sub unmark_as_readonly { $current_permissions{$file} = \@new_locks; } else { push(@del_keys, $file); - &Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user); + &del('file_permissions',\@del_keys, $domain, $user); delete $current_permissions{$file}; } } } - &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user); + &put('file_permissions',\%current_permissions,$domain,$user); return; } @@ -4145,7 +4173,8 @@ sub EXT { if ($realm eq 'user') { # --------------------------------------------------------------- user.resource if ($space eq 'resource') { - if (defined($Apache::lonhomework::parsing_a_problem)) { + if (defined($Apache::lonhomework::parsing_a_problem) || + defined($Apache::lonhomework::parsing_a_task)) { return $Apache::lonhomework::history{$qualifierrest}; } else { my %restored; @@ -4445,7 +4474,7 @@ sub metadata { my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } my $metastring; - if ($uri !~ m|^uploaded/|) { + if ($uri !~ m -^(uploaded|editupload)/-) { my $file=&filelocation('',&clutter($filename)); #push(@{$metaentry{$uri.'.file'}},$file); $metastring=&getfile($file); @@ -4469,7 +4498,7 @@ sub metadata { } else { $metaentry{':packages'}=$package.$keyroot; } - foreach (keys %packagetab) { + foreach (sort keys %packagetab) { my $part=$keyroot; $part=~s/^\_//; if ($_=~/^\Q$package\E\&/ || @@ -4686,7 +4715,23 @@ sub gettitle { if (!$title) { $title=(split('/',$urlsymb))[-1]; } return $title; } - + +sub get_slot { + my ($which,$cnum,$cdom)=@_; + if (!$cnum || !$cdom) { + (undef,my $courseid)=&Apache::lonxml::whichuser(); + $cdom=$ENV{'course.'.$courseid.'.domain'}; + $cnum=$ENV{'course.'.$courseid.'.num'}; + } + my %slotinfo=&get('slots',[$which],$cdom,$cnum); + &Apache::lonhomework::showhash(%slotinfo); + my ($tmp)=keys(%slotinfo); + if ($tmp=~/^error:/) { return (); } + if (ref($slotinfo{$which}) eq 'HASH') { + return %{$slotinfo{$which}}; + } + return $slotinfo{$which}; +} # ------------------------------------------------- Update symbolic store links sub symblist { @@ -4788,7 +4833,7 @@ sub decode_symb { sub fixversion { my $fn=shift; - if ($fn=~/^(adm|uploaded|public)/) { return $fn; } + if ($fn=~/^(adm|uploaded|editupload|public)/) { return $fn; } my %bighash; my $uri=&clutter($fn); my $key=$ENV{'request.course.id'}.'_'.$uri; @@ -4842,7 +4887,7 @@ sub symbread { my $syval=''; if (($ENV{'request.course.fn'}) && ($thisfn)) { my $targetfn = $thisfn; - if ( ($thisfn =~ m/^uploaded\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { + if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { $targetfn = 'adm/wrapper/'.$thisfn; } if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', @@ -4979,8 +5024,9 @@ sub validCODE { sub getCODE { if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; } - if (defined($Apache::lonhomework::parsing_a_problem) && - &validCODE($Apache::lonhomework::history{'resource.CODE'})) { + if ( (defined($Apache::lonhomework::parsing_a_problem) || + defined($Apache::lonhomework::parsing_a_task) ) && + &validCODE($Apache::lonhomework::history{'resource.CODE'})) { return $Apache::lonhomework::history{'resource.CODE'}; } return undef; @@ -5250,15 +5296,14 @@ sub receipt { sub getfile { my ($file) = @_; - - if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); } + if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); } &repcopy($file); return &readfile($file); } sub repcopy_userfile { my ($file)=@_; - if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); } + if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); } if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; } my ($cdom,$cnum,$filename) = ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|); @@ -5373,9 +5418,9 @@ sub filelocation { if ($file=~m:^/~:) { # is a contruction space reference $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; - } elsif ($file=~/^\/*uploaded/) { # is an uploaded file + } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file my ($udom,$uname,$filename)= - ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|); + ($file=~m -^/+(?:uploaded|editupload)/+([^/]+)/+([^/]+)/+(.*)$-); my $home=&homeserver($uname,$udom); my $is_me=0; my @ids=¤t_machine_ids(); @@ -5457,7 +5502,7 @@ sub declutter { sub clutter { my $thisfn='/'.&declutter(shift); - unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) { + unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { $thisfn='/res'.$thisfn; } return $thisfn; @@ -6476,6 +6521,91 @@ declutter() : declutters URLs (remove do =back +=head2 Usererfile file routines (/uploaded*) + +=over 4 + +=item * + +userfileupload(): main rotine for putting a file in a user or course's + filespace, arguments are, + + formname - required - this is the name of the element in $ENV where the + filename, and the contents of the file to create/modifed exist + the filename is in $ENV{'form.'.$formname.'.filename'} and the + contents of the file is located in $ENV{'form.'.$formname} + coursedoc - if true, store the file in the course of the active role + of the current user + subdir - required - subdirectory to put the file in under ../userfiles/ + if undefined, it will be placed in "unknown" + + (This routine calls clean_filename() to remove any dangerous + characters from the filename, and then calls finuserfileupload() to + complete the transaction) + + returns either the url of the uploaded file (/uploaded/....) if successful + and /adm/notfound.html if unsuccessful + +=item * + +clean_filename(): routine for cleaing a filename up for storage in + userfile space, argument is: + + filename - proposed filename + +returns: the new clean filename + +=item * + +finishuserfileupload(): routine that creaes and sends the file to +userspace, probably shouldn't be called directly + + docuname: username or courseid of destination for the file + docudom: domain of user/course of destination for the file + docuhome: loncapa id of the library server that is getting the file + formname: same as for userfileupload() + fname: filename (inculding subdirectories) for the file + + returns either the url of the uploaded file (/uploaded/....) if successful + and /adm/notfound.html if unsuccessful + +=item * + +renameuserfile(): renames an existing userfile to a new name + + Args: + docuname: username or courseid of destination for the file + docudom: domain of user/course of destination for the file + old: current file name (including any subdirs under userfiles) + new: desired file name (including any subdirs under userfiles) + +=item * + +mkdiruserfile(): creates a directory is a userfiles dir + + Args: + docuname: username or courseid of destination for the file + docudom: domain of user/course of destination for the file + dir: dir to create (including any subdirs under userfiles) + +=item * + +removeuserfile(): removes a file that exists in userfiles + + Args: + docuname: username or courseid of destination for the file + docudom: domain of user/course of destination for the file + fname: filname to delete (including any subdirs under userfiles) + +=item * + +removeuploadedurl(): convience function for removeuserfile() + + Args: + url: a full /uploaded/... url to delete + +=back + =head2 HTTP Helper Routines =over 4