[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.7 and 1.1172.2.123

version 1.1172.2.118.2.7, 2020/09/08 02:08:27 version 1.1172.2.123, 2020/05/04 15:07:10
Line 1873  sub get_dom { Line 1873  sub get_dom {
         }          }
     }      }
     if ($udom && $uhome && ($uhome ne 'no_host')) {      if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep;          my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         if ($namespace =~ /^enc/) {  
             $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);  
         } else {  
             $rep=&reply("getdom:$udom:$namespace:$items",$uhome);  
         }  
         my %returnhash;          my %returnhash;
         if ($rep eq '' || $rep =~ /^error: 2 /) {          if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;              return %returnhash;
Line 1922  sub put_dom { Line 1917  sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';              $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }          }
         $items=~s/\&$//;          $items=~s/\&$//;
         if ($namespace =~ /^enc/) {          return &reply("putdom:$udom:$namespace:$items",$uhome);
             return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);  
         } else {  
             return &reply("putdom:$udom:$namespace:$items",$uhome);  
         }  
     } else {      } else {
         &logthis("put_dom failed - no homeserver and/or domain");          &logthis("put_dom failed - no homeserver and/or domain");
     }      }
Line 2543  sub get_passwdconf { Line 2534  sub get_passwdconf {
     return %passwdconf;      return %passwdconf;
 }  }
   
 sub course_portal_url {  
     my ($cnum,$cdom) = @_;  
     my $chome = &homeserver($cnum,$cdom);  
     my $hostname = &hostname($chome);  
     my $protocol = $protocol{$chome};  
     $protocol = 'http' if ($protocol ne 'https');  
     my %domdefaults = &get_domain_defaults($cdom);  
     my $firsturl;  
     if ($domdefaults{'portal_def'}) {  
         $firsturl = $domdefaults{'portal_def'};  
     } else {  
         $firsturl = $protocol.'://'.$hostname;  
     }  
     return $firsturl;  
 }  
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 3094  sub repcopy { Line 3069  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 {  
         $answer = reply("unsub:$fname",$home);  
     }  
     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 3273  sub remove_stale_resfile { Line 3227  sub remove_stale_resfile {
                                     $stale = 1;                                      $stale = 1;
                                 }                                  }
                                 if ($stale) {                                  if ($stale) {
                                     if (unlink($fname)) {                                      unlink($fname);
                                         if ($uri!~/\.meta$/) {                                      if ($uri!~/\.meta$/) {
                                             if (-e $fname.'.meta') {                                          unlink($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 3446  sub can_edit_resource { Line 3394  sub can_edit_resource {
                             $cfile =  '/adm/wrapper'.$resurl;                              $cfile =  '/adm/wrapper'.$resurl;
                         }                          }
                     }                      }
                 } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {  
                     $incourse = 1;  
                     if ($env{'form.forceedit'}) {  
                         $forceview = 1;  
                     } else {  
                         $forceedit = 1;  
                     }  
                     $cfile = $resurl;  
                 } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {                  } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;                      $incourse = 1;
                     if ($env{'form.forceedit'}) {                      if ($env{'form.forceedit'}) {
Line 3478  sub can_edit_resource { Line 3418  sub can_edit_resource {
                     $forceedit = 1;                      $forceedit = 1;
                 }                  }
                 $cfile = $resurl;                  $cfile = $resurl;
             } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {  
                 $incourse = 1;  
                 if ($env{'form.forceedit'}) {  
                     $forceview = 1;  
                 } else {  
                     $forceedit = 1;  
                 }  
                 $cfile = $resurl;  
             } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {              } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                 $incourse = 1;                  $incourse = 1;
                 $forceview = 1;                  $forceview = 1;
Line 3495  sub can_edit_resource { Line 3427  sub can_edit_resource {
                     $cfile = &clutter($res);                      $cfile = &clutter($res);
                 } else {                  } else {
                     $cfile = $env{'form.suppurl'};                      $cfile = $env{'form.suppurl'};
                     my $escfile = &unescape($cfile);                      $cfile =~ s{^http://}{};
                     if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {                      $cfile = '/adm/wrapper/ext/'.$cfile;
                         $cfile = '/adm/wrapper'.$escfile;  
                     } else {  
                         $escfile =~ s{^http://}{};  
                         $cfile = &escape("/adm/wrapper/ext/$escfile");  
                     }  
                 }                  }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {              } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {                  if ($env{'form.forceedit'}) {
Line 5474  my %cachedtimes=(); Line 5401  my %cachedtimes=();
 my $cachedtime='';  my $cachedtime='';
   
 sub load_all_first_access {  sub load_all_first_access {
     my ($uname,$udom,$ignorecache)=@_;      my ($uname,$udom)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&      if (($cachedkey eq $uname.':'.$udom) &&
         (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&          (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
         (!$ignorecache)) {  
         return;          return;
     }      }
     $cachedtime=time;      $cachedtime=time;
Line 5486  sub load_all_first_access { Line 5412  sub load_all_first_access {
 }  }
   
 sub get_first_access {  sub get_first_access {
     my ($type,$argsymb,$argmap,$ignorecache)=@_;      my ($type,$argsymb,$argmap)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();      my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }      if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
Line 5498  sub get_first_access { Line 5424  sub get_first_access {
     } else {      } else {
  $res=$symb;   $res=$symb;
     }      }
     &load_all_first_access($uname,$udom,$ignorecache);      &load_all_first_access($uname,$udom);
     return $cachedtimes{"$courseid\0$res"};      return $cachedtimes{"$courseid\0$res"};
 }  }
   
Line 6915  sub currentdump { Line 6841  sub currentdump {
    #     #
    my %returnhash=();     my %returnhash=();
    #     #
    if ($rep eq 'unknown_cmd') {     if ($rep eq "unknown_cmd") { 
        # an old lond will not know currentdump         # an old lond will not know currentdump
        # Do a dump and make it look like a currentdump         # Do a dump and make it look like a currentdump
        my @tmp = &dumpstore($courseid,$sdom,$sname,'.');         my @tmp = &dumpstore($courseid,$sdom,$sname,'.');
Line 7848  sub allowed { Line 7774  sub allowed {
   
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }      if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$}))       if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) 
  || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) ))    || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
  && ($priv eq 'bre')) {   && ($priv eq 'bre')) {
  return 'F';   return 'F';
Line 8545  sub get_commblock_resources { Line 8471  sub get_commblock_resources {
                             }                              }
                         }                          }
                     }                      }
                     if ($interval[0] =~ /^(\d+)/) {                      if ($interval[0] =~ /^\d+$/) {
                         my $timelimit = $1;   
                         my $first_access;                          my $first_access;
                         if ($type eq 'resource') {                          if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);                              $first_access=&get_first_access($interval[1],$item);
Line 8556  sub get_commblock_resources { Line 8481  sub get_commblock_resources {
                             $first_access=&get_first_access($interval[1]);                              $first_access=&get_first_access($interval[1]);
                         }                          }
                         if ($first_access) {                          if ($first_access) {
                             my $timesup = $first_access+$timelimit;                              my $timesup = $first_access+$interval[0];
                             if ($timesup > $now) {                              if ($timesup > $now) {
                                 my $activeblock;                                  my $activeblock;
                                 foreach my $res (@to_test) {                                  foreach my $res (@to_test) {
Line 10282  sub writecoursepref { Line 10207  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,$callercontext)=@_;          $course_owner,$crstype,$cnum,$context,$category)=@_;
     $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) {
             my $reload;              if (&usertools_access($ownername,$ownerdom,$category,undef,
             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;
             }              }
Line 11303  sub get_userresdata { Line 11223  sub get_userresdata {
 #  Parameters:  #  Parameters:
 #     $name      - Course/user name.  #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.  #     $domain    - Name of the domain the user/course is registered on.
 #     $type      - Type of thing $name is (must be 'course' or 'user')  #     $type      - Type of thing $name is (must be 'course' or 'user'
 #     @which     - Array of names of resources desired.  #     @which     - Array of names of resources desired.
 #  Returns:  #  Returns:
 #     The value of the first reasource in @which that is found in the  #     The value of the first reasource in @which that is found in the
Line 11322  sub resdata { Line 11242  sub resdata {
     }      }
     if (!ref($result)) { return $result; }          if (!ref($result)) { return $result; }    
     foreach my $item (@which) {      foreach my $item (@which) {
         if (ref($item) eq 'ARRAY') {   if (defined($result->{$item->[0]})) {
     if (defined($result->{$item->[0]})) {      return [$result->{$item->[0]},$item->[1]];
         return [$result->{$item->[0]},$item->[1]];   }
     }  
         }  
     }      }
     return undef;      return undef;
 }  }
   
 sub get_domain_ltitools {  
     my ($cdom) = @_;  
     my %ltitools;  
     my ($result,$cached)=&is_cached_new('ltitools',$cdom);  
     if (defined($cached)) {  
         if (ref($result) eq 'HASH') {  
             %ltitools = %{$result};  
         }  
     } else {  
         my %domconfig = &get_dom('configuration',['ltitools'],$cdom);  
         if (ref($domconfig{'ltitools'}) eq 'HASH') {  
             %ltitools = %{$domconfig{'ltitools'}};  
             my %encdomconfig = &get_dom('encconfig',['ltitools'],$cdom);  
             if (ref($encdomconfig{'ltitools'}) eq 'HASH') {  
                 foreach my $id (keys(%ltitools)) {  
                     if (ref($encdomconfig{'ltitools'}{$id}) eq 'HASH') {  
                         foreach my $item ('key','secret') {  
                             $ltitools{$id}{$item} = $encdomconfig{'ltitools'}{$id}{$item};  
                         }  
                     }  
                 }  
             }  
         }  
         my $cachetime = 24*60*60;  
         &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);  
     }  
     return %ltitools;  
 }  
   
 sub get_numsuppfiles {  sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;      my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;      my $hashid=$cnum.':'.$cdom;
Line 11815  sub metadata { Line 11704  sub metadata {
     # if it is a non metadata possible uri return quickly      # if it is a non metadata possible uri return quickly
     if (($uri eq '') ||       if (($uri eq '') || 
  (($uri =~ m|^/*adm/|) &&    (($uri =~ m|^/*adm/|) && 
      ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||       ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
  return undef;   return undef;
     }      }
Line 13470  sub clutter { Line 13359  sub clutter {
 # &logthis("Got a blank emb style");  # &logthis("Got a blank emb style");
     }      }
  }   }
     } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {  
         $thisfn='/adm/wrapper'.$thisfn;  
     }      }
     return $thisfn;      return $thisfn;
 }  }
Removed from v.1.1172.2.118.2.7  
changed lines
  Added in v.1.1172.2.123

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