[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.194 and 1.197

version 1.194, 2001/12/27 17:00:30 version 1.197, 2002/01/04 16:31:41
Line 64 Line 64
 # 12/5 Guy Albertelli  # 12/5 Guy Albertelli
 # 12/6,12/7,12/12 Gerd Kortemeyer  # 12/6,12/7,12/12 Gerd Kortemeyer
 # 12/18 Scott Harrison  # 12/18 Scott Harrison
 # 12/21,12/22,12/27 Gerd Kortemeyer  # 12/21,12/22,12/27,12/28 Gerd Kortemeyer
   # YEAR=2002
   # 1/4 Gerd Kortemeyer
 #  #
 ###  ###
   
Line 84  use GDBM_File; Line 86  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use HTML::TokeParser;  use HTML::TokeParser;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   my $readit;
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
   
Line 1703  sub assignrole { Line 1706  sub assignrole {
 }  }
   
 # -------------------------------------------------- Modify user authentication  # -------------------------------------------------- Modify user authentication
   # Overrides without validation
   
 sub modifyuserauth {  sub modifyuserauth {
     my ($udom,$uname,$umode,$upass)=@_;      my ($udom,$uname,$umode,$upass)=@_;
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
     &logthis('Call to modify user authentication'.$udom.', '.$uname.', '.      unless (&allowed('mau',$udom)) { return 'refused'; }
       &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
              $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});                 $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});  
     my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.      my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
      &escape($upass),$uhome);       &escape($upass),$uhome);
       &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
           'Authentication changed for '.$udom.', '.$uname.', '.$umode.
            '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
       &log($udom,,$uname,$uhome,
           'Authentication changed by '.$ENV{'user.domain'}.', '.
                                        $ENV{'user.name'}.', '.$umode.
            '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
     unless ($reply eq 'ok') {      unless ($reply eq 'ok') {
           &logthis('Authentication mode error: '.$reply);
  return 'error: '.$reply;   return 'error: '.$reply;
     }         }   
     return 'ok';      return 'ok';
Line 1720  sub modifyuserauth { Line 1734  sub modifyuserauth {
   
   
 sub modifyuser {  sub modifyuser {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene)=@_;      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,
           $forceid)=@_;
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
      $last.', '.$gene.' by '.       $last.', '.$gene.'(forceid: '.$forceid.') by '.
              $ENV{'user.name'}.' at '.$ENV{'user.domain'});                 $ENV{'user.name'}.' at '.$ENV{'user.domain'});  
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
Line 1761  sub modifyuser { Line 1776  sub modifyuser {
     if ($uid) {      if ($uid) {
        $uid=~tr/A-Z/a-z/;         $uid=~tr/A-Z/a-z/;
        my %uidhash=&idrget($udom,$uname);         my %uidhash=&idrget($udom,$uname);
        if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)) {         if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/) 
            && (!$forceid)) {
   unless ($uid eq $uidhash{$uname}) {    unless ($uid eq $uidhash{$uname}) {
       return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid;        return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid;
           }            }
Line 1790  sub modifyuser { Line 1806  sub modifyuser {
   
 sub modifystudent {  sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
         $end,$start)=@_;          $end,$start,$forceid)=@_;
     my $cid='';      my $cid='';
     unless ($cid=$ENV{'request.course.id'}) {      unless ($cid=$ENV{'request.course.id'}) {
  return 'not_in_class';   return 'not_in_class';
     }      }
 # --------------------------------------------------------------- Make the user  # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser      my $reply=&modifyuser
  ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene);   ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid);
     unless ($reply eq 'ok') { return $reply; }      unless ($reply eq 'ok') { return $reply; }
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) {       if (($uhome eq '') || ($uhome eq 'no_host')) { 
Line 2555  sub goodbye { Line 2571  sub goodbye {
   
 BEGIN {  BEGIN {
 # ------------------------------------------------------------ Read access.conf  # ------------------------------------------------------------ Read access.conf
       unless ($readit) {
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/access.conf");      my $config=Apache::File->new("/etc/httpd/conf/access.conf");
   
Line 2640  $dumpcount=0; Line 2657  $dumpcount=0;
   
 &logtouch();  &logtouch();
 &logthis('<font color=yellow>INFO: Read configuration</font>');  &logthis('<font color=yellow>INFO: Read configuration</font>');
   $readit=1;
   }
 }  }
   
 1;  1;
Removed from v.1.194  
changed lines
  Added in v.1.197

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