[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.1172.2.118.2.13 and 1.1172.2.118.2.14

version 1.1172.2.118.2.13, 2021/01/03 01:47:59 version 1.1172.2.118.2.14, 2021/01/04 13:41:25
Line 125  our @EXPORT = qw(%env); Line 125  our @EXPORT = qw(%env);
  $logid ++;   $logid ++;
         my $now = time();          my $now = time();
  my $id=$now.'00000'.$$.'00000'.$logid;   my $id=$now.'00000'.$$.'00000'.$logid;
           my $ip = &get_requestor_ip();
         my $logentry = {          my $logentry = {
                          $id => {                           $id => {
                                   'exe_uname' => $env{'user.name'},                                    'exe_uname' => $env{'user.name'},
                                   'exe_udom'  => $env{'user.domain'},                                    'exe_udom'  => $env{'user.domain'},
                                   'exe_time'  => $now,                                    'exe_time'  => $now,
                                   'exe_ip'    => $ENV{'REMOTE_ADDR'},                                    'exe_ip'    => $ip,
                                   'delflag'   => $delflag,                                    'delflag'   => $delflag,
                                   'logentry'  => $storehash,                                    'logentry'  => $storehash,
                                   'uname'     => $uname,                                    'uname'     => $uname,
Line 5569  sub checkout { Line 5570  sub checkout {
     my ($symb,$tuname,$tudom,$tcrsid)=@_;      my ($symb,$tuname,$tudom,$tcrsid)=@_;
     my $now=time;      my $now=time;
     my $lonhost=$perlvar{'lonHostID'};      my $lonhost=$perlvar{'lonHostID'};
       my $ip = &get_requestor_ip();
     my $infostr=&escape(      my $infostr=&escape(
                  'CHECKOUTTOKEN&'.                   'CHECKOUTTOKEN&'.
                  $tuname.'&'.                   $tuname.'&'.
                  $tudom.'&'.                   $tudom.'&'.
                  $tcrsid.'&'.                   $tcrsid.'&'.
                  $symb.'&'.                   $symb.'&'.
                  $now.'&'.$ENV{'REMOTE_ADDR'});                   $now.'&'.$ip);
     my $token=&reply('tmpput:'.$infostr,$lonhost);      my $token=&reply('tmpput:'.$infostr,$lonhost);
     if ($token=~/^error\:/) {      if ($token=~/^error\:/) {
         &logthis("<font color=\"blue\">WARNING: ".          &logthis("<font color=\"blue\">WARNING: ".
Line 5589  sub checkout { Line 5591  sub checkout {
   
     my %infohash=('resource.0.outtoken' => $token,      my %infohash=('resource.0.outtoken' => $token,
                   'resource.0.checkouttime' => $now,                    'resource.0.checkouttime' => $now,
                   'resource.0.outremote' => $ENV{'REMOTE_ADDR'});                    'resource.0.outremote' => $ip);
   
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {      unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';         return '';
Line 5620  sub checkin { Line 5622  sub checkin {
     $lonhost=~tr/A-Z/a-z/;      $lonhost=~tr/A-Z/a-z/;
     my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;      my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
     $dtoken=~s/\W/\_/g;      $dtoken=~s/\W/\_/g;
       my $ip = &get_requestor_ip();
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=      my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));                   split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
   
Line 5636  sub checkin { Line 5639  sub checkin {
   
     my %infohash=('resource.0.intoken' => $token,      my %infohash=('resource.0.intoken' => $token,
                   'resource.0.checkintime' => $now,                    'resource.0.checkintime' => $now,
                   'resource.0.inremote' => $ENV{'REMOTE_ADDR'});                    'resource.0.inremote' => $ip);
   
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {      unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';         return '';
Line 7069  sub putstore { Line 7072  sub putstore {
        foreach my $key (keys(%{$storehash})) {         foreach my $key (keys(%{$storehash})) {
            $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';             $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
        }         }
        $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).         my $ip = &get_requestor_ip();
          $namevalue .= 'ip='.&escape($ip).
                      '&host='.&escape($perlvar{'lonHostID'}).                       '&host='.&escape($perlvar{'lonHostID'}).
                      '&version='.$esc_v.                       '&version='.$esc_v.
                      '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});                       '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
Line 9994  sub modifyuserauth { Line 9998  sub modifyuserauth {
              ' in domain '.$env{'request.role.domain'});                 ' in domain '.$env{'request.role.domain'});  
     my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.      my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
      &escape($upass),$uhome);       &escape($upass),$uhome);
       my $ip = &get_requestor_ip();
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},      &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
         'Authentication changed for '.$udom.', '.$uname.', '.$umode.          'Authentication changed for '.$udom.', '.$uname.', '.$umode.
          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);           '(Remote '.$ip.'): '.$reply);
     &log($udom,,$uname,$uhome,      &log($udom,,$uname,$uhome,
         'Authentication changed by '.$env{'user.domain'}.', '.          'Authentication changed by '.$env{'user.domain'}.', '.
                                      $env{'user.name'}.', '.$umode.                                       $env{'user.name'}.', '.$umode.
          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);           '(Remote '.$ip.'): '.$reply);
     unless ($reply eq 'ok') {      unless ($reply eq 'ok') {
         &logthis('Authentication mode error: '.$reply);          &logthis('Authentication mode error: '.$reply);
  return 'error: '.$reply;   return 'error: '.$reply;
Line 10521  sub store_userdata { Line 10526  sub store_userdata {
             if (($uhome eq '') || ($uhome eq 'no_host')) {              if (($uhome eq '') || ($uhome eq 'no_host')) {
                 $result = 'error: no_host';                  $result = 'error: no_host';
             } else {              } else {
                 $storehash->{'ip'} = $ENV{'REMOTE_ADDR'};                  $storehash->{'ip'} = &get_requestor_ip();
                 $storehash->{'host'} = $perlvar{'lonHostID'};                  $storehash->{'host'} = $perlvar{'lonHostID'};
   
                 my $namevalue='';                  my $namevalue='';
Line 13490  sub uses_sts { Line 13495  sub uses_sts {
     return;      return;
 }  }
   
   sub get_requestor_ip {
       my ($r,$nolookup,$noproxy) = @_;
       my $from_ip;
       if (ref($r)) {
           $from_ip = $r->get_remote_host($nolookup);
       } else {
           $from_ip = $ENV{'REMOTE_ADDR'};
       }
       return $from_ip;
   }
   
 # ------------------------------------------------------------- Declutters URLs  # ------------------------------------------------------------- Declutters URLs
   
 sub declutter {  sub declutter {
Removed from v.1.1172.2.118.2.13  
changed lines
  Added in v.1.1172.2.118.2.14

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