--- loncom/lonnet/perl/lonnet.pm 2005/10/12 16:50:37 1.663 +++ loncom/lonnet/perl/lonnet.pm 2005/10/27 19:47:39 1.669 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.663 2005/10/12 16:50:37 raeburn Exp $ +# $Id: lonnet.pm,v 1.669 2005/10/27 19:47:39 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1176,7 +1176,6 @@ sub process_coursefile { $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, $home); } else { - my $fetchresult = ''; my $fpath = ''; my $fname = $file; ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); @@ -1862,10 +1861,11 @@ sub dcmaildump { foreach my $tryserver (keys(%libserv)) { if ($hostdom{$tryserver} eq $dom) { %{$returnhash{$tryserver}}=(); - foreach ( - split(/\&/,&reply('dcmaildump:'.$dom.':'. - &escape($startdate).':'.&escape($enddate).':'. - &escape($senders), $tryserver))) { + my $cmd='dcmaildump:'.$dom.':'. + &escape($startdate).':'.&escape($enddate).':'; + my @esc_senders=map { &escape($_)} @$senders; + $cmd.=&escape(join('&',@esc_senders)); + foreach (split(/\&/,&reply($cmd,$tryserver))) { my ($key,$value) = split(/\=/,$_); if (($key) && ($value)) { $returnhash{$tryserver}{&unescape($key)} = &unescape($value); @@ -2954,6 +2954,29 @@ sub eget { return %returnhash; } +# ------------------------------------------------------------ tmpput interface +sub tmpput { + my ($storehash,$server)=@_; + my $items=''; + foreach (keys(%$storehash)) { + $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; + } + $items=~s/\&$//; + return &reply("tmpput:$items",$server); +} + +# ------------------------------------------------------------ tmpget interface +sub tmpget { + my ($token)=@_; + my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'}); + my %returnhash; + foreach my $item (split(/\&/,$rep)) { + my ($key,$value)=split(/=/,$item); + $returnhash{&unescape($key)}=&thaw_unescape($value); + } + return %returnhash; +} + # ---------------------------------------------- Custom access rule evaluation sub customaccess { @@ -3075,13 +3098,20 @@ sub allowed { $thisallowed.=$1; } -# URI is an uploaded document for this course +# URI is an uploaded document for this course, default permissions don't matter # not allowing 'edit' access (editupload) to uploaded course docs if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { + $thisallowed=''; my $refuri=$env{'httpref.'.$orguri}; if ($refuri) { if ($refuri =~ m|^/adm/|) { $thisallowed='F'; + } else { + $refuri=&declutter($refuri); + my ($match) = &is_on_map($refuri); + if ($match) { + $thisallowed='F'; + } } } } @@ -5785,14 +5815,15 @@ sub filelocation { sub hreflocation { my ($dir,$file)=@_; unless (($file=~m-^http://-i) || ($file=~m-^/-)) { - my $finalpath=filelocation($dir,$file); - $finalpath=~s-^/home/httpd/html--; - $finalpath=~s-^/home/(\w+)/public_html/-/~$1/-; - return $finalpath; - } elsif ($file=~m-^/home-) { - $file=~s-^/home/httpd/html--; + $file=filelocation($dir,$file); + } + if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { + $file=~s-^\Q$perlvar{'lonDocRoot'}\E--; + } elsif ($file=~m-/home/(\w+)/public_html/-) { $file=~s-^/home/(\w+)/public_html/-/~$1/-; - return $file; + } elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { + $file=~s-^/home/httpd/lonUsers/([^/]*)/./././([^/]*)/userfiles/ + -/uploaded/$1/$2/-x; } return $file; }