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

Diff for /loncom/lond between versions 1.182 and 1.188

version 1.182, 2004/03/09 16:12:26 version 1.188, 2004/04/29 10:24:40
Line 822  sub REAPER {                        # ta Line 822  sub REAPER {                        # ta
  if (defined($children{$pid})) {   if (defined($children{$pid})) {
     &logthis("Child $pid died");      &logthis("Child $pid died");
     delete($children{$pid});      delete($children{$pid});
  } else {   } elsif ($pid > 0) {
     &logthis("Unknown Child $pid died");      &logthis("Unknown Child $pid died");
  }   }
     } while ( $pid > 0 );      } while ( $pid > 0 );
Line 1827  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,$fpath)=split(/:/,$userinput);   my ($cmd,$fname)=split(/:/,$userinput);
  my ($udom,$uname,$ufile)=split(/\//,$fname);   my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
  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 '') {                              $ufile=~s/^[\.\~]+//;
                                 my $filepath = $udir;                              my $path = $udir;
                                 my @parts=split(/\//,$fpath);                              if ($ufile =~m|(.+)/([^/]+)$|) {
                                 my $count;                                  my @parts=split('/',$1);
                                 for ($count=0;$count<=$#parts;$count++) {                                  foreach my $part (@parts) {
                                     $filepath .="/$parts[$count]";                                      $path .= '/'.$part;
                                     if ((-e $filepath)!=1) {                                      if ((-e $path)!=1) {
                                         mkdir($filepath,0770);                                          mkdir($path,0770);
                                     }                                      }
                                 }                                  }
                             }                              }
     $ufile=~s/^[\.\~]+//;      my $destname=$udir.'/'.$ufile;
     $ufile=~s/\///g;      my $transname=$udir.'/'.$ufile.'.in.transit';
     my $destname=$udir.'/'.$fpath.$ufile;      my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
     my $transname=$udir.'/'.$fpath.$ufile.'.in.transit';  
     my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile;  
     my $response;      my $response;
     {      {
  my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
Line 1857  sub make_new_child { Line 1855  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 $fpath $fname ($remoteurl)");   &logthis("LWP GET: $message for $fname ($remoteurl)");
  print $client "failed\n";   print $client "failed\n";
     } else {      } else {
  if (!rename($transname,$destname)) {   if (!rename($transname,$destname)) {
Line 1873  sub make_new_child { Line 1871  sub make_new_child {
  }   }
     } else {      } else {
  Reply($client, "refused\n", $userinput);   Reply($client, "refused\n", $userinput);
       }
   # --------------------------------------------------------- remove a user file 
    } elsif ($userinput =~ /^removeuserfile/) { # Client clear or enc.
       if(isClient) {
    my ($cmd,$fname)=split(/:/,$userinput);
    my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
    &logthis("$udom - $uname - $ufile");
    if ($ufile =~m|/\.\./|) {
       # any files paths with /../ in them refuse 
                               # to deal with
       print $client "refused\n";
    } else {
       my $udir=propath($udom,$uname);
       if (-e $udir) {
    my $file=$udir.'/userfiles/'.$ufile;
    if (-e $file) {
       unlink($file);
       if (-e $file) {
    print $client "failed\n";
       } else {
    print $client "ok\n";
       }
    } else {
       print $client "not_found\n";
    }
       } else {
    print $client "not_home\n";
       }
    }
       } else {
    Reply($client, "refused\n", $userinput);
     }      }
 # ------------------------------------------ authenticate access to a user file  # ------------------------------------------ authenticate access to a user file
  } elsif ($userinput =~ /^tokenauthuserfile/) { # Client only   } elsif ($userinput =~ /^tokenauthuserfile/) { # Client only
Line 1884  sub make_new_child { Line 1912  sub make_new_child {
  if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.   if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
  $session.'.id')) {   $session.'.id')) {
     while (my $line=<ENVIN>) {      while (my $line=<ENVIN>) {
  if ($line=~/userfile\.$fname\=/) { $reply='ok'; }   if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }
     }      }
     close(ENVIN);      close(ENVIN);
     print $client $reply."\n";      print $client $reply."\n";
Line 1900  sub make_new_child { Line 1928  sub make_new_child {
     if(isClient) {      if(isClient) {
  my ($cmd,$fname)=split(/:/,$userinput);   my ($cmd,$fname)=split(/:/,$userinput);
  if (-e $fname) {   if (-e $fname) {
     print $client &unsub($client,$fname,$clientip);      print $client &unsub($fname,$clientip);
  } else {   } else {
     print $client "not_found\n";      print $client "not_found\n";
  }   }
Line 3012  sub chatadd { Line 3040  sub chatadd {
 sub unsub {  sub unsub {
     my ($fname,$clientip)=@_;      my ($fname,$clientip)=@_;
     my $result;      my $result;
       my $unsubs = 0; # Number of successful unsubscribes:
   
   
       # An old way subscriptions were handled was to have a 
       # subscription marker file:
   
       Debug("Attempting unlink of $fname.$clientname");
     if (unlink("$fname.$clientname")) {      if (unlink("$fname.$clientname")) {
  $result="ok\n";   $unsubs++; # Successful unsub via marker file.
     } else {      } 
  $result="not_subscribed\n";  
     }      # The more modern way to do it is to have a subscription list
       # file:
   
     if (-e "$fname.subscription") {      if (-e "$fname.subscription") {
  my $found=&addline($fname,$clientname,$clientip,'');   my $found=&addline($fname,$clientname,$clientip,'');
  if ($found) { $result="ok\n"; }   if ($found) { 
       $unsubs++;
    }
       } 
   
       #  If either or both of these mechanisms succeeded in unsubscribing a 
       #  resource we can return ok:
   
       if($unsubs) {
    $result = "ok\n";
     } else {      } else {
  if ($result != "ok\n") { $result="not_subscribed\n"; }   $result = "not_subscribed\n";
     }      }
   
     return $result;      return $result;
 }  }
   
Line 3144  sub make_passwd_file { Line 3191  sub make_passwd_file {
  }   }
     } elsif ($umode eq 'unix') {      } elsif ($umode eq 'unix') {
  {   {
       #
       #  Don't allow the creation of privileged accounts!!! that would
       #  be real bad!!!
       #
       my $uid = getpwnam($uname);
       if((defined $uid) && ($uid == 0)) {
    &logthis(">>>Attempted to create privilged account blocked");
    return "no_priv_account_error\n";
       }
   
     my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";      my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
     {      {
  &Debug("Executing external: ".$execpath);   &Debug("Executing external: ".$execpath);
Removed from v.1.182  
changed lines
  Added in v.1.188

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