[BACK]Return to lonauthcgi.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi

Diff for /loncom/cgi/lonauthcgi.pm between versions 1.5 and 1.16

version 1.5, 2009/10/08 22:37:39 version 1.16, 2018/12/22 21:04:56
Line 32 Line 32
   
 =head1 NAME  =head1 NAME
   
 loncgi  lonauthcgi
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
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;
Line 72  Inputs: $page, the identifier of the pag Line 73  Inputs: $page, the identifier of the pag
         $ip, the IP address of the client requesting the page.          $ip, the IP address of the client requesting the page.
   
 Returns: 1 if access is permitted for the requestor's IP.  Returns: 1 if access is permitted for the requestor's IP.
          Access is allowed if on of the following is true:           Access is allowed if one of the following is true:
          (a) the requestor IP is the loopback address           (a) the requestor IP is the loopback address.
          (b) Domain configurations for domains hosted on this server include           (b) the requestor IP is the IP of the current server.
            (c) the requestor IP is the IP of a manager,
                if the page to view is not "takeoffline" or "toggledebug" 
            (d) the requestor IP is the IP of a server belonging 
                to a domain included in domains hosted on this server.
            (e) Domain configurations for domains hosted on this server include
              the requestor's IP as one of the specified IPs with access               the requestor's IP as one of the specified IPs with access
              to this page. (does not apply to 'ping' page type)               to this page. (not applicable to 'ping' page).
   
 =cut  =cut
   
Line 88  sub check_ipbased_access { Line 94  sub check_ipbased_access {
     if (!defined($ip)) {      if (!defined($ip)) {
         $ip = $ENV{'REMOTE_ADDR'};          $ip = $ENV{'REMOTE_ADDR'};
     }      }
     if (($page ne 'lonstatus') && ($page ne 'serverstatus')) {      if ($ip eq '127.0.0.1') {
         if ($ip eq '127.0.0.1') {          $allowed = 1;
           return $allowed;
       } else {
           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
           my $host_ip = &Apache::lonnet::get_host_ip($lonhost);
           if (($host_ip ne '') && ($host_ip eq $ip)) {
             $allowed = 1;              $allowed = 1;
             return $allowed;              return $allowed;
         }          }
     }      }
       if (&is_manager_ip($ip)) {
           unless (($page eq 'toggledebug') || ($page eq 'takeoffline')) {
               $allowed = 1;
               return $allowed;
           }
       }
       if (&check_domain_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 119  sub check_ipbased_access { Line 140  sub check_ipbased_access {
   
 =pod  =pod
   
   =item is_manager_ip()
   
   Inputs: $remote_ip, the IP address of the client requesting the page.
   
   Returns: 1 if the client IP address corresponds to that of a 
            machine listed in /home/httpd/lonTabs/managers.tab
   
   =cut
   
   #############################################
   #############################################
   sub is_manager_ip {
       my ($remote_ip) = @_;
       return if ($remote_ip eq '');
       my ($directory,$is_manager);
       foreach my $key (keys(%Apache::lonnet::managerstab)) {
           my $manager_ip;
           if ($key =~ /:/) {
               my ($cluname,$dnsname) = split(/:/,$key);
               my $ip = gethostbyname($dnsname);
               if (defined($ip)) {
                   $manager_ip = inet_ntoa($ip);
               }
           } else {
               $manager_ip = &Apache::lonnet::get_host_ip($key);
           }
           if (defined($manager_ip)) {
               if ($remote_ip eq $manager_ip) {
                   $is_manager = 1;
                   last;
               }
           }
       }
       return $is_manager;
   }
   
   #############################################
   #############################################
   
   =pod
   
   =item check_domain_ip()
   
   Inputs: $remote_ip, the IP address of the client requesting the page.
   
   Returns: 1 if the client IP address is for a machine in the cluster
            and domain in common for client machine and this machine.
   
   =cut
   
   #############################################
   #############################################
   sub check_domain_ip {
       my ($remote_ip) = @_;
       my %remote_doms;
       my $allowed;
       if ($remote_ip ne '') {
           my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip);
           if (@remote_hosts) {
               my @poss_domains = &Apache::lonnet::current_machine_domains();
               if (@poss_domains > 0) {
                   foreach my $hostid (@remote_hosts) {
                       my $hostdom = &Apache::lonnet::host_domain($hostid);
                       if ($hostdom ne '') {
                           if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
                               $allowed = 1;
                               last;
                           }
                       }
                   }
               }
           }
       }
       return $allowed;
   }
   
   #############################################
   #############################################
   
   =pod
   
 =item can_view()  =item can_view()
   
 Inputs: $page, the identifier of the page to be viewed,  Inputs: $page, the identifier of the page to be viewed,
         can be one of the keys in the hash from &serverstatus_titles()          can be one of the keys in the hash from &serverstatus_titles()
           $domain (optional), a specific domain for which the page is needed.  
   
 Returns: 1 if access to the page is permitted.  Returns: 1 if access to the page is permitted, or &-separated list of domains
            for which access is allowed, if $page is domconf, and not superuser.
          Access allowed if one of the following is true:           Access allowed if one of the following is true:
          (a) Requestor has LON-CAPA superuser role           (a) Requestor has LON-CAPA superuser role
          (b) Requestor's role is Domain Coordinator in one of the domains           (b) Requestor's role is Domain Coordinator in requested domain 
                (if specified) or (if unspecified) in one of the domains
              hosted on this server               hosted on this server
          (c) Domain configurations for domains hosted on this server include           (c) The domain configuration for the particular domain (if specified),
              the requestor as one of the named users (username:domain) with access               or domain configurations for domains hosted on this server (if 
              to the page.               specific domain not specified), include the requestor as one of
                the named users (username:domain) with access to the page.
          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.  
   
          In the case of requests for the 'showenv' page (/adm/test), the domains tested           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 -            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            the domain of the requestor.  In addition, if the requestor has an active 
          Domain Coordinator role for that domain, access is permitted, regardless of             Domain Coordinator role for that domain, access is permitted, regardless of  
          the requestor's current role.           the requestor's current role.
   
 =cut  =cut
   
 #############################################  #############################################
 #############################################  #############################################
 sub can_view {  sub can_view {
     my ($page) = @_;      my ($page,$domain) = @_;
     my $allowed;      my $allowed;
     if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {      if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
         $allowed = 1;          $allowed = 1;
     } elsif ($page eq 'ping') {  
         my @poss_domains = &Apache::lonnet::current_machine_domains();  
         my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'});  
         foreach my $hostid (@hostids) {  
             my $hostdom = &Apache::lonnet::host_domain($hostid);  
             if (grep(/^\Q$hostdom\E$/,@poss_domains)) {  
                 $allowed = 1;  
                 last;  
             }  
         }  
     } else {      } else {
         my @poss_domains;          my @poss_domains;
         if ($page eq 'showenv') {          if ($page eq 'showenv') {
Line 177  sub can_view { Line 271  sub can_view {
             }              }
         } else {          } else {
             @poss_domains = &Apache::lonnet::current_machine_domains();              @poss_domains = &Apache::lonnet::current_machine_domains();
               if ($domain ne '') {
                   if (grep(/^\Q$domain\E$/,@poss_domains)) {
                       @poss_domains = ($domain);
                   } else {
                       undef(@poss_domains); 
                   }
               }
         }          }
         unless ($allowed) {          unless ($allowed) {
               my %alloweddoms;   
             foreach my $dom (@poss_domains) {              foreach my $dom (@poss_domains) {
                 my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],                  my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
                                                          $dom);                                                           $dom);
                 if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {                  if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
                     $allowed = 1;                      if ($page eq 'domconf') {
                           $alloweddoms{$dom} = 1;
                       } else {
                           $allowed = 1; 
                       }
                 } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {                  } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                     if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {                      if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                         if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {                          if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
                             my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});                              my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
                             if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {                              if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
                                 $allowed = 1;                                  if ($page eq 'domconf') {
                                       $alloweddoms{$dom} = 1;
                                   } else {
                                       $allowed = 1;
                                   }
                               }
                               unless ($page eq 'domconf') {
                                   last if ($allowed);
                             }                              }
                         }                          }
                     }                      }
                 }                  }
                 last if $allowed;              }
               if (($page eq 'domconf') && (!$allowed))  {
                   $allowed = join('&',sort(keys(%alloweddoms)));
             }              }
         }          }
     }      }
Line 206  sub can_view { Line 321  sub can_view {
   
 =pod  =pod
   
 =unauthorized_msg()  =item unauthorized_msg()
   
 Inputs: $page, the identifier of the page to be viewed,  Inputs: $page, the identifier of the page to be viewed,
         can be one of the keys in the hash from &serverstatus_titles()          can be one of the keys in the hash from &serverstatus_titles()
Line 265  sub serverstatus_titles { Line 380  sub serverstatus_titles {
                    'loncron'           => 'Generate Detailed Report',                     'loncron'           => 'Generate Detailed Report',
                    'server-status'     => 'Apache Status Page',                     'server-status'     => 'Apache Status Page',
                    'codeversions'      => 'LON-CAPA Module Versions',                     'codeversions'      => 'LON-CAPA Module Versions',
                      'checksums'         => 'LON-CAPA Module Checking',
                      'diskusage'         => 'Course/Community Disk Usage',
                    'clusterstatus'     => 'Domain status',                     'clusterstatus'     => 'Domain status',
                      'certstatus'        => 'LON-CAPA SSL Certificates Status',
                    'metadata_keywords' => 'Display Metadata Keywords',                     'metadata_keywords' => 'Display Metadata Keywords',
                    '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",                     'toggledebug'       => 'Toggle debug messages',
                      'ping'              => 'Cause server to ping another server',   
                      'domconf'           => 'Text Display of Domain Configuration',
                      'uniquecodes'       => 'Six-character Course Codes',
                      'coursecatalog'     => 'Course/Community Catalog with enrollment data',
                  );                   );
     return \%titles;      return \%titles;
 }  }
   
   =pod
   
   =back
   
 1;  =cut
   
   1;
Removed from v.1.5  
changed lines
  Added in v.1.16

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