--- loncom/lonnet/perl/lonnet.pm 2003/01/09 22:45:51 1.314 +++ loncom/lonnet/perl/lonnet.pm 2003/01/15 19:34:03 1.319 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.314 2003/01/09 22:45:51 www Exp $ +# $Id: lonnet.pm,v 1.319 2003/01/15 19:34:03 matthew 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 @@ -1736,6 +1743,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