--- loncom/lonnet/perl/lonnet.pm 2004/08/23 15:23:53 1.527 +++ loncom/lonnet/perl/lonnet.pm 2004/08/25 16:03:17 1.532 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.527 2004/08/23 15:23:53 sakharuk Exp $ +# $Id: lonnet.pm,v 1.532 2004/08/25 16:03:17 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1047,6 +1047,7 @@ sub currentversion { sub subscribe { my $fname=shift; if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } + $fname=~s/[\n\r]//g; my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); @@ -1067,6 +1068,7 @@ sub repcopy { my $filename=shift; $filename=~s/\/+/\//g; if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; } + $filename=~s/[\n\r]//g; my $transname="$filename.in.transfer"; if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); @@ -1152,7 +1154,6 @@ sub ssi { $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn); $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form)); } else { - &logthis('GET'."http://".$ENV{'HTTP_HOST'}.$fn); $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn); } @@ -1268,10 +1269,8 @@ sub process_coursefile { # 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'; } - my $fname=$ENV{'form.'.$formname.'.filename'}; +sub clean_filename { + my ($fname)=@_; # Replace Windows backslashes by forward slashes $fname=~s/\\/\//g; # Get rid of everything but the actual filename @@ -1280,6 +1279,14 @@ sub userfileupload { $fname=~s/\s+/\_/g; # Replace all other weird characters by nothing $fname=~s/[^\w\.\-]//g; + return $fname; +} + +sub userfileupload { + my ($formname,$coursedoc,$subdir)=@_; + if (!defined($subdir)) { $subdir='unknown'; } + my $fname=$ENV{'form.'.$formname.'.filename'}; + $fname=&clean_filename($fname); # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } chop($ENV{'form.'.$formname}); @@ -1373,6 +1380,19 @@ sub removeuserfile { return &reply("removeuserfile:$docudom/$docuname/$fname",$home); } +sub mkdiruserfile { + my ($docuname,$docudom,$dir)=@_; + my $home=&homeserver($docuname,$docudom); + return &reply("mkdiruserfile:".&escape("$docudom/$docuname/$dir"),$home); +} + +sub renameuserfile { + my ($docuname,$docudom,$old,$new)=@_; + my $home=&homeserver($docuname,$docudom); + return &reply("renameuserfile:$docudom:$docuname:".&escape("$old").':'. + &escape("$new"),$home); +} + # ------------------------------------------------------------------------- Log sub log { @@ -2698,8 +2718,8 @@ sub allowed { if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; } # Free bre access to adm and meta resources - - if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) { + if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) + || ($uri=~/\.meta$/)) && ($priv eq 'bre')) { return 'F'; } @@ -4198,7 +4218,9 @@ sub metadata { my ($uri,$what,$liburi,$prefix,$depthcount)=@_; $uri=&declutter($uri); # if it is a non metadata possible uri return quickly - if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || + if (($uri eq '') || + (($uri =~ m|^/*adm/|) && + ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || ($uri =~ m|home/[^/]+/public_html/|)) { return undef;