[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.575 and 1.585

version 1.575, 2004/12/07 16:19:37 version 1.585, 2005/01/10 19:12:55
Line 1406  sub finishuserfileupload { Line 1406  sub finishuserfileupload {
     }      }
 # Save the file  # Save the file
     {      {
  #&Apache::lonnet::logthis("Saving to $filepath $file");  
  open(FH,'>'.$filepath.'/'.$file);   open(FH,'>'.$filepath.'/'.$file);
  print FH $ENV{'form.'.$formname};   print FH $ENV{'form.'.$formname};
  close(FH);   close(FH);
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
       &Apache::lonnet::logthis("fetching ".$path.$file);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);      my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {      if ($fetchresult eq 'ok') {
 #  #
Line 1588  sub courseacclog { Line 1588  sub courseacclog {
     my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};      my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
     if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) {      if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) {
         $what.=':POST';          $what.=':POST';
           # FIXME: Probably ought to escape things....
  foreach (keys %ENV) {   foreach (keys %ENV) {
             if ($_=~/^form\.(.*)/) {              if ($_=~/^form\.(.*)/) {
  $what.=':'.$1.'='.$ENV{$_};   $what.=':'.$1.'='.$ENV{$_};
             }              }
         }          }
       } elsif ($fnsymb =~ m:^/adm/searchcat:) {
           # FIXME: We should not be depending on a form parameter that someone
           # editing lonsearchcat.pm might change in the future.
           if ($ENV{'form.phase'} eq 'course_search') {
               $what.= ':POST';
               # FIXME: Probably ought to escape things....
               foreach my $element ('courseexp','crsfulltext','crsrelated',
                                    'crsdiscuss') {
                   $what.=':'.$element.'='.$ENV{'form.'.$element};
               }
           }
     }      }
     &courselog($what);      &courselog($what);
 }  }
Line 1644  sub get_course_adv_roles { Line 1656  sub get_course_adv_roles {
         if (($tend) && ($tend<$now)) { next; }          if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }          if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$_);          my ($role,$username,$domain,$section)=split(/\:/,$_);
    if ($username eq '' || $domain eq '') { next; }
  if ((&privileged($username,$domain)) &&    if ((&privileged($username,$domain)) && 
     (!$nothide{$username.':'.$domain})) { next; }      (!$nothide{$username.':'.$domain})) { next; }
         my $key=&plaintext($role);          my $key=&plaintext($role);
Line 2399  sub rolesinit { Line 2412  sub rolesinit {
             my ($area,$role)=split(/=/,$_);              my ($area,$role)=split(/=/,$_);
             $area=~s/\_\w\w$//;              $area=~s/\_\w\w$//;
             my ($trole,$tend,$tstart)=split(/_/,$role);              my ($trole,$tend,$tstart)=split(/_/,$role);
             $userroles.=&set_arearole($trole,$area,$tstart,$tend);              $userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username);
             if (($tend!=0) && ($tend<$now)) { $trole=''; }              if (($tend!=0) && ($tend<$now)) { $trole=''; }
             if (($tstart!=0) && ($tstart>$now)) { $trole=''; }              if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
             if (($area ne '') && ($trole ne '')) {              if (($area ne '') && ($trole ne '')) {
Line 2776  sub customaccess { Line 2789  sub customaccess {
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
     my ($priv,$uri)=@_;      my ($priv,$uri,$symb)=@_;
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
Line 3057  sub allowed { Line 3070  sub allowed {
   
    if ($thisallowed=~/X/) {     if ($thisallowed=~/X/) {
       if ($ENV{'acc.randomout'}) {        if ($ENV{'acc.randomout'}) {
          my $symb=&symbread($uri,1);   if (!$symb) { $symb=&symbread($uri,1); }
          if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) {            if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) { 
             return '';               return ''; 
          }           }
Line 3359  sub auto_instcode_format { Line 3372  sub auto_instcode_format {
     my $courses = '';      my $courses = '';
     my $homeserver;      my $homeserver;
     if ($caller eq 'global') {      if ($caller eq 'global') {
         $homeserver = $perlvar{'lonHostID'};          foreach my $tryserver (keys %libserv) {
               if ($hostdom{$tryserver} eq $codedom) {
                   $homeserver = $tryserver;
                   last;
               }
           }
           if (($ENV{'user.name'}) && ($ENV{'user.domain'} eq $codedom)) {
               $homeserver = &homeserver($ENV{'user.name'},$codedom);
           }
     } else {      } else {
         $homeserver = &homeserver($caller,$codedom);          $homeserver = &homeserver($caller,$codedom);
     }      }
     my $host=$hostname{$homeserver};  
     foreach (keys %{$instcodes}) {      foreach (keys %{$instcodes}) {
         $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';          $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';
     }      }
Line 3818  sub save_selected_files { Line 3838  sub save_selected_files {
     my ($user, $path, @files) = @_;      my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);      my @other_files = &files_not_in_path($user, $path);
     foreach (@other_files) {  
         &logthis("other dir file $_");  
     }  
     foreach (@files) {  
         &logthis("current dir file $_");  
     }  
     open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);      open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
     foreach my $file (@files) {      foreach my $file (@files) {
         print (OUT $ENV{'form.currentpath'}.$file."\n");          print (OUT $ENV{'form.currentpath'}.$file."\n");
Line 3906  sub get_marked_as_readonly { Line 3920  sub get_marked_as_readonly {
     }      }
     return @readonly_files;      return @readonly_files;
 }  }
   #-----------------------------------------------------------Get Marked as Read Only Hash
   
   sub get_marked_as_readonly_hash {
       my ($domain,$user,$what) = @_;
       my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
       my %readonly_files;
       while (my ($file_name,$value) = each(%current_permissions)) {
           if (ref($value) eq "ARRAY"){
               foreach my $stored_what (@{$value}) {
                   if ($stored_what eq $what) {
                       $readonly_files{$file_name} = 'locked';
                   } elsif (!defined($what)) {
                       $readonly_files{$file_name} = 'locked';
                   }
               }
           } 
       }
       return %readonly_files;
   }
 # ------------------------------------------------------------ Unmark as Read Only  # ------------------------------------------------------------ Unmark as Read Only
   
 sub unmark_as_readonly {  sub unmark_as_readonly {
Line 4418  sub packages_tab_default { Line 4450  sub packages_tab_default {
  if (defined($packagetab{"$pack_type&$name&default"})) {   if (defined($packagetab{"$pack_type&$name&default"})) {
     return $packagetab{"$pack_type&$name&default"};      return $packagetab{"$pack_type&$name&default"};
  }   }
    if ($pack_type eq 'part') { $pack_part='0'; }
  if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) {   if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) {
     return $packagetab{$pack_type."_".$pack_part."&$name&default"};      return $packagetab{$pack_type."_".$pack_part."&$name&default"};
  }   }
Line 4777  sub symbverify { Line 4810  sub symbverify {
                if (                 if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)    &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) {      eq $symb) { 
                   $okay=1;      if (($ENV{'request.role.adv'}) ||
                }         $bighash{'encrypted_'.$_} eq $ENV{'request.enc'}) {
          $okay=1; 
      }
          }
    }     }
         }          }
  untie(%bighash);   untie(%bighash);
Line 5533  sub thaw_unescape { Line 5569  sub thaw_unescape {
 }  }
   
 sub mod_perl_version {  sub mod_perl_version {
       return 1;
     if (defined($perlvar{'MODPERL2'})) {      if (defined($perlvar{'MODPERL2'})) {
  return 2;   return 2;
     }      }
     return 1;  
 }  }
   
 sub correct_line_ends {  sub correct_line_ends {
Line 5569  BEGIN { Line 5605  BEGIN {
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf  # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
     unless ($readit) {      unless ($readit) {
 {  {
       # FIXME: Use LONCAPA::Configuration::read_conf here and omit next block
     open(my $config,"</etc/httpd/conf/loncapa.conf");      open(my $config,"</etc/httpd/conf/loncapa.conf");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
Line 6204  returns the data handle Line 6241  returns the data handle
 =item *  =item *
   
 symbverify($symb,$thisfn) : verifies that $symb actually exists and is  symbverify($symb,$thisfn) : verifies that $symb actually exists and is
 a possible symb for the URL in $thisfn, returns a 1 on success, 0 on  a possible symb for the URL in $thisfn, and if is an encryypted
 failure, user must be in a course, as it assumes the existance of the  resource that the user accessed using /enc/ returns a 1 on success, 0
 course initi hash, and uses $ENV('request.course.id'}  on failure, user must be in a course, as it assumes the existance of
   the course initial hash, and uses $ENV('request.course.id'}
   
   
 =item *  =item *
Removed from v.1.575  
changed lines
  Added in v.1.585

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