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

Diff for /loncom/cgi/lonauthcgi.pm between versions 1.1 and 1.8

version 1.1, 2008/12/25 01:51:03 version 1.8, 2011/10/17 17:23:25
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 110  sub check_ipbased_access { Line 131  sub check_ipbased_access {
                 }                  }
             }              }
         }          }
       }
       return $allowed;
   }
   
   #############################################
   #############################################
   
   =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 '') {
           if (&Apache::lonnet::hostname($remote_ip) ne '') {
               my @poss_domains = &Apache::lonnet::current_machine_domains();
               if (@poss_domains > 0) {
                   my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip);
                   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;      return $allowed;
Line 134  Returns: 1 if access to the page is perm Line 235  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 'showenv' page (/adm/test), the domains tested
          at least one domain hosted on requestor's server is also hosted on this server.           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 146  sub can_view { Line 250  sub can_view {
     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') {      } else {
         my @poss_domains = &Apache::lonnet::current_machine_domains();          my @poss_domains;
         my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'});          if ($page eq 'showenv') {
         foreach my $hostid (@hostids) {              @poss_domains = ($env{'user.domain'});
             my $hostdom = &Apache::lonnet::host_domain($hostid);              my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
             if (grep(/^\Q$hostdom\E$/,@poss_domains)) {              if (exists($Apache::lonnet::env{$envkey})) {
                 $allowed = 1;                  my $livedc = 1;
                 last;                  my $then = $Apache::lonnet::env{'user.login.time'};
                   my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
                   if ($tstart && $tstart>$then) { $livedc = 0; }
                   if ($tend   && $tend  <$then) { $livedc = 0; }
                   if ($livedc) {
                       $allowed = 1;
                   }
             }              }
           } else {
               @poss_domains = &Apache::lonnet::current_machine_domains();
         }          }
     } else {          unless ($allowed) {
         my @poss_domains = &Apache::lonnet::current_machine_domains();              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;                      $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;                                  $allowed = 1;
                               }
                         }                          }
                     }                      }
                 }                  }
                   last if $allowed;
             }              }
             last if $allowed;  
         }          }
     }      }
     return $allowed;      return $allowed;
Line 183  sub can_view { Line 296  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 247  sub serverstatus_titles { Line 360  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;
 }  }
   
   =pod
   
   =back
   
 1;  =cut
   
   1;
Removed from v.1.1  
changed lines
  Added in v.1.8

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