--- loncom/lonnet/perl/lonnet.pm 2002/12/09 19:04:44 1.312 +++ loncom/lonnet/perl/lonnet.pm 2003/01/28 00:09:57 1.320 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.312 2002/12/09 19:04:44 www Exp $ +# $Id: lonnet.pm,v 1.320 2003/01/28 00:09:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -857,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 @@ -1737,6 +1744,57 @@ sub dump { return %returnhash; } +# --------------------------------------------------------------- currentdump +sub currentdump { + my ($namespace,$udomain,$uname)=@_; + if (!$udomain) { $udomain = $ENV{'user.domain'}; } + if (!$uname) { $uname = $ENV{'user.name'}; } + my $uhome = &homeserver($uname,$udomain); + my $rep=reply("currentdump:$udomain:$uname:$namespace",$uhome); + return if ($rep =~ /^(error:|no_such_host)/); + # + my %returnhash=(); + # + if ($rep eq "unknown_cmd") { + # an old lond will not know currentdump + # Do a dump and make it look like a currentdump + my @tmp = &dump($namespace,$udomain,$uname,'.'); + return if ($tmp[0] =~ /^(error:|no_such_host)/); + my %hash = @tmp; + @tmp=(); + # Code ripped from lond, essentially. The only difference + # here is the unescaping done by lonnet::dump(). Conceivably + # we might run in to problems with parameter names =~ /^v\./ + while (my ($key,$value) = each(%hash)) { + my ($v,$symb,$param) = split(/:/,$key); + next if ($v eq 'version' || $symb eq 'keys'); + next if (exists($returnhash{$symb}) && + exists($returnhash{$symb}->{$param}) && + $returnhash{$symb}->{'v.'.$param} > $v); + $returnhash{$symb}->{$param}=$value; + $returnhash{$symb}->{'v.'.$param}=$v; + } + # + # Remove all of the keys in the hashes which keep track of + # the version of the parameter. + while (my ($symb,$param_hash) = each(%returnhash)) { + # use a foreach because we are going to delete from the hash. + foreach my $key (keys(%$param_hash)) { + delete($param_hash->{$key}) if ($key =~ /^v\./); + } + } + } else { + my @pairs=split(/\&/,$rep); + foreach (@pairs) { + my ($key,$value)=split(/=/,$_); + my ($symb,$param) = split(/:/,$key); + $returnhash{&unescape($symb)}->{&unescape($param)} = + &unescape($value); + } + } + return %returnhash; +} + # --------------------------------------------------------------- put interface sub put { @@ -1864,6 +1922,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/) { @@ -2350,10 +2414,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; } @@ -2748,14 +2817,14 @@ sub EXT { } else { $courseid=$ENV{'request.course.id'}; } - my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); my $rest; - if ($therest[0]) { + if (defined($therest[0])) { $rest=join('.',@therest); } else { $rest=''; } + my $qualifierrest=$qualifier; if ($rest) { $qualifierrest.='.'.$rest; } my $spacequalifierrest=$space;