[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.178 and 1.182

version 1.178, 2004/02/18 10:40:45 version 1.182, 2004/03/09 16:12:26
Line 1258  sub make_new_child { Line 1258  sub make_new_child {
     #  the pid hash.      #  the pid hash.
     #      #
     my $caller = getpeername($client);      my $caller = getpeername($client);
     my ($port,$iaddr)=unpack_sockaddr_in($caller);      my ($port,$iaddr);
     $clientip=inet_ntoa($iaddr);      if (defined($caller) && length($caller) > 0) {
    ($port,$iaddr)=unpack_sockaddr_in($caller);
       } else {
    &logthis("Unable to determine who caller was, getpeername returned nothing");
       }
       if (defined($iaddr)) {
    $clientip=inet_ntoa($iaddr);
       } else {
    &logthis("Unable to determine clinetip");
    $clientip='Unavailable';
       }
           
     if ($pid) {      if ($pid) {
         # Parent records the child's birth and returns.          # Parent records the child's birth and returns.
Line 1817  sub make_new_child { Line 1827  sub make_new_child {
 # -------------------------------------- fetch a user file from a remote server  # -------------------------------------- fetch a user file from a remote server
  } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.   } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.
     if(isClient) {      if(isClient) {
  my ($cmd,$fname)=split(/:/,$userinput);   my ($cmd,$fname,$fpath)=split(/:/,$userinput);
  my ($udom,$uname,$ufile)=split(/\//,$fname);   my ($udom,$uname,$ufile)=split(/\//,$fname);
  my $udir=propath($udom,$uname).'/userfiles';   my $udir=propath($udom,$uname).'/userfiles';
  unless (-e $udir) { mkdir($udir,0770); }   unless (-e $udir) { mkdir($udir,0770); }
  if (-e $udir) {   if (-e $udir) {
                               unless ($fpath eq '') {
                                   my $filepath = $udir;
                                   my @parts=split(/\//,$fpath);
                                   my $count;
                                   for ($count=0;$count<=$#parts;$count++) {
                                       $filepath .="/$parts[$count]";
                                       if ((-e $filepath)!=1) {
                                           mkdir($filepath,0770);
                                       }
                                   }
                               }
     $ufile=~s/^[\.\~]+//;      $ufile=~s/^[\.\~]+//;
     $ufile=~s/\///g;      $ufile=~s/\///g;
     my $destname=$udir.'/'.$ufile;      my $destname=$udir.'/'.$fpath.$ufile;
     my $transname=$udir.'/'.$ufile.'.in.transit';      my $transname=$udir.'/'.$fpath.$ufile.'.in.transit';
     my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;      my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile;
     my $response;      my $response;
     {      {
  my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
Line 1836  sub make_new_child { Line 1857  sub make_new_child {
     if ($response->is_error()) {      if ($response->is_error()) {
  unlink($transname);   unlink($transname);
  my $message=$response->status_line;   my $message=$response->status_line;
  &logthis("LWP GET: $message for $fname ($remoteurl)");   &logthis("LWP GET: $message for $fpath $fname ($remoteurl)");
  print $client "failed\n";   print $client "failed\n";
     } else {      } else {
  if (!rename($transname,$destname)) {   if (!rename($transname,$destname)) {
Line 2006  sub make_new_child { Line 2027  sub make_new_child {
  } else {   } else {
     print $client "error: ".($!+0)      print $client "error: ".($!+0)
  ." untie(GDBM) failed ".   ." untie(GDBM) failed ".
  "while attempting put\n";   "while attempting inc\n";
  }   }
     } else {      } else {
  print $client "error: ".($!)   print $client "error: ".($!)
     ." tie(GDBM) Failed ".      ." tie(GDBM) Failed ".
     "while attempting put\n";      "while attempting inc\n";
     }      }
  } else {   } else {
     print $client "refused\n";      print $client "refused\n";
Line 2337  sub make_new_child { Line 2358  sub make_new_child {
  my $proname=propath($udom,$uname);   my $proname=propath($udom,$uname);
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {   if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
        study($regexp);  
        while (my ($key,$value) = each(%hash)) {         while (my ($key,$value) = each(%hash)) {
    if ($regexp eq '.') {     if ($regexp eq '.') {
        $qresult.=$key.'='.$value.'&';         $qresult.=$key.'='.$value.'&';
Removed from v.1.178  
changed lines
  Added in v.1.182

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