[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.1419 and 1.1423

version 1.1419, 2020/03/03 01:16:39 version 1.1423, 2020/07/01 20:08:58
Line 1230  sub choose_server { Line 1230  sub choose_server {
     return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load);      return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load);
 }  }
   
   sub get_course_sessions {
       my ($cnum,$cdom,$lastactivity) = @_;
       my %servers = &internet_dom_servers($cdom);
       my %returnhash;
       foreach my $server (sort(keys(%servers))) {
           my $rep = &reply("coursesessions:$cdom:$cnum:$lastactivity",$server);
           my @pairs=split(/\&/,$rep);
           unless (($rep eq 'unknown_cmd') || ($rep =~ /^error/)) {
               foreach my $item (@pairs) {
                   my ($key,$value)=split(/=/,$item,2);
                   $key = &unescape($key);
                   next if ($key =~ /^error: 2 /);
                   if (exists($returnhash{$key})) {
                       next if ($value < $returnhash{$key});
                   }
                   $returnhash{$key}=$value;
               }
           }
       }
       return %returnhash;
   }
   
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
   
 sub changepass {  sub changepass {
Line 3361  sub repcopy { Line 3383  sub repcopy {
     }      }
 }  }
   
   # ------------------------------------------------- Unsubscribe from a resource
   
   sub unsubscribe {
       my ($fname) = @_;
       my $answer;
       if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return $answer; }
       $fname=~s/[\n\r]//g;
       my $author=$fname;
       $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
       my ($udom,$uname)=split(/\//,$author);
       my $home=homeserver($uname,$udom);
       if ($home eq 'no_host') {
           $answer = 'no_host';
       } elsif (grep { $_ eq $home } &current_machine_ids()) {
           $answer = 'home';
       } else {
           my $defdom = $perlvar{'lonDefDomain'};
           if (&will_trust('content',$defdom,$udom)) {
               $answer = reply("unsub:$fname",$home);
           } else {
               $answer = 'untrusted';
           }
       }
       return $answer;
   }
   
 # ------------------------------------------------ Get server side include body  # ------------------------------------------------ Get server side include body
 sub ssi_body {  sub ssi_body {
     my ($filelink,%form)=@_;      my ($filelink,%form)=@_;
Line 3506  sub remove_stale_resfile { Line 3554  sub remove_stale_resfile {
                                     $stale = 1;                                      $stale = 1;
                                 }                                  }
                                 if ($stale) {                                  if ($stale) {
                                     unlink($fname);                                      if (unlink($fname)) {
                                     if ($uri!~/\.meta$/) {                                          if ($uri!~/\.meta$/) {
                                         unlink($fname.'.meta');                                              if (-e $fname.'.meta') {
                                                   unlink($fname.'.meta');
                                               }
                                           }
                                           my $unsubresult = &unsubscribe($fname);
                                           unless ($unsubresult eq 'ok') {
                                               &logthis("no unsub of $fname from $homeserver, reason: $unsubresult");
                                           }
                                           $removed = 1;
                                     }                                      }
                                     &reply("unsub:$fname",$homeserver);  
                                     $removed = 1;  
                                 }                                  }
                             }                              }
                         }                          }
Line 10553  sub writecoursepref { Line 10607  sub writecoursepref {
   
 sub createcourse {  sub createcourse {
     my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,      my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
         $course_owner,$crstype,$cnum,$context,$category)=@_;          $course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_;
     $url=&declutter($url);      $url=&declutter($url);
     my $cid='';      my $cid='';
     if ($context eq 'requestcourses') {      if ($context eq 'requestcourses') {
         my $can_create = 0;          my $can_create = 0;
         my ($ownername,$ownerdom) = split(':',$course_owner);          my ($ownername,$ownerdom) = split(':',$course_owner);
         if ($udom eq $ownerdom) {          if ($udom eq $ownerdom) {
             if (&usertools_access($ownername,$ownerdom,$category,undef,              my $reload;
               if (($callercontext eq 'auto') &&
                  ($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) {
                   $reload = 'reload';
               }
               if (&usertools_access($ownername,$ownerdom,$category,$reload,
                                   $context)) {                                    $context)) {
                 $can_create = 1;                  $can_create = 1;
             }              }
Removed from v.1.1419  
changed lines
  Added in v.1.1423

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