[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.1391 and 1.1396

version 1.1391, 2018/11/28 05:05:36 version 1.1396, 2018/12/22 01:56:25
Line 458  sub reply { Line 458  sub reply {
     unless (defined(&hostname($server))) { return 'no_such_host'; }      unless (defined(&hostname($server))) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);      my $answer=subreply($cmd,$server);
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {      if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=\"blue\">WARNING:".          my $logged = $cmd;
                 " $cmd to $server returned $answer</font>");          if ($cmd =~ /^encrypt:([^:]+):/) {
               my $subcmd = $1;
               if (($subcmd eq 'auth') || ($subcmd eq 'passwd') ||
                   ($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||
                   ($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades')) {
                   (undef,undef,my @rest) = split(/:/,$cmd);
                   if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) {
                       splice(@rest,2,1,'Hidden');
                   } elsif ($subcmd eq 'passwd') {
                       splice(@rest,2,2,('Hidden','Hidden'));
                   } elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||
                            ($subcmd eq 'autoexportgrades')) {
                       splice(@rest,3,1,'Hidden');
                   }
                   $logged = join(':',('encrypt:'.$subcmd,@rest));
               }
           }
           &logthis("<font color=\"blue\">WARNING:".
                    " $logged to $server returned $answer</font>");
     }      }
     return $answer;      return $answer;
 }  }
Line 711  sub check_for_valid_session { Line 729  sub check_for_valid_session {
   
     if (!defined($disk_env{'user.name'})      if (!defined($disk_env{'user.name'})
  || !defined($disk_env{'user.domain'})) {   || !defined($disk_env{'user.domain'})) {
           untie(%disk_env);
  return undef;   return undef;
     }      }
   
Line 723  sub check_for_valid_session { Line 742  sub check_for_valid_session {
             $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'};              $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'};
         }          }
     }      }
       untie(%disk_env);
   
     return $handle;      return $handle;
 }  }
Line 747  sub timed_flock { Line 767  sub timed_flock {
     }      }
 }  }
   
   sub get_sessionfile_vars {
       my ($handle,$lonidsdir,$storearr) = @_;
       my %returnhash;
       unless (ref($storearr) eq 'ARRAY') {
           return %returnhash;
       }
       if (-l "$lonidsdir/$handle.id") {
           my $link = readlink("$lonidsdir/$handle.id");
           if ((-e $link) && ($link =~ m{^\Q$lonidsdir\E/(.+)\.id$})) {
               $handle = $1;
           }
       }
       if ((-e "$lonidsdir/$handle.id") &&
           ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) {
           my ($possuname,$possudom,$possuhome) = ($1,$2,$3);
           if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) {
               if (open(my $idf,'+<',"$lonidsdir/$handle.id")) {
                   flock($idf,LOCK_SH);
                   if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
                           &GDBM_READER(),0640)) {
                       foreach my $item (@{$storearr}) {
                           $returnhash{$item} = $disk_env{$item};
                       }
                       untie(%disk_env);
                   }
               }
           }
       }
       return %returnhash;
   }
   
 # ---------------------------------------------------------- Append Environment  # ---------------------------------------------------------- Append Environment
   
 sub appenv {  sub appenv {
Line 1612  sub check_balancer_result { Line 1663  sub check_balancer_result {
                 $is_balancer = 1;                  $is_balancer = 1;
                 $currtargets = $result->{'targets'};                  $currtargets = $result->{'targets'};
                 $currrules = $result->{'rules'};                  $currrules = $result->{'rules'};
                 $dom_balancers = $currbalancer;  
             }              }
             $dom_balancers = $currbalancer;              $dom_balancers = $currbalancer;
         } else {          } else {
Line 1709  sub trusted_domains { Line 1759  sub trusted_domains {
     if (&domain($calldom) eq '') {      if (&domain($calldom) eq '') {
         return ($trusted,$untrusted);          return ($trusted,$untrusted);
     }      }
     unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {      unless ($cmdtype =~ /^(content|shared|enroll|coaurem|othcoau|domroles|catalog|reqcrs|msg)$/) {
         return ($trusted,$untrusted);          return ($trusted,$untrusted);
     }      }
     my $callprimary = &domain($calldom,'primary');      my $callprimary = &domain($calldom,'primary');
Line 1731  sub trusted_domains { Line 1781  sub trusted_domains {
                 map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}};                   map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; 
             }              }
             if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {              if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
                   $possinc{$intcalldom} = 1;
                 map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}};                  map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}};
             }              }
         }          }
Line 1765  sub trusted_domains { Line 1816  sub trusted_domains {
             }              }
             foreach my $exc (@allexc) {              foreach my $exc (@allexc) {
                 if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {                  if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
                     $untrusted = $doms_by_intdom{$exc};                      push(@{$untrusted},@{$doms_by_intdom{$exc}});
                 }                  }
             }              }
             foreach my $inc (@allinc) {              foreach my $inc (@allinc) {
                 if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {                  if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
                     $trusted = $doms_by_intdom{$inc};                      push(@{$trusted},@{$doms_by_intdom{$inc}});
                 }                  }
             }              }
         }          }
Line 5323  sub set_first_access { Line 5374  sub set_first_access {
     my $firstaccess=&get_first_access($type,$symb,$map);      my $firstaccess=&get_first_access($type,$symb,$map);
     if ($firstaccess) {      if ($firstaccess) {
         &logthis("First access time already set ($firstaccess) when attempting ".          &logthis("First access time already set ($firstaccess) when attempting ".
                  "to set new value (type: $type, extent: $res) for $uname:$udom ".                    "to set new value (type: $type, extent: $res) for $uname:$udom ".
                  "in $courseid");                    "in $courseid");
         return 'already_set';          return 'already_set';
     } else {      } else {
         my $start = time;          my $start = time;
Removed from v.1.1391  
changed lines
  Added in v.1.1396

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