--- loncom/auth/lonroles.pm	2021/11/19 19:19:35	1.356
+++ loncom/auth/lonroles.pm	2021/11/28 19:18:00	1.357
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # User Roles Screen
 #
-# $Id: lonroles.pm,v 1.356 2021/11/19 19:19:35 raeburn Exp $
+# $Id: lonroles.pm,v 1.357 2021/11/28 19:18:00 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -277,7 +277,7 @@ sub handler {
         $update = $then;
     }
 
-    my $norolelist;
+    my ($norolelist,$blocked_by_ip,$blocked_type,$blocked_ipaddr);
     if (($env{'request.course.id'}) && ($env{'request.deeplink.login'})) {
         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
@@ -314,6 +314,93 @@ sub handler {
         }
     }
 
+    if ($env{'form.selectrole'}) {
+        my ($role,$cdom,$cnum,$rest);
+        if ($env{'form.switchrole'} =~ m{^(co|cc|in|ta|ep|ad|st|cr).*?\./($match_domain)/($match_courseid)(/(\w+)|$)}) {
+            ($role,$cdom,$cnum,$rest) = ($1,$2,$3,$4);
+        } elsif ($env{'form.newrole'} =~ m{^(co|cc|in|ta|ep|ad|st|cr).*?\./($match_domain)/($match_courseid)(/(\w+)|$)}) {
+            ($role,$cdom,$cnum,$rest) = ($1,$2,$3,$4);
+        }
+        if ($cdom ne '') {
+            my ($has_evb,$check_ipaccess,$showrole);
+            $showrole = 1;
+            my $checkrole = "cm./$cdom/$cnum";
+            if ($rest ne '') {
+                $checkrole .= "/$rest";
+            }
+            if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+                ($role ne 'st')) {
+                $has_evb = 1;
+            }
+            unless ($has_evb) {
+                my @machinedoms = &Apache::lonnet::current_machine_domains();
+                my $udom = $env{'user.domain'};
+                if ($udom eq $cdom) {
+                    $check_ipaccess = 1;
+                } elsif (($udom ne '') && (grep(/^\Q$udom\E$/,@machinedoms))) {
+                    $check_ipaccess = 1;
+                } else {
+                    my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+                    my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+                    my $cprim = &Apache::lonnet::domain($cdom,'primary');
+                    my $cintdom = &Apache::lonnet::internet_dom($cprim);
+                    if (($cintdom ne '') && (ref($internet_names) eq 'ARRAY')) {
+                        if (grep(/^\Q$cintdom\E$/,@{$internet_names})) {
+                            $check_ipaccess = 1;
+                        }
+                    }
+                }
+                if ($check_ipaccess) {
+                    my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$cdom);
+                    unless (defined($cached)) {
+                        my %domconfig =
+                            &Apache::lonnet::get_dom('configuration',['ipaccess'],$cdom);
+                        $ipaccessref = &do_cache_new('ipaccess',$cdom,$domconfig{'ipaccess'},1800);
+                    }
+                    if (ref($ipaccessref) eq 'HASH') {
+                        my $remote_ip = &Apache::lonnet::get_requestor_ip();
+                        foreach my $id (keys(%{$ipaccessref})) {
+                            if (ref($ipaccessref->{$id}) eq 'HASH') {
+                                my $range = $ipaccessref->{$id}->{'ip'};
+                                if ($range) {
+                                    my $type = 'exclude';
+                                    if (&Apache::lonnet::ip_match($remote_ip,$range)) {
+                                        $type = 'include';
+                                    }
+                                    if (ref($ipaccessref->{$id}->{'courses'}) eq 'HASH') {
+                                        if ($ipaccessref->{$id}->{'courses'}{$cdom.'_'.$cnum}) {
+                                            if ($type eq 'include') {
+                                                $showrole = 1;
+                                                last;
+                                            } else {
+                                                $showrole = 0;
+                                            }
+                                        } else {
+                                            if ($type eq 'include') {
+                                                $showrole = 0;
+                                            } else {
+                                                $showrole = 1;
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                        unless ($showrole) {
+                            $blocked_ipaddr = $remote_ip;
+                        }
+                    }
+                }
+            }
+            unless ($showrole) {
+                $blocked_by_ip = 1;
+                $blocked_type = &Apache::loncommon::course_type($cdom.'_'.$cnum);
+                delete($env{'form.selectrole'});
+                delete($env{'form.newrole'});
+            }
+        }
+    }
+
     $registered_cleanup=0;
     @{$rosterupdates}=();
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
@@ -1260,6 +1347,16 @@ ENDHEADER
         $r->print('<input type="hidden" name="newrole" value="" />');
         $r->print('<input type="hidden" name="display" value="'.$display.'" />');
         $r->print('<input type="hidden" name="state" value="" />');
+        if ($blocked_by_ip) {
+            my $blocked_role = 'student';
+            if ($blocked_type eq 'Community') {
+                $blocked_role = 'member';
+            }
+            $r->print('<h3><span class="LC_error">'.
+                      &mt('The [_1] you selected is not available for access with a [_2] role from your current IP address: [_3].',
+                          lc($blocked_type),$blocked_role,$blocked_ipaddr).
+                      '</span></h3>');
+        }
     }
     $r->rflush();