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

Diff for /loncom/lond between versions 1.252 and 1.261

version 1.252, 2004/09/08 18:57:33 version 1.261, 2004/10/18 10:13:46
Line 1065  sub tie_user_hash { Line 1065  sub tie_user_hash {
           
 }  }
   
   #   read_profile
   #
   #   Returns a set of specific entries from a user's profile file.
   #   this is a utility function that is used by both get_profile_entry and
   #   get_profile_entry_encrypted.
   #
   # Parameters:
   #    udom       - Domain in which the user exists.
   #    uname      - User's account name (loncapa account)
   #    namespace  - The profile namespace to open.
   #    what       - A set of & separated queries.
   # Returns:
   #    If all ok: - The string that needs to be shipped back to the user.
   #    If failure - A string that starts with error: followed by the failure
   #                 reason.. note that this probabyl gets shipped back to the
   #                 user as well.
   #
   sub read_profile {
       my ($udom, $uname, $namespace, $what) = @_;
       
       my $hashref = &tie_user_hash($udom, $uname, $namespace,
    &GDBM_READER());
       if ($hashref) {
           my @queries=split(/\&/,$what);
           my $qresult='';
   
    for (my $i=0;$i<=$#queries;$i++) {
       $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
    }
    $qresult=~s/\&$//;              # Remove trailing & from last lookup.
    if (untie %$hashref) {
       return $qresult;
    } else {
       return "error: ".($!+0)." untie (GDBM) Failed";
    }
       } else {
    if ($!+0 == 2) {
       return "error:No such file or GDBM reported bad block error";
    } else {
       return "error: ".($!+0)." tie (GDBM) Failed";
    }
       }
   
   }
 #--------------------- Request Handlers --------------------------------------------  #--------------------- Request Handlers --------------------------------------------
 #  #
 #   By convention each request handler registers itself prior to the sub   #   By convention each request handler registers itself prior to the sub 
Line 1762  sub change_authentication_handler { Line 1806  sub change_authentication_handler {
  chomp($npass);   chomp($npass);
   
  $npass=&unescape($npass);   $npass=&unescape($npass);
    my $oldauth = &get_auth_type($udom, $uname); # Get old auth info.
  my $passfilename = &password_path($udom, $uname);   my $passfilename = &password_path($udom, $uname);
  if ($passfilename) { # Not allowed to create a new user!!   if ($passfilename) { # Not allowed to create a new user!!
     my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);      my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
       #
       #  If the current auth mode is internal, and the old auth mode was
       #  unix, or krb*,  and the user is an author for this domain,
       #  re-run manage_permissions for that role in order to be able
       #  to take ownership of the construction space back to www:www
       #
   
       if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal
    if(&is_author($udom, $uname)) {
       &Debug(" Need to manage author permissions...");
       &manage_permissions("/$udom/_au", $udom, $uname, "internal:");
    }
       }
          
   
     &Reply($client, $result, $userinput);      &Reply($client, $result, $userinput);
  } else {          } else {       
     &Failure($client, "non_authorized\n", $userinput); # Fail the user now.      &Failure($client, "non_authorized\n", $userinput); # Fail the user now.
Line 1994  sub remove_user_file_handler { Line 2054  sub remove_user_file_handler {
  if (-e $udir) {   if (-e $udir) {
     my $file=$udir.'/userfiles/'.$ufile;      my $file=$udir.'/userfiles/'.$ufile;
     if (-e $file) {      if (-e $file) {
    #
    #   If the file is a regular file unlink is fine...
    #   However it's possible the client wants a dir.
    #   removed, in which case rmdir is more approprate:
    #
         if (-f $file){          if (-f $file){
     unlink($file);      unlink($file);
  } elsif(-d $file) {   } elsif(-d $file) {
     rmdir($file);      rmdir($file);
  }   }
  if (-e $file) {   if (-e $file) {
       #  File is still there after we deleted it ?!?
   
     &Failure($client, "failed\n", "$cmd:$tail");      &Failure($client, "failed\n", "$cmd:$tail");
  } else {   } else {
     &Reply($client, "ok\n", "$cmd:$tail");      &Reply($client, "ok\n", "$cmd:$tail");
Line 2040  sub mkdir_user_file_handler { Line 2107  sub mkdir_user_file_handler {
  if (-e $udir) {   if (-e $udir) {
     my $newdir=$udir.'/userfiles/'.$ufile;      my $newdir=$udir.'/userfiles/'.$ufile;
     if (!-e $newdir) {      if (!-e $newdir) {
  mkdir($newdir);   my @parts=split('/',$newdir);
    my $path;
    foreach my $part (@parts) {
       $path .= '/'.$part;
       if (!-e $path) {
    mkdir($path,0770);
       }
    }
  if (!-e $newdir) {   if (!-e $newdir) {
     &Failure($client, "failed\n", "$cmd:$tail");      &Failure($client, "failed\n", "$cmd:$tail");
  } else {   } else {
Line 2387  sub roles_put_handler { Line 2461  sub roles_put_handler {
     #  is done on close this improves the chances the log will be an un-      #  is done on close this improves the chances the log will be an un-
     #  corrupted ordered thing.      #  corrupted ordered thing.
     if ($hashref) {      if ($hashref) {
    my $pass_entry = &get_auth_type($udom, $uname);
    my ($auth_type,$pwd)  = split(/:/, $pass_entry);
    $auth_type = $auth_type.":";
  my @pairs=split(/\&/,$what);   my @pairs=split(/\&/,$what);
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     &manage_permissions($key, $udom, $uname,      &manage_permissions($key, $udom, $uname,
        &get_auth_type( $udom, $uname));         $auth_type);
     $hashref->{$key}=$value;      $hashref->{$key}=$value;
  }   }
  if (untie($hashref)) {   if (untie($hashref)) {
Line 2486  sub get_profile_entry { Line 2563  sub get_profile_entry {
         
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = &tie_user_hash($udom, $uname, $namespace,  
  &GDBM_READER());      my $replystring = read_profile($udom, $uname, $namespace, $what);
     if ($hashref) {      my ($first) = split(/:/,$replystring);
         my @queries=split(/\&/,$what);      if($first ne "error") {
         my $qresult='';   &Reply($client, "$replystring\n", $userinput);
   
  for (my $i=0;$i<=$#queries;$i++) {  
     $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.  
  }  
  $qresult=~s/\&$//;              # Remove trailing & from last lookup.  
  if (untie(%$hashref)) {  
     &Reply($client, "$qresult\n", $userinput);  
  } else {  
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".  
     "while attempting get\n", $userinput);  
  }  
     } else {      } else {
  if ($!+0 == 2) {               # +0 coerces errno -> number 2 is ENOENT   &Failure($client, $replystring." while attempting get\n", $userinput);
     &Failure($client, "error:No such file or ".  
     "GDBM reported bad block error\n", $userinput);  
  } else {                        # Some other undifferentiated err.  
     &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".  
     "while attempting get\n", $userinput);  
  }  
     }      }
     return 1;      return 1;
   
   
 }  }
 &register_handler("get", \&get_profile_entry, 0,1,0);  &register_handler("get", \&get_profile_entry, 0,1,0);
   
Line 2541  sub get_profile_entry_encrypted { Line 2603  sub get_profile_entry_encrypted {
         
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);      my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     chomp($what);      chomp($what);
     my $hashref = &tie_user_hash($udom, $uname, $namespace,      my $qresult = read_profile($udom, $uname, $namespace, $what);
  &GDBM_READER());      my ($first) = split(/:/, $qresult);
     if ($hashref) {      if($first ne "error") {
         my @queries=split(/\&/,$what);  
         my $qresult='';   if ($cipher) {
  for (my $i=0;$i<=$#queries;$i++) {      my $cmdlength=length($qresult);
     $qresult.="$hashref->{$queries[$i]}&";      $qresult.="         ";
  }      my $encqresult='';
  if (untie(%$hashref)) {      for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
     $qresult=~s/\&$//;   $encqresult.= unpack("H16", 
     if ($cipher) {       $cipher->encrypt(substr($qresult,
  my $cmdlength=length($qresult);       $encidx,
  $qresult.="         ";       8)));
  my $encqresult='';  
  for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {  
     $encqresult.= unpack("H16",   
  $cipher->encrypt(substr($qresult,  
  $encidx,  
  8)));  
  }  
  &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);  
     } else {  
  &Failure( $client, "error:no_key\n", $userinput);  
     }      }
       &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".   &Failure( $client, "error:no_key\n", $userinput);
     "while attempting eget\n", $userinput);      }
  }  
     } else {      } else {
  &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".   &Failure($client, "$qresult while attempting eget\n", $userinput);
  "while attempting eget\n", $userinput);  
     }      }
           
     return 1;      return 1;
 }  }
 &register_handler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);  &register_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0);
 #  #
 #   Deletes a key in a user profile database.  #   Deletes a key in a user profile database.
 #     #   
Line 3124  sub put_course_id_handler { Line 3176  sub put_course_id_handler {
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {      if ($hashref) {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$descr,$inst_code)=split(/=/,$pair);
     $hashref->{$key}=$value.':'.$now;      $hashref->{$key}=$descr.':'.$inst_code.':'.$now;
  }   }
  if (untie(%$hashref)) {   if (untie(%$hashref)) {
     &Reply($client, "ok\n", $userinput);      &Reply( $client, "ok\n", $userinput);
  } else {   } else {
     &Failure( $client, "error: ".($!+0)      &Failure($client, "error: ".($!+0)
      ." untie(GDBM) Failed ".       ." untie(GDBM) Failed ".
      "while attempting courseidput\n", $userinput);       "while attempting courseidput\n", $userinput);
  }   }
     } else {      } else {
  &Failure( $client, "error: ".($!+0)   &Failure($client, "error: ".($!+0)
  ." tie(GDBM) Failed ".   ." tie(GDBM) Failed ".
  "while attempting courseidput\n", $userinput);   "while attempting courseidput\n", $userinput);
     }      }
       
   
     return 1;      return 1;
 }  }
Line 4888  sub make_new_child { Line 4941  sub make_new_child {
     exit;      exit;
           
 }  }
   #
   #   Determine if a user is an author for the indicated domain.
   #
   # Parameters:
   #    domain          - domain to check in .
   #    user            - Name of user to check.
   #
   # Return:
   #     1             - User is an author for domain.
   #     0             - User is not an author for domain.
   sub is_author {
       my ($domain, $user) = @_;
   
       &Debug("is_author: $user @ $domain");
   
       my $hashref = &tie_user_hash($domain, $user, "roles",
    &GDBM_READER());
   
       #  Author role should show up as a key /domain/_au
   
       my $key   = "/$domain/_au";
       my $value = $hashref->{$key};
   
       if(defined($value)) {
    &Debug("$user @ $domain is an author");
       }
   
       return defined($value);
   }
 #  #
 #   Checks to see if the input roleput request was to set  #   Checks to see if the input roleput request was to set
 # an author role.  If so, invokes the lchtmldir script to set  # an author role.  If so, invokes the lchtmldir script to set
Line 4904  sub make_new_child { Line 4984  sub make_new_child {
 sub manage_permissions  sub manage_permissions
 {  {
   
   
     my ($request, $domain, $user, $authtype) = @_;      my ($request, $domain, $user, $authtype) = @_;
   
       &Debug("manage_permissions: $request $domain $user $authtype");
   
     # See if the request is of the form /$domain/_au      # See if the request is of the form /$domain/_au
     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" ;
  &logthis("system $execdir/lchtmldir $userhome $user $authtype");   &logthis("system $execdir/lchtmldir $userhome $user $authtype");
    &Debug("Setting homedir permissions for $userhome");
  system("$execdir/lchtmldir $userhome $user $authtype");   system("$execdir/lchtmldir $userhome $user $authtype");
     }      }
 }  }
Line 5006  sub get_auth_type Line 5090  sub get_auth_type
  Debug("Password info = $realpassword\n");   Debug("Password info = $realpassword\n");
  my ($authtype, $contentpwd) = split(/:/, $realpassword);   my ($authtype, $contentpwd) = split(/:/, $realpassword);
  Debug("Authtype = $authtype, content = $contentpwd\n");   Debug("Authtype = $authtype, content = $contentpwd\n");
  my $availinfo = '';   return "$authtype:$contentpwd";     
  if($authtype eq 'krb4' or $authtype eq 'krb5') {  
     $availinfo = $contentpwd;  
  }  
   
  return "$authtype:$availinfo";  
     } else {      } else {
  Debug("Returning nouser");   Debug("Returning nouser");
  return "nouser";   return "nouser";
Line 5360  sub make_passwd_file { Line 5439  sub make_passwd_file {
     if ($umode eq 'krb4' or $umode eq 'krb5') {      if ($umode eq 'krb4' or $umode eq 'krb5') {
  {   {
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
     print $pf "$umode:$npass\n";      if ($pf) {
    print $pf "$umode:$npass\n";
       } else {
    $result = "pass_file_failed_error";
       }
  }   }
     } elsif ($umode eq 'internal') {      } elsif ($umode eq 'internal') {
  my $salt=time;   my $salt=time;
Line 5369  sub make_passwd_file { Line 5452  sub make_passwd_file {
  {   {
     &Debug("Creating internal auth");      &Debug("Creating internal auth");
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
     print $pf "internal:$ncpass\n";       if($pf) {
    print $pf "internal:$ncpass\n"; 
       } else {
    $result = "pass_file_failed_error";
       }
  }   }
     } elsif ($umode eq 'localauth') {      } elsif ($umode eq 'localauth') {
  {   {
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
     print $pf "localauth:$npass\n";      if($pf) {
    print $pf "localauth:$npass\n";
       } else {
    $result = "pass_file_failed_error";
       }
  }   }
     } elsif ($umode eq 'unix') {      } elsif ($umode eq 'unix') {
  {   {
Line 5413  sub make_passwd_file { Line 5504  sub make_passwd_file {
  $result = "lcuseradd_failed:$error_text\n";   $result = "lcuseradd_failed:$error_text\n";
     }  else {      }  else {
  my $pf = IO::File->new(">$passfilename");   my $pf = IO::File->new(">$passfilename");
  print $pf "unix:\n";   if($pf) {
       print $pf "unix:\n";
    } else {
       $result = "pass_file_failed_error";
    }
     }      }
  }   }
     } elsif ($umode eq 'none') {      } elsif ($umode eq 'none') {
  {   {
     my $pf = IO::File->new("> $passfilename");      my $pf = IO::File->new("> $passfilename");
     print $pf "none:\n";      if($pf) {
    print $pf "none:\n";
       } else {
    $result = "pass_file_failed_error";
       }
  }   }
     } else {      } else {
  $result="auth_mode_error\n";   $result="auth_mode_error\n";
Removed from v.1.252  
changed lines
  Added in v.1.261

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