[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.663 and 1.669

version 1.663, 2005/10/12 16:50:37 version 1.669, 2005/10/27 19:47:39
Line 1176  sub process_coursefile { Line 1176  sub process_coursefile {
         $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,          $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
      $home);       $home);
     } else {      } else {
         my $fetchresult = '';  
         my $fpath = '';          my $fpath = '';
         my $fname = $file;          my $fname = $file;
         ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);          ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
Line 1862  sub dcmaildump { Line 1861  sub dcmaildump {
     foreach my $tryserver (keys(%libserv)) {      foreach my $tryserver (keys(%libserv)) {
         if ($hostdom{$tryserver} eq $dom) {          if ($hostdom{$tryserver} eq $dom) {
             %{$returnhash{$tryserver}}=();              %{$returnhash{$tryserver}}=();
             foreach (      my $cmd='dcmaildump:'.$dom.':'.
                 split(/\&/,&reply('dcmaildump:'.$dom.':'.   &escape($startdate).':'.&escape($enddate).':';
                    &escape($startdate).':'.&escape($enddate).':'.      my @esc_senders=map { &escape($_)} @$senders;
                    &escape($senders), $tryserver))) {      $cmd.=&escape(join('&',@esc_senders));
       foreach (split(/\&/,&reply($cmd,$tryserver))) {
                 my ($key,$value) = split(/\=/,$_);                  my ($key,$value) = split(/\=/,$_);
                 if (($key) && ($value)) {                  if (($key) && ($value)) {
                     $returnhash{$tryserver}{&unescape($key)} = &unescape($value);                      $returnhash{$tryserver}{&unescape($key)} = &unescape($value);
Line 2954  sub eget { Line 2954  sub eget {
    return %returnhash;     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  # ---------------------------------------------- Custom access rule evaluation
   
 sub customaccess {  sub customaccess {
Line 3075  sub allowed { Line 3098  sub allowed {
        $thisallowed.=$1;         $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  # not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {      if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
    $thisallowed='';
  my $refuri=$env{'httpref.'.$orguri};   my $refuri=$env{'httpref.'.$orguri};
  if ($refuri) {   if ($refuri) {
     if ($refuri =~ m|^/adm/|) {      if ($refuri =~ m|^/adm/|) {
  $thisallowed='F';   $thisallowed='F';
       } else {
                   $refuri=&declutter($refuri);
                   my ($match) = &is_on_map($refuri);
                   if ($match) {
                       $thisallowed='F';
                   }
     }      }
  }   }
     }      }
Line 5785  sub filelocation { Line 5815  sub filelocation {
 sub hreflocation {  sub hreflocation {
     my ($dir,$file)=@_;      my ($dir,$file)=@_;
     unless (($file=~m-^http://-i) || ($file=~m-^/-)) {      unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
  my $finalpath=filelocation($dir,$file);   $file=filelocation($dir,$file);
  $finalpath=~s-^/home/httpd/html--;      }
  $finalpath=~s-^/home/(\w+)/public_html/-/~$1/-;      if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
  return $finalpath;   $file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
     } elsif ($file=~m-^/home-) {      } elsif ($file=~m-/home/(\w+)/public_html/-) {
  $file=~s-^/home/httpd/html--;  
  $file=~s-^/home/(\w+)/public_html/-/~$1/-;   $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;      return $file;
 }  }
Removed from v.1.663  
changed lines
  Added in v.1.669

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>