--- loncom/lonnet/perl/lonnet.pm 2002/12/06 16:34:55 1.311 +++ loncom/lonnet/perl/lonnet.pm 2003/01/13 21:52:11 1.318 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.311 2002/12/06 16:34:55 matthew Exp $ +# $Id: lonnet.pm,v 1.318 2003/01/13 21:52:11 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -729,6 +729,7 @@ sub currentversion { sub subscribe { my $fname=shift; + if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); @@ -856,8 +857,15 @@ sub tokenwrapper { sub userfileupload { my ($formname,$coursedoc)=@_; my $fname=$ENV{'form.'.$formname.'.filename'}; +# Replace Windows backslashes by forward slashes $fname=~s/\\/\//g; +# Get rid of everything but the actual filename $fname=~s/^.*\/([^\/]+)$/$1/; +# Replace spaces by underscores + $fname=~s/\s+/\_/g; +# Replace all other weird characters by nothing + $fname=~s/[^\w\.\-]//g; +# See if there is anything left unless ($fname) { return 'error: no uploaded file'; } chop($ENV{'form.'.$formname}); # Create the directory if not present @@ -1736,6 +1744,25 @@ sub dump { return %returnhash; } +# --------------------------------------------------------------- dumpcurrent +sub dumpcurrent { + my ($namespace,$udomain,$uname)=@_; + if (!$udomain) { $udomain = $ENV{'user.domain'}; } + if (!$uname) { $uname = $ENV{'user.name'}; } + my $uhome = &homeserver($uname,$udomain); + my $rep=reply("dumpcurrent:$udomain:$uname:$namespace",$uhome); + &logthis("error = ".$rep) if ($rep =~ /^(error|no_such_host)/); + return if ($rep =~ /^(error:|no_such_host)/); + my @pairs=split(/\&/,$rep); + my %returnhash=(); + foreach (@pairs) { + my ($key,$value)=split(/=/,$_); + my ($symb,$param) = split(/:/,$key); + $returnhash{&unescape($symb)}->{&unescape($param)} = &unescape($value); + } + return %returnhash; +} + # --------------------------------------------------------------- put interface sub put { @@ -1863,6 +1890,12 @@ sub allowed { $thisallowed.=$1; } +# URI is an uploaded document for this course + + if (($priv eq 'bre') && + ($uri=~/^uploaded\/$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}\/$ENV{'course.'.$ENV{'request.course.id'}.'.num'}/)) { + return 'F'; + } # Full access at system, domain or course-wide level? Exit. if ($thisallowed=~/F/) { @@ -2349,10 +2382,15 @@ sub modifyuser { } } # -------------------------------------------------------------- Add names, etc - my %names=&get('environment', + my @tmp=&get('environment', ['firstname','middlename','lastname','generation'], $udom,$uname); - if ($names{'firstname'} =~ m/^error:.*/) { %names=(); } + my %names; + if ($tmp[0] =~ m/^error:.*/) { + %names=(); + } else { + %names = @tmp; + } if ($first) { $names{'firstname'} = $first; } if ($middle) { $names{'middlename'} = $middle; } if ($last) { $names{'lastname'} = $last; }