Diff for /loncom/cgi/lonauthcgi.pm between versions 1.2 and 1.7

version 1.2, 2008/12/25 05:10:14 version 1.7, 2011/10/14 20:50:54
Line 55  package LONCAPA::lonauthcgi; Line 55  package LONCAPA::lonauthcgi;
   
 use strict;  use strict;
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
   use Socket;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::lonlocal;  use Apache::lonlocal;
 use LONCAPA;  use LONCAPA;
   use LONCAPA::Configuration();
   
 #############################################  #############################################
 #############################################  #############################################
Line 94  sub check_ipbased_access { Line 96  sub check_ipbased_access {
             return $allowed;              return $allowed;
         }          }
     }      }
       if (&is_manager_ip($ip)) {
           $allowed = 1;
           return $allowed;
       }
     if ($page ne 'ping') {      if ($page ne 'ping') {
         my @poss_domains = &Apache::lonnet::current_machine_domains();          my @poss_domains = &Apache::lonnet::current_machine_domains();
         foreach my $dom (@poss_domains) {          foreach my $dom (@poss_domains) {
Line 117  sub check_ipbased_access { Line 123  sub check_ipbased_access {
 #############################################  #############################################
 #############################################  #############################################
   
   sub is_manager_ip {
       my ($remote_ip) = @_;
       return if ($remote_ip eq '');
       my ($directory,$is_manager);
       my $config=LONCAPA::Configuration::read_conf();
       if (ref($config) eq 'HASH') {
           $directory = $config->{'lonTabDir'};
       }
       if (defined($directory)) {
           if (open(MANAGERS, "$directory/managers.tab")) {
               while(my $host = <MANAGERS>) {
                   chomp($host);
                   next if ($host =~ /^\#/);
                   my $ip = &Apache::lonnet::get_host_ip($host);
                   if (defined($ip)) {
                       if ($remote_ip eq $ip) {
                           $is_manager = 1;
                           last;
                       }
                   } else {
                       my ($cluname,$dnsname) = split(/:/, $host);
                       $ip = gethostbyname($dnsname);
                       if (defined($ip)) {
                           my $hostip = inet_ntoa($ip);
                           if ($hostip = $remote_ip) {
                               $is_manager = 1;
                           }
                       }
                   }
               }
               close(MANAGERS);
           }
       }
       return $is_manager;
   }
   
   #############################################
   #############################################
   
 =pod  =pod
   
 =item can_view()  =item can_view()
Line 133  Returns: 1 if access to the page is perm Line 178  Returns: 1 if access to the page is perm
              the requestor as one of the named users (username:domain) with access               the requestor as one of the named users (username:domain) with access
              to the page.               to the page.
   
          In the case of requests for the 'ping' page, and access is also allowed if           In the case of requests for the 'ping' page, access is also allowed if
          at least one domain hosted on requestor's server is also hosted on this server.           at least one domain hosted on requestor's server is also hosted on this server.
   
            In the case of requests for the 'showenv' page (/adm/test), the domains tested
            are not the domains hosted on the server, but instead are a single domain - 
            the domain of the requestor.  In addition, if the requestor has an active 
            Domain Coordinator role for that domain, access is permitted, regardless of  
            the requestor's current role.
 =cut  =cut
   
 #############################################  #############################################
Line 156  sub can_view { Line 206  sub can_view {
             }              }
         }          }
     } else {      } else {
         my @poss_domains = &Apache::lonnet::current_machine_domains();          my @poss_domains;
         foreach my $dom (@poss_domains) {          if ($page eq 'showenv') {
             my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);              @poss_domains = ($env{'user.domain'});
             if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {              my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
                 $allowed = 1;              if (exists($Apache::lonnet::env{$envkey})) {
             } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {                  my $livedc = 1;
                 if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {                  my $then = $Apache::lonnet::env{'user.login.time'};
                     if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {                  my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
                         my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});                  if ($tstart && $tstart>$then) { $livedc = 0; }
                         if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {                  if ($tend   && $tend  <$then) { $livedc = 0; }
                             $allowed = 1;                  if ($livedc) {
                       $allowed = 1;
                   }
               }
           } else {
               @poss_domains = &Apache::lonnet::current_machine_domains();
           }
           unless ($allowed) {
               foreach my $dom (@poss_domains) {
                   my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
                                                            $dom);
                   if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
                       $allowed = 1;
                   } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                       if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                           if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
                               my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
                               if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
                                   $allowed = 1;
                               }
                         }                          }
                     }                      }
                 }                  }
                   last if $allowed;
             }              }
             last if $allowed;  
         }          }
     }      }
     return $allowed;      return $allowed;
Line 246  sub serverstatus_titles { Line 315  sub serverstatus_titles {
                    'metadata_harvest'  => 'Harvest Metadata Searches',                     'metadata_harvest'  => 'Harvest Metadata Searches',
                    'takeoffline'       => 'Offline - replace Log-in page',                     'takeoffline'       => 'Offline - replace Log-in page',
                    'takeonline'        => 'Online - restore Log-in page',                     'takeonline'        => 'Online - restore Log-in page',
                    'showenv'           => "Show user environment",                     'showenv'           => 'Show user environment',
                      'toggledebug'       => 'Toggle debug messages',
                  );                   );
     return \%titles;      return \%titles;
 }  }

Removed from v.1.2  
changed lines
  Added in v.1.7


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