[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.471 and 1.475

version 1.471, 2004/02/04 22:39:06 version 1.475, 2004/03/08 23:04:00
Line 377  sub delenv { Line 377  sub delenv {
     return 'error: '.$!;      return 'error: '.$!;
  }   }
  foreach (@oldenv) {   foreach (@oldenv) {
     unless ($_=~/^$delthis/) { print $fh $_; }      if ($_=~/^$delthis/) { 
                   my ($key,undef) = split('=',$_);
                   delete($ENV{$key});
               } else {
                   print $fh $_; 
               }
  }   }
  close($fh);   close($fh);
     }      }
Line 1232  sub finishuserfileupload { Line 1237  sub finishuserfileupload {
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
           
     my $fetchresult=       my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
  &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome);      $docuhome);
     if ($fetchresult eq 'ok') {      if ($fetchresult eq 'ok') {
 #  #
 # Return the URL to it  # Return the URL to it
Line 3844  sub metadata { Line 3849  sub metadata {
     # if it is a non metadata possible uri return quickly      # if it is a non metadata possible uri return quickly
     if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||      if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
  ($uri =~ m|home/[^/]+/public_html/|)) {   ($uri =~ m|home/[^/]+/public_html/|) || ($uri =~ m|^uploaded/|)) {
  return undef;   return undef;
     }      }
     my $filename=$uri;      my $filename=$uri;
Line 4393  sub setup_random_from_rndseed { Line 4398  sub setup_random_from_rndseed {
     }      }
 }  }
   
   sub latest_receipt_algorithm_id {
       return 'receipt2';
   }
   
 sub ireceipt {  sub ireceipt {
     my ($funame,$fudom,$fucourseid,$fusymb)=@_;      my ($funame,$fudom,$fucourseid,$fusymb,$part)=@_;
     my $cuname=unpack("%32C*",$funame);      my $cuname=unpack("%32C*",$funame);
     my $cudom=unpack("%32C*",$fudom);      my $cudom=unpack("%32C*",$fudom);
     my $cucourseid=unpack("%32C*",$fucourseid);      my $cucourseid=unpack("%32C*",$fucourseid);
     my $cusymb=unpack("%32C*",$fusymb);      my $cusymb=unpack("%32C*",$fusymb);
     my $cunique=unpack("%32C*",$perlvar{'lonReceipt'});      my $cunique=unpack("%32C*",$perlvar{'lonReceipt'});
     return unpack("%32C*",$perlvar{'lonHostID'}).'-'.      my $cpart=unpack("%32S*",$part);
            ($cunique%$cuname+      my $return =unpack("%32C*",$perlvar{'lonHostID'}).'-';
             $cunique%$cudom+      if ($ENV{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
             $cusymb%$cuname+   $ENV{'request.state'} eq 'construct') {
             $cusymb%$cudom+   &Apache::lonxml::debug("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname).
             $cucourseid%$cuname+         " and ".($cpart%$cudom));
             $cucourseid%$cudom);         
    $return.= ($cunique%$cuname+
      $cunique%$cudom+
      $cusymb%$cuname+
      $cusymb%$cudom+
      $cucourseid%$cuname+
      $cucourseid%$cudom+
      $cpart%$cuname+
      $cpart%$cudom);
       } else {
    $return.= ($cunique%$cuname+
      $cunique%$cudom+
      $cusymb%$cuname+
      $cusymb%$cudom+
      $cucourseid%$cuname+
      $cucourseid%$cudom);
       }
       return $return;
 }  }
   
 sub receipt {  sub receipt {
   my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();      my ($part)=@_;
   return &ireceipt($name,$domain,$courseid,$symb);      my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
       return &ireceipt($name,$domain,$courseid,$symb,$part);
 }  }
   
 # ------------------------------------------------------------ Serves up a file  # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or a -1  # returns either the contents of the file or 
   # -1 if the file doesn't exist
   # -2 if an error occured when trying to aqcuire the file
   
 sub getfile {  sub getfile {
  my $file=shift;      my $file=shift;
  if ($file=~/^\/*uploaded\//) { # user file      if ($file=~/^\/*uploaded\//) { # user file
     my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',&tokenwrapper($file));   my $request=new HTTP::Request('GET',&tokenwrapper($file));
     my $response=$ua->request($request);   my $response=$ua->request($request);
     if ($response->is_success()) {   if ($response->is_success()) {
        return $response->content;      return $response->content;
     } else {    } else { 
        return -1;       #&logthis("Return Code is ".$response->code." for $file ".
     }      #         &tokenwrapper($file));
  } else { # normal file from res space      # 500 for ISE when tokenwrapper can't figure out what server to
   &repcopy($file);              #  contact
   if (! -e $file ) { return -1; };              # 503 when lonuploadacc can't contact the requested server
   my $fh;      if ($response->code eq 503 || $response->code eq 500) {
   open($fh,"<$file");   return -2;
   my $a='';      } else {
   while (<$fh>) { $a .=$_; }   return -1;
   return $a;      }
  }   }
       } else { # normal file from res space
    &repcopy($file);
    if (! -e $file ) { return -1; };
    my $fh;
    open($fh,"<$file");
    my $a='';
    while (<$fh>) { $a .=$_; }
    return $a;
       }
 }  }
   
 sub filelocation {  sub filelocation {
Line 4458  sub filelocation { Line 4497  sub filelocation {
   }    }
   $location=~s://+:/:g; # remove duplicate /    $location=~s://+:/:g; # remove duplicate /
   while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..    while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
     while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
   return $location;    return $location;
 }  }
   
Removed from v.1.471  
changed lines
  Added in v.1.475

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