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

Diff for /loncom/lond between versions 1.178.2.12 and 1.178.2.22

version 1.178.2.12, 2004/03/22 10:02:24 version 1.178.2.22, 2004/05/04 10:09:38
Line 237  sub TieUserHash { Line 237  sub TieUserHash {
     $namespace=~s/\//\_/g; # / -> _      $namespace=~s/\//\_/g; # / -> _
     $namespace=~s/\W//g; # whitespace eliminated.      $namespace=~s/\W//g; # whitespace eliminated.
     my $proname     = propath($domain, $user);      my $proname     = propath($domain, $user);
          
     # If this is a namespace for which a history is kept,      # If this is a namespace for which a history is kept,
     # make the history log entry:      # make the history log entry:
           
           
     unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {      if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) {
    my $args = scalar @_;
    Debug(" Opening history: $namespace $args");
  my $hfh = IO::File->new(">>$proname/$namespace.hist");    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
  if($hfh) {   if($hfh) {
     my $now = time;      my $now = time;
Line 739  sub AuthenticateHandler { Line 741  sub AuthenticateHandler {
     chomp($upass);      chomp($upass);
     $upass=unescape($upass);      $upass=unescape($upass);
   
     # Fetch the user authentication information:      my $pwdcorrect = ValidateUser($udom, $uname, $upass);
          if($pwdcorrect) {
     my $realpasswd = GetAuthType($udom, $uname);   Reply( $client, "authorized\n", $userinput);
     if($realpasswd ne "nouser") { # nouser means no passwd file.  
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);  
  my $pwdcorrect=0;  
  #   #
  #   Authenticate against password stored in the internal file.   #  Bad credentials: Failed to authorize
  #   #
  Debug("Authenticating via $howpwd");  
  if ($howpwd eq 'internal') {  
     &Debug("Internal auth");  
     $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);  
     #  
     #   Authenticate against the unix password file.  
     #  
  } elsif ($howpwd eq 'unix') {  
     &Debug("Unix auth");  
     if((getpwnam($uname))[1] eq "") { #no such user!  
  $pwdcorrect = 0;  
     } else {  
  $contentpwd=(getpwnam($uname))[1];  
  my $pwauth_path="/usr/local/sbin/pwauth";  
  unless ($contentpwd eq 'x') { # Not in shadow file.  
     $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);  
  } elsif (-e $pwauth_path) { # In shadow file so  
     open PWAUTH, "|$pwauth_path" or # use external program  
  die "Cannot invoke authentication";  
     print PWAUTH "$uname\n$upass\n";  
     close PWAUTH;  
     $pwdcorrect=!$?;  
  }  
     }  
     #  
     #   Authenticate against a Kerberos 4 server:  
     #  
  } elsif ($howpwd eq 'krb4') {  
     my $null=pack("C",0);  
     unless ($upass=~/$null/) {  
  my $krb4_error = &Authen::Krb4::get_pw_in_tkt($uname,  
       "",  
       $contentpwd,  
       'krbtgt',  
       $contentpwd,  
       1,  
       $upass);  
  if (!$krb4_error) {  
     $pwdcorrect = 1;  
  } else {   
     $pwdcorrect=0;   
     # log error if it is not a bad password  
     if ($krb4_error != 62) {  
  &logthis('krb4:'.$uname.','.$contentpwd.','.  
  &Authen::Krb4::get_err_txt($Authen::Krb4::error));  
     }  
  }  
     }  
     #  
     #   Authenticate against a Kerberos 5 server:  
     #  
  } elsif ($howpwd eq 'krb5') {  
     my $null=pack("C",0);  
     unless ($upass=~/$null/) {  
  my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd);  
  my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd;  
  my $krbserver=&Authen::Krb5::parse_name($krbservice);  
  my $credentials=&Authen::Krb5::cc_default();  
  $credentials->initialize($krbclient);  
  my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,  
  $krbserver,  
  $upass,  
  $credentials);  
  $pwdcorrect = ($krbreturn == 1);  
     } else {   
  $pwdcorrect=0;   
     }  
     #  
     #  Finally, the user may have written in an authentication module.  
     #  in that case, if requested, authenticate against it.  
     #  
  } elsif ($howpwd eq 'localauth') {  
     $pwdcorrect=&localauth::localauth($uname,$upass,$contentpwd);  
  }  
  #  
  #   Successfully authorized.  
  #  
  if ($pwdcorrect) {  
     Reply( $client, "authorized\n", $userinput);  
     #  
     #  Bad credentials: Failed to authorize  
     #  
  } else {  
     Failure( $client, "non_authorized\n", $userinput);  
  }  
  #  Used to be unknown_user but that allows crackers to   
  #  distinguish between bad username and bad password so...  
  #    
     } else {      } else {
  Failure( $client, "non_authorized\n", $userinput);   Failure( $client, "non_authorized\n", $userinput);
     }      }
   
     return 1;      return 1;
 }  }
 RegisterHandler("auth", \&AuthenticateHandler, 1, 1, 0);  RegisterHandler("auth", \&AuthenticateHandler, 1, 1, 0);
Line 878  sub ChangePasswordHandler { Line 790  sub ChangePasswordHandler {
     #  npass - New password.      #  npass - New password.
         
     my ($udom,$uname,$upass,$npass)=split(/:/,$tail);      my ($udom,$uname,$upass,$npass)=split(/:/,$tail);
     chomp($npass);  
     $upass=&unescape($upass);      $upass=&unescape($upass);
     $npass=&unescape($npass);      $npass=&unescape($npass);
     &Debug("Trying to change password for $uname");      &Debug("Trying to change password for $uname");
     my $realpasswd  = GetAuthType($udom, $uname);  
     if ($realpasswd ne "nouser") {      # First require that the user can be authenticated with their
       # old password:
   
       my $validated = ValidateUser($udom, $uname, $upass);
       if($validated) {
    my $realpasswd  = GetAuthType($udom, $uname); # Defined since authd.
   
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  if ($howpwd eq 'internal') {   if ($howpwd eq 'internal') {
     &Debug("internal auth");      &Debug("internal auth");
     if (crypt($upass,$contentpwd) eq $contentpwd) {      my $salt=time;
  my $salt=time;      $salt=substr($salt,6,2);
  $salt=substr($salt,6,2);      my $ncpass=crypt($npass,$salt);
  my $ncpass=crypt($npass,$salt);      if(RewritePwFile($udom, $uname, "internal:$ncpass")) {
  if(RewritePwFile($udom, $uname, "internal:$ncpass")) {   &logthis("Result of password change for "
     &logthis("Result of password change for "   ."$uname: pwchange_success");
      ."$uname: pwchange_success");   Reply($client, "ok\n", $userinput);
     Reply($client, "ok\n", $userinput);  
  } else {  
     &logthis("Unable to open $uname passwd "                 
      ."to change password");  
     Failure( $client, "non_authorized\n",$userinput);  
  }  
     } else {      } else {
  Failure($client, "non_authorized\n", $userinput);   &logthis("Unable to open $uname passwd "               
    ."to change password");
    Failure( $client, "non_authorized\n",$userinput);
     }      }
  } elsif ($howpwd eq 'unix') {   } elsif ($howpwd eq 'unix') {
     # Unix means we have to access /etc/password      # Unix means we have to access /etc/password
     # one way or another.  
     # First: Make sure the current password is  
     #        correct  
     &Debug("auth is unix");      &Debug("auth is unix");
     $contentpwd=(getpwnam($uname))[1];      my $execdir=$perlvar{'lonDaemons'};
     my $pwdcorrect = "0";      &Debug("Opening lcpasswd pipeline");
     my $pwauth_path="/usr/local/sbin/pwauth";      my $pf = IO::File->new("|$execdir/lcpasswd > "
     unless ($contentpwd eq 'x') {     ."$perlvar{'lonDaemons'}"
  $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);     ."/logs/lcpasswd.log");
     } elsif (-e $pwauth_path) {      print $pf "$uname\n$npass\n$npass\n";
  open PWAUTH, "|$pwauth_path" or      close $pf;
     die "Cannot invoke authentication";      my $err = $?;
  print PWAUTH "$uname\n$upass\n";      my $result = ($err>0 ? 'pwchange_failure' : 'ok');
  close PWAUTH;      &logthis("Result of password change for $uname: ".
  &Debug("exited pwauth with $? ($uname,$upass) ");       &lcpasswdstrerror($?));
  $pwdcorrect=($? == 0);      Reply($client, "$result\n", $userinput);
     }  
     if ($pwdcorrect) {  
  my $execdir=$perlvar{'lonDaemons'};  
  &Debug("Opening lcpasswd pipeline");  
  my $pf = IO::File->new("|$execdir/lcpasswd > "  
        ."$perlvar{'lonDaemons'}"  
        ."/logs/lcpasswd.log");  
  print $pf "$uname\n$npass\n$npass\n";  
  close $pf;  
  my $err = $?;  
  my $result = ($err>0 ? 'pwchange_failure' : 'ok');  
  &logthis("Result of password change for $uname: ".  
  &lcpasswdstrerror($?));  
  Reply($client, "$result\n", $userinput);  
     } else {  
  Reply($client, "non_authorized\n", $userinput);  
     }  
  } else {   } else {
     # this just means that the current password mode is not      # this just means that the current password mode is not
     # one we know how to change (e.g the kerberos auth modes or      # one we know how to change (e.g the kerberos auth modes or
Line 945  sub ChangePasswordHandler { Line 839  sub ChangePasswordHandler {
     #      #
     Reply( $client, "auth_mode_error\n", $userinput);      Reply( $client, "auth_mode_error\n", $userinput);
  }     }  
     } else {  
  #  used to be unknonw user but that gives out too much info..      }
  #  so make it the same as if the initial passwd was bad.      else {
  #  
  Reply( $client, "non_authorized\n", $userinput);   Reply( $client, "non_authorized\n", $userinput);
     }      }
   
     return 1;      return 1;
 }  }
 RegisterHandler("passwd", \&ChangePasswordHandler, 1, 1, 0);  RegisterHandler("passwd", \&ChangePasswordHandler, 1, 1, 0);
Line 998  sub AddUserHandler { Line 892  sub AddUserHandler {
     for (my $i=3;$i<= ($#fpparts-1);$i++) {      for (my $i=3;$i<= ($#fpparts-1);$i++) {
  $fpnow.='/'.$fpparts[$i];    $fpnow.='/'.$fpparts[$i]; 
  unless (-e $fpnow) {   unless (-e $fpnow) {
       &logthis("mkdir $fpnow");
     unless (mkdir($fpnow,0777)) {      unless (mkdir($fpnow,0777)) {
  $fperror="error: ".($!+0)." mkdir failed while attempting "   $fperror="error: ".($!+0)." mkdir failed while attempting "
     ."makeuser";      ."makeuser";
Line 1097  sub IsHomeHandler { Line 992  sub IsHomeHandler {
         
     my ($udom,$uname)=split(/:/,$tail);      my ($udom,$uname)=split(/:/,$tail);
     chomp($uname);      chomp($uname);
     my $passfile = PasswordPath($udom, $uname);      my $passfile = PasswordFilename($udom, $uname);
     if($passfile) {      if($passfile) {
  Reply( $client, "found\n", $userinput);   Reply( $client, "found\n", $userinput);
     } else {      } else {
Line 1135  sub UpdateResourceHandler { Line 1030  sub UpdateResourceHandler {
         
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my $fname=$tail;      my $fname= $tail; # This allows interactive testing
   
   
     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 1245  sub FetchUserFileHandler { Line 1142  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 1298  sub UnsubscribeHandler { Line 1192  sub UnsubscribeHandler {
     my $client   = shift;      my $client   = shift;
     my $userinput= "$cmd:$tail";      my $userinput= "$cmd:$tail";
           
     my $fname = $tail;      my ($fname) = $tail;
   
       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
 #  #
 # Parameters:  # Parameters:
 #    $cmd      - The command that got us here.  #    $cmd      - The command that got us here.
Line 1520  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 1724  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 1955  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 a set of key=value pairs associated with a versioned name.
 #  #
 #  Parameters:  #  Parameters:
 #    $cmd                - Request command keyword.  #    $cmd                - Request command keyword.
Line 2021  sub StoreHandler { Line 1918  sub StoreHandler {
 }  }
 RegisterHandler("store", \&StoreHandler, 0, 1, 0);  RegisterHandler("store", \&StoreHandler, 0, 1, 0);
 #  #
 #   Restore a prior version of a resource.  #  Dump out all versions of a resource that has key=value pairs associated
   # with it for each version.  These resources are built up via the store
   # command.
 #  #
 #  Parameters:  #  Parameters:
 #     $cmd               - Command keyword.  #     $cmd               - Command keyword.
Line 2035  RegisterHandler("store", \&StoreHandler, Line 1934  RegisterHandler("store", \&StoreHandler,
 #      1  indicating the caller should not yet exit.  #      1  indicating the caller should not yet exit.
 # Side-effects:  # Side-effects:
 #   Writes a reply to the client.  #   Writes a reply to the client.
   #   The reply is a string of the following shape:
   #   version=current&version:keys=k1:k2...&1:k1=v1&1:k2=v2...
   #    Where the 1 above represents version 1.
   #    this continues for all pairs of keys in all versions.
   #
   #
   #    
 #  #
 sub RestoreHandler {  sub RestoreHandler {
     my $cmd     = shift;      my $cmd     = shift;
Line 2330  sub DumpCourseIdHandler { Line 2236  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 2526  sub TmpGetHandler { Line 2437  sub TmpGetHandler {
     my $client    = shift;      my $client    = shift;
     my $userinput = "$cmd:$id";       my $userinput = "$cmd:$id"; 
           
     chomp($id);  
     $id=~s/\W/\_/g;      $id=~s/\W/\_/g;
     my $store;      my $store;
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
Line 2600  sub LsHandler { Line 2511  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 2787  sub ProcessRequest { Line 2703  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);
       $tail =~ s/(\r)//; # This helps people debugging with e.g. telnet.
   
     Debug("Command received: $command, encoded = $wasenc");      Debug("Command received: $command, encoded = $wasenc");
   
Line 2828  sub ProcessRequest { Line 2747  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 3915  sub propath { Line 3834  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 4143  sub ManagePermissions { Line 4066  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 4247  sub GetAuthType { Line 4170  sub GetAuthType {
     }      }
 }  }
   
   #
   #  Validate a user given their domain, name and password.  This utility
   #  function is used by both  AuthenticateHandler and ChangePasswordHandler
   #  to validate the login credentials of a user.
   # Parameters:
   #    $domain    - The domain being logged into (this is required due to
   #                 the capability for multihomed systems.
   #    $user      - The name of the user being validated.
   #    $password  - The user's propoposed password.
   #
   # Returns:
   #     1        - The domain,user,pasword triplet corresponds to a valid
   #                user.
   #     0        - The domain,user,password triplet is not a valid user.
   #
   sub ValidateUser {
       my $domain  = shift;
       my $user    = shift;
       my $password= shift;
   
       # Why negative ~pi you may well ask?  Well this function is about
       # authentication, and therefore very important to get right.
       # I've initialized the flag that determines whether or not I've 
       # validated correctly to a value it's not supposed to get.
       # At the end of this function. I'll ensure that it's not still that
       # value so we don't just wind up returning some accidental value
       # as a result of executing an unforseen code path that
       # did not set $validated.
   
       my $validated = -3.14159;
   
       #  How we authenticate is determined by the type of authentication
       #  the user has been assigned.  If the authentication type is
       #  "nouser", the user does not exist so we will return 0.
   
       my $contents = GetAuthType($domain, $user);
       my ($howpwd, $contentpwd) = split(/:/, $contents);
   
       my $null = pack("C",0); # Used by kerberos auth types.
   
       if ($howpwd ne 'nouser') {
   
    if($howpwd eq "internal") { # Encrypted is in local password file.
       $validated = (crypt($password, $contentpwd) eq $contentpwd);
    }
    elsif ($howpwd eq "unix") { # User is a normal unix user.
       $contentpwd = (getpwnam($user))[1];
       if($contentpwd) {
    if($contentpwd eq 'x') { # Shadow password file...
       my $pwauth_path = "/usr/local/sbin/pwauth";
       open PWAUTH,  "|$pwauth_path" or
    die "Cannot invoke authentication";
       print PWAUTH "$user\n$password\n";
       close PWAUTH;
       $validated = ! $?;
   
    } else {         # Passwords in /etc/passwd. 
       $validated = (crypt($password,
    $contentpwd) eq $contentpwd);
    }
       } else {
    $validated = 0;
       }
    }
    elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain.
       if(! ($password =~ /$null/) ) {
    my $k4error = &Authen::Krb4::get_pw_in_tkt($user,
      "",
      $contentpwd,,
      'krbtgt',
      $contentpwd,
      1,
      $password);
    if(!$k4error) {
       $validated = 1;
    }
    else {
       $validated = 0;
       &logthis('krb4: '.$user.', '.$contentpwd.', '.
        &Authen::Krb4::get_err_txt($Authen::Krb4::error));
    }
       }
       else {
    $validated = 0; # Password has a match with null.
       }
    }
    elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.
       if(!($password =~ /$null/)) { # Null password not allowed.
    my $krbclient = &Authen::Krb5::parse_name($user.'@'
     .$contentpwd);
    my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;
    my $krbserver  = &Authen::Krb5::parse_name($krbservice);
    my $credentials= &Authen::Krb5::cc_default();
    $credentials->initialize($krbclient);
    my $krbreturn  = &Authen::KRb5::get_in_tkt_with_password($krbclient,
    $krbserver,
    $password,
    $credentials);
    $validated = ($krbreturn == 1);
       }
       else {
    $validated = 0;
       }
    }
    elsif ($howpwd eq "localauth") { 
       #  Authenticate via installation specific authentcation method:
       $validated = &localauth::localauth($user, 
          $password, 
          $contentpwd);
    }
    else { # Unrecognized auth is also bad.
       $validated = 0;
    }
       } else {
    $validated = 0;
       }
       #
       #  $validated has the correct stat of the authentication:
       #
   
       unless ($validated != -3.14159) {
    die "ValidateUser - failed to set the value of validated";
       }
       return $validated;
   }
   
   #
   #    Add a line to the subscription list?
   #
 sub addline {  sub addline {
     my ($fname,$hostid,$ip,$newline)=@_;      my ($fname,$hostid,$ip,$newline)=@_;
     my $contents;      my $contents;
Line 4254  sub addline { Line 4306  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;
 }  }
   #
   #    Get chat messages.
   #
 sub getchat {  sub getchat {
     my ($cdom,$cname,$udom,$uname)=@_;      my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;      my %hash;
Line 4291  sub getchat { Line 4355  sub getchat {
     }      }
     return (@participants,@entries);      return (@participants,@entries);
 }  }
   #
   #   Add a chat message
   #
 sub chatadd {  sub chatadd {
     my ($cdom,$cname,$newchat)=@_;      my ($cdom,$cname,$newchat)=@_;
     my %hash;      my %hash;
Line 4331  sub chatadd { Line 4397  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 4393  sub thisversion { Line 4478  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 4414  sub subscribe { Line 4502  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 4462  sub make_passwd_file { Line 4551  sub make_passwd_file {
     print $pf "localauth:$npass\n";      print $pf "localauth:$npass\n";
  }   }
     } elsif ($umode eq 'unix') {      } elsif ($umode eq 'unix') {
  {   #
     my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";   #  Don't allow the creation of privileged accounts!!! that would
     {   #  be real bad!!!
  &Debug("Executing external: ".$execpath);   #
  &Debug("user  = ".$uname.", Password =". $npass);   my $uid = getpwnam($uname);
  my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");   if((defined $uid) && ($uid == 0)) {
  print $se "$uname\n";      &logthis(">>>Attempted add of privileged account blocked<<<");
  print $se "$npass\n";      return "no_priv_account_error\n";
  print $se "$npass\n";   }
     }  
     my $useraddok = $?;   #
     if($useraddok > 0) {   my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
  &logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok));  
     }   &Debug("Executing external: ".$execpath);
     my $pf = IO::File->new(">$passfilename");   &Debug("user  = ".$uname.", Password =". $npass);
     print $pf "unix:\n";   my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
    print $se "$uname\n";
    print $se "$npass\n";
    print $se "$npass\n";
   
    my $useraddok = $?;
    if($useraddok > 0) {
       my $lcstring = lcuseraddstrerror($useraddok);
       &logthis("Failed lcuseradd: $lcstring");
       return "error: lcuseradd failed: $lcstring\n";
  }   }
    my $pf = IO::File->new(">$passfilename");
    print $pf "unix:\n";
    
     } elsif ($umode eq 'none') {      } elsif ($umode eq 'none') {
  {   {
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
Line 4492  sub make_passwd_file { Line 4593  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.12  
changed lines
  Added in v.1.178.2.22

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