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

Diff for /loncom/lond between versions 1.178.2.14 and 1.178.2.20

version 1.178.2.14, 2004/04/07 09:39:18 version 1.178.2.20, 2004/04/27 11:30:28
Line 796  sub ChangePasswordHandler { Line 796  sub ChangePasswordHandler {
     # First require that the user can be authenticated with their      # First require that the user can be authenticated with their
     # old password:      # old password:
   
     my $validated = ValidUser($udom, $uname, $upass);      my $validated = ValidateUser($udom, $uname, $upass);
     if($validated) {      if($validated) {
  my $realpasswd  = GetAuthType($udom, $uname); # Defined since authd.   my $realpasswd  = GetAuthType($udom, $uname); # Defined since authd.
   
Line 1028  sub UpdateResourceHandler { Line 1028  sub UpdateResourceHandler {
         
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my $fname=$tail;      my $fname=split(/:/$tail); # This allows interactive testing
       chomp($fname); # with telnet.
   
     my $ownership=ishome($fname);      my $ownership=ishome($fname);
     if ($ownership eq 'not_owner') {      if ($ownership eq 'not_owner') {
  if (-e $fname) {   if (-e $fname) {
Line 1138  sub FetchUserFileHandler { Line 1140  sub FetchUserFileHandler {
 }  }
 RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0);  RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0);
 #  #
 #   Authenticate access to a user file.  Question?   The token for athentication  #   Authenticate access to a user file. 
 #   is allowed to be sent as cleartext is this really what we want?  This token  
 #   represents the user's session id.  Once it is forged does this allow too much   
 #   access??  
 #  #
 # Parameters:  # Parameters:
 #    $cmd      - The command that got us here.  #    $cmd      - The command that got us here.
Line 1191  sub UnsubscribeHandler { Line 1190  sub UnsubscribeHandler {
     my $client   = shift;      my $client   = shift;
     my $userinput= "$cmd:$tail";      my $userinput= "$cmd:$tail";
           
     my $fname = $tail;      my ($fname) = split(/:/,$tail); # This allows for interactive testing
                                       # e.g. manual telnet and unsub:res:
                                       # Otherwise the \r gets in the way. 
       chomp($fname);
       Debug("Unsubscribing $fname");
     if (-e $fname) {      if (-e $fname) {
  Reply($client, &unsub($client,$fname,$clientip), $userinput);   Debug("Exists");
    Reply($client, &unsub($fname,$clientip), $userinput);
     } else {      } else {
  Failure($client, "not_found\n", $userinput);   Failure($client, "not_found\n", $userinput);
     }      }
     return 1;      return 1;
 }  }
 RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0);  RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0);
   
 #   Subscribe to a resource  #   Subscribe to a resource
 #  #
Line 1413  sub RolesPutHandler { Line 1417  sub RolesPutHandler {
     my $client     = shift;      my $client     = shift;
     my $userinput  = "$cmd:$tail";      my $userinput  = "$cmd:$tail";
   
     my ($exedom,$exeuser,$udom,$uname,$what)   =split(/:/,$tail);      my ( $exedom, $exeuser, $udom, $uname,  $what) = split(/:/,$tail);
     &Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom.      
    "what = ".$what);  
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
Line 1617  sub GetProfileEntryEncrypted { Line 1621  sub GetProfileEntryEncrypted {
           
     return 1;      return 1;
 }  }
 RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0);  RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);
   
 #  #
 #   Deletes a key in a user profile database.  #   Deletes a key in a user profile database.
Line 1848  sub DumpWithRegexp { Line 1852  sub DumpWithRegexp {
 }  }
 RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0);  RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0);
   
 #  Store an aitem in any database but the roles database.  #  Store an aitem in any resource meta data(?) or database with
   #  versioning?
 #  #
 #  Parameters:  #  Parameters:
 #    $cmd                - Request command keyword.  #    $cmd                - Request command keyword.
Line 2223  sub DumpCourseIdHandler { Line 2228  sub DumpCourseIdHandler {
     }      }
     unless (defined($since)) { $since=0; }      unless (defined($since)) { $since=0; }
     my $qresult='';      my $qresult='';
       logthis(" Looking for $description  since $since");
     my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());      my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {      if ($hashref) {
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($descr,$lasttime)=split(/\:/,$value);      my ($descr,$lasttime)=split(/\:/,$value);
       logthis("Got:  key = $key descr = $descr time: $lasttime");
     if ($lasttime<$since) {       if ($lasttime<$since) { 
    logthis("Skipping .. too early");
  next;    next; 
     }      }
     if ($description eq '.') {      if ($description eq '.') {
    logthis("Adding wildcard match");
  $qresult.=$key.'='.$descr.'&';   $qresult.=$key.'='.$descr.'&';
     } else {      } else {
  my $unescapeVal = &unescape($descr);   my $unescapeVal = &unescape($descr);
    logthis("Matching with $unescapeVal");
  if (eval('$unescapeVal=~/$description/i')) {   if (eval('$unescapeVal=~/$description/i')) {
       logthis("Adding on match");
     $qresult.="$key=$descr&";      $qresult.="$key=$descr&";
  }   }
     }      }
Line 2493  sub LsHandler { Line 2503  sub LsHandler {
   
     my $userinput = "$cmd:$ulsdir";      my $userinput = "$cmd:$ulsdir";
   
       chomp($ulsdir);
   
     my $ulsout='';      my $ulsout='';
     my $ulsfn;      my $ulsfn;
       logthis("ls for '$ulsdir'");
     if (-e $ulsdir) {      if (-e $ulsdir) {
    logthis("ls - directory exists");
  if(-d $ulsdir) {   if(-d $ulsdir) {
       logthis("ls  $ulsdir is a file");
     if (opendir(LSDIR,$ulsdir)) {      if (opendir(LSDIR,$ulsdir)) {
  while ($ulsfn=readdir(LSDIR)) {   while ($ulsfn=readdir(LSDIR)) {
     my @ulsstats=stat($ulsdir.'/'.$ulsfn);      my @ulsstats=stat($ulsdir.'/'.$ulsfn);
Line 2680  sub ProcessRequest { Line 2695  sub ProcessRequest {
     # Split off the request keyword from the rest of the stuff.      # Split off the request keyword from the rest of the stuff.
         
     my ($command, $tail) = split(/:/, $userinput, 2);      my ($command, $tail) = split(/:/, $userinput, 2);
       chomp($command);
       chomp($tail);
   
     Debug("Command received: $command, encoded = $wasenc");      Debug("Command received: $command, encoded = $wasenc");
   
Line 2721  sub ProcessRequest { Line 2738  sub ProcessRequest {
     $KeepGoing = &$Handler($command, $tail, $client);      $KeepGoing = &$Handler($command, $tail, $client);
  } else {   } else {
     Debug("Refusing to dispatch because ok is false");      Debug("Refusing to dispatch because ok is false");
     Failure($client, "refused", $userinput);      Failure($client, "refused\n", $userinput);
  }   }
   
   
Line 3808  sub propath { Line 3825  sub propath {
   
 sub ishome {  sub ishome {
     my $author=shift;      my $author=shift;
       Debug("ishome: $author");
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
       Debug("     after big regsub: $author");
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
       Debug("      domain: $udom  user: $uname");
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
       Debug("     path = $proname");
     if (-e $proname) {      if (-e $proname) {
  return 'owner';   return 'owner';
     } else {      } else {
Line 4036  sub ManagePermissions { Line 4057  sub ManagePermissions {
     my $authtype= shift;      my $authtype= shift;
   
     # See if the request is of the form /$domain/_au      # See if the request is of the form /$domain/_au
     &logthis("ruequest is $request");      &logthis("request is $request");
     if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...      if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
  my $execdir = $perlvar{'lonDaemons'};   my $execdir = $perlvar{'lonDaemons'};
  my $userhome= "/home/$user" ;   my $userhome= "/home/$user" ;
Line 4276  sub addline { Line 4297  sub addline {
     my $expr='^'.$hostid.':'.$ip.':';      my $expr='^'.$hostid.':'.$ip.':';
     $expr =~ s/\./\\\./g;      $expr =~ s/\./\\\./g;
     my $sh;      my $sh;
       Debug("Looking for $expr");
     if ($sh=IO::File->new("$fname.subscription")) {      if ($sh=IO::File->new("$fname.subscription")) {
  while (my $subline=<$sh>) {   while (my $subline=<$sh>) {
     if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}      Debug("addline: line: $subline");
       if ($subline !~ /$expr/) {
    $contents.= $subline;
       } else {
    Debug("Found $subline");
    $found=1;
       }
  }   }
  $sh->close();   $sh->close();
     }      }
     $sh=IO::File->new(">$fname.subscription");      $sh=IO::File->new(">$fname.subscription");
     if ($contents) { print $sh $contents; }      if ($contents) { print $sh $contents; }
     if ($newline) { print $sh $newline; }      if ($newline) { 
    Debug("Appending $newline");
    print $sh $newline; 
       }
     $sh->close();      $sh->close();
     return $found;      return $found;
 }  }
Line 4357  sub chatadd { Line 4388  sub chatadd {
 sub unsub {  sub unsub {
     my ($fname,$clientip)=@_;      my ($fname,$clientip)=@_;
     my $result;      my $result;
     if (unlink("$fname.$clientname")) {  #    if (unlink("$fname.$clientname")) {
  $result="ok\n";  # $result="ok\n";
     } else {  #    } else {
  $result="not_subscribed\n";  # $result="not_subscribed\n";
     }  #    }
       unlink("$fname.$clientname");
     if (-e "$fname.subscription") {      if (-e "$fname.subscription") {
    Debug ("Processing subscription file $fname.subscription");
  my $found=&addline($fname,$clientname,$clientip,'');   my $found=&addline($fname,$clientname,$clientip,'');
  if ($found) { $result="ok\n"; }   if ($found) { 
       Debug("Old linek found");
       $result="ok\n"; 
    } else {
       $result = "not_subscribed\n";
    }
     } else {      } else {
  if ($result != "ok\n") { $result="not_subscribed\n"; }   Debug("No Subscription file $fname.subscription");
    if ($result ne "ok\n") { $result="not_subscribed\n"; }
     }      }
     return $result;      return $result;
 }  }
Line 4419  sub thisversion { Line 4458  sub thisversion {
   
 sub subscribe {  sub subscribe {
     my ($userinput,$clientip)=@_;      my ($userinput,$clientip)=@_;
       chomp($userinput);
     my $result;      my $result;
     my ($cmd,$fname)=split(/:/,$userinput);      my ($cmd,$fname)=split(/:/,$userinput);
     my $ownership=&ishome($fname);      my $ownership=&ishome($fname);
       Debug("subscribe: Owner = $ownership file: '$fname'");
     if ($ownership eq 'owner') {      if ($ownership eq 'owner') {
 # explitly asking for the current version?  # explitly asking for the current version?
         unless (-e $fname) {          unless (-e $fname) {
       Debug("subscribe - does not exist");
             my $currentversion=&currentversion($fname);              my $currentversion=&currentversion($fname);
     if (&thisversion($fname)==$currentversion) {      if (&thisversion($fname)==$currentversion) {
                 if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {                  if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
Line 4440  sub subscribe { Line 4482  sub subscribe {
             }              }
         }          }
  if (-e $fname) {   if (-e $fname) {
       Debug("subscribe - exists");
     if (-d $fname) {      if (-d $fname) {
  $result="directory\n";   $result="directory\n";
     } else {      } else {
Line 4494  sub make_passwd_file { Line 4537  sub make_passwd_file {
  #   #
  my $uid = getpwnam($uname);   my $uid = getpwnam($uname);
  if((defined $uid) && ($uid == 0)) {   if((defined $uid) && ($uid == 0)) {
       &logthis(">>>Attempted add of privileged account blocked<<<");
     return "no_priv_account_error\n";      return "no_priv_account_error\n";
  }   }
   
Line 4509  sub make_passwd_file { Line 4553  sub make_passwd_file {
   
  my $useraddok = $?;   my $useraddok = $?;
  if($useraddok > 0) {   if($useraddok > 0) {
     &logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok));      my $lcstring = lcuseraddstrerror($useraddok);
       &logthis("Failed lcuseradd: $lcstring");
       return "error: lcuseradd failed: $lcstring\n";
  }   }
  my $pf = IO::File->new(">$passfilename");   my $pf = IO::File->new(">$passfilename");
  print $pf "unix:\n";   print $pf "unix:\n";
Line 4527  sub make_passwd_file { Line 4573  sub make_passwd_file {
   
 sub sethost {  sub sethost {
     my ($remotereq) = @_;      my ($remotereq) = @_;
       Debug("sethost got $remotereq");
     my (undef,$hostid)=split(/:/,$remotereq);      my (undef,$hostid)=split(/:/,$remotereq);
     if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }      if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
       Debug("sethost attempting to set host $hostid");
     if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {      if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
  $currenthostid=$hostid;   $currenthostid=$hostid;
  $currentdomainid=$hostdom{$hostid};   $currentdomainid=$hostdom{$hostid};
Removed from v.1.178.2.14  
changed lines
  Added in v.1.178.2.20

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