--- loncom/lonnet/perl/lonnet.pm 2005/03/02 22:26:36 1.602 +++ loncom/lonnet/perl/lonnet.pm 2005/03/17 21:02:00 1.611 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.602 2005/03/02 22:26:36 raeburn Exp $ +# $Id: lonnet.pm,v 1.611 2005/03/17 21:02:00 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -911,8 +911,8 @@ sub make_room { } sub purge_remembered { - &logthis("Tossing ".scalar(keys(%remembered))); - &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); + #&logthis("Tossing ".scalar(keys(%remembered))); + #&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); undef(%remembered); undef(%accessed); } @@ -994,27 +994,27 @@ sub subscribe { sub repcopy { my $filename=shift; $filename=~s/\/+/\//g; - if ($filename=~m|^/home/httpd/html/adm/|) { return 'OK'; } - if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'OK'; } + 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; my $transname="$filename.in.transfer"; - if ((-e $filename) || (-e $transname)) { return 'OK'; } + if ((-e $filename) || (-e $transname)) { return 'ok'; } my $remoteurl=subscribe($filename); if ($remoteurl =~ /^con_lost by/) { &logthis("Subscribe returned $remoteurl: $filename"); - return 'HTTP_SERVICE_UNAVAILABLE'; + return 'unavailable'; } elsif ($remoteurl eq 'not_found') { #&logthis("Subscribe returned not_found: $filename"); - return 'HTTP_NOT_FOUND'; + return 'not_found'; } elsif ($remoteurl =~ /^rejected by/) { &logthis("Subscribe returned $remoteurl: $filename"); - return 'FORBIDDEN'; + return 'forbidden'; } elsif ($remoteurl eq 'directory') { - return 'OK'; + return 'ok'; } else { my $author=$filename; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; @@ -1025,7 +1025,7 @@ sub repcopy { my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; if ($path ne "$perlvar{'lonDocRoot'}/res") { &logthis("Malconfiguration for replication: $filename"); - return 'HTTP_BAD_REQUEST'; + return 'bad_request'; } my $count; for ($count=5;$count<$#parts;$count++) { @@ -1042,7 +1042,7 @@ sub repcopy { my $message=$response->status_line; &logthis("WARNING:" ." LWP get: $message: $filename"); - return 'HTTP_SERVICE_UNAVAILABLE'; + return 'unavailable'; } else { if ($remoteurl!~/\.meta$/) { my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta'); @@ -1054,7 +1054,7 @@ sub repcopy { } } rename($transname,$filename); - return 'OK'; + return 'ok'; } } } @@ -1063,6 +1063,9 @@ sub repcopy { # ------------------------------------------------ Get server side include body sub ssi_body { my ($filelink,%form)=@_; + if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) { + $form{'LONCAPA_INTERNAL_no_discussion'}='true'; + } my $output=($filelink=~/^http\:/?&externalssi($filelink): &ssi($filelink,%form)); $output=~s|//(\s*)?\s||gs; @@ -1196,10 +1199,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 @@ -1216,6 +1215,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'; } @@ -2703,7 +2707,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'; } @@ -2772,9 +2776,9 @@ 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}; + my $refuri=$ENV{'httpref.'.$origuri}; if ($refuri) { if ($refuri =~ m|^/adm/|) { $thisallowed='F'; @@ -3895,19 +3899,37 @@ sub dirlist { if($udom) { if($uname) { - my $listing=reply('ls:'.$dirRoot.'/'.$uri, + my $listing=reply('ls2:'.$dirRoot.'/'.$uri, homeserver($uname,$udom)); - return split(/:/,$listing); + my @listing_results; + if ($listing eq 'unknown_cmd') { + $listing=reply('ls:'.$dirRoot.'/'.$uri, + homeserver($uname,$udom)); + @listing_results = split(/:/,$listing); + } else { + @listing_results = map { &unescape($_); } split(/:/,$listing); + } + return @listing_results; } elsif(!defined($alternateDirectoryRoot)) { my $tryserver; my %allusers=(); foreach $tryserver (keys %libserv) { if($hostdom{$tryserver} eq $udom) { - my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'. + my $listing=reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'. $udom, $tryserver); - if (($listing ne 'no_such_dir') && ($listing ne 'empty') - && ($listing ne 'con_lost')) { - foreach (split(/:/,$listing)) { + my @listing_results; + if ($listing eq 'unknown_cmd') { + $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'. + $udom, $tryserver); + @listing_results = split(/:/,$listing); + } else { + @listing_results = + map { &unescape($_); } split(/:/,$listing); + } + if ($listing_results[0] ne 'no_such_dir' && + $listing_results[0] ne 'empty' && + $listing_results[0] ne 'con_lost') { + foreach (@listing_results) { my ($entry,@stat)=split(/&/,$_); $allusers{$entry}=1; } @@ -4424,7 +4446,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); @@ -4767,7 +4789,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; @@ -4821,7 +4843,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', @@ -5229,16 +5251,15 @@ 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|^/home/httpd/html/lonUsers/|) { return 'OK'; } + 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/+([^/]+)/+([^/]+)/+(.*)|); my ($info,$rtncode); @@ -5261,7 +5282,7 @@ sub repcopy_userfile { return -1; } if ($info < $fileinfo[9]) { - return 'OK'; + return 'ok'; } $info = ''; $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode); @@ -5295,7 +5316,7 @@ sub repcopy_userfile { open(FILE,">$file"); print FILE $info; close(FILE); - return 'OK'; + return 'ok'; } sub tokenwrapper { @@ -5352,9 +5373,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(); @@ -5366,9 +5387,6 @@ sub filelocation { $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. $udom.'/'.$uname.'/'.$filename; } - } elsif ($file =~ /^\/adm\/portfolio\//) { - $file =~ s:^/adm/portfolio/::; - $location = $location=&Apache::loncommon::propath($ENV{'user.domain'},$ENV{'user.name'}).'/userfiles/portfolio/'.$file; } else { $file=~s/^\Q$perlvar{'lonDocRoot'}\E//; $file=~s:^/res/:/:; @@ -5439,7 +5457,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; @@ -6115,8 +6133,8 @@ subscribe($fname) : subscribe to a resou repcopy($filename) : subscribes to the requested file, and attempts to replicate from the owning library server, Might return -'HTTP_SERVICE_UNAVAILABLE', 'HTTP_NOT_FOUND', 'FORBIDDEN', 'OK', or -'HTTP_BAD_REQUEST', also attempts to grab the metadata for the +'unavailable', 'not_found', 'forbidden', 'ok', or +'bad_request', also attempts to grab the metadata for the resource. Expects the local filesystem pathname (/home/httpd/html/res/....) @@ -6458,6 +6476,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