[system] / branches / wheeler / webwork2 / lib / WeBWorK / Authz.pm Repository:
ViewVC logotype

View of /branches/wheeler/webwork2/lib/WeBWorK/Authz.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7144 - (download) (as text) (annotate)
Thu Jun 7 00:51:30 2012 UTC (7 years, 8 months ago) by wheeler
File size: 20136 byte(s)
Revisions to accommodate varying inputs from different LMSs and to improve interaction with Login.pm and Logout.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/Authz.pm,v 1.37 2012/06/08 22:59:54 wheeler Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::Authz;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK::Authz - check user permissions.
   22 
   23 =head1 SYNOPSIS
   24 
   25  # create new authorizer -- $r is a WeBWorK::Request object.
   26  my $authz = new WeBWorK::Authz($r);
   27 
   28  # tell authorizer to cache permission level of user spammy.
   29  $authz->setCachedUser("spammy");
   30 
   31  # this call will use the cached data.
   32  if ($authz->hasPermissions("spammy", "eat_breakfast")) {
   33   eat_breakfast();
   34  }
   35 
   36  # this call will not use the cached data, and will cause a database lookup.
   37  if ($authz->hasPermissions("hammy", "go_to_bed")) {
   38   go_to_bed();
   39  }
   40 
   41 =head1 DESCRIPTION
   42 
   43 WeBWorK::Authen determines if a user is authorized to perform a specific
   44 activity, based on the user's PermissionLevel record in the WeBWorK database and
   45 the contents of the %permissionLevels hash in the course environment.
   46 
   47 =head2 Format of the %permissionLevels hash
   48 
   49 %permissionLevels maps text strings describing activities to numeric permission
   50 levels. The definitive list of activities is contained in the default version of
   51 %permissionLevels, in the file F<conf/global.conf.dist>.
   52 
   53 A user is able to engage in an activity if their permission level is greater
   54 than or equal to the level associated with the activity. If the level associated
   55 with an activity is undefiend, then no user is permitted to perform the
   56 activity, regardless of their permission level.
   57 
   58 =cut
   59 
   60 use strict;
   61 use warnings;
   62 use Carp qw/croak/;
   63 # FIXME SET: set-level auth add
   64 use WeBWorK::Utils qw(before after between);
   65 use WeBWorK::Authen::Proctor;
   66 use Net::IP;
   67 
   68 ################################################################################
   69 
   70 =head1 CONSTRUCTOR
   71 
   72 =over
   73 
   74 =item WeBWorK::Authz->new($r)
   75 
   76 Creates a new authorizer instance. $r is a WeBWorK::Request object. It must
   77 already have its C<ce> and C<db> fields set.
   78 
   79 =cut
   80 
   81 sub new {
   82   my ($invocant, $r) = @_;
   83   my $class = ref($invocant) || $invocant;
   84   my $self = {
   85     r => $r,
   86   };
   87 
   88   $r -> {permission_retrieval_error} = 0;
   89   bless $self, $class;
   90   return $self;
   91 }
   92 
   93 =back
   94 
   95 =cut
   96 
   97 ################################################################################
   98 
   99 =head1 METHODS
  100 
  101 =over
  102 
  103 =item setCachedUser($userID)
  104 
  105 Caches the PermissionLevel of the user $userID in an existing authorizer. If a
  106 user's PermissionLevel is cached, it will be used whenever hasPermissions() is
  107 called on the same user. Only one user can be cached at a time. This is used by
  108 WeBWorK to cache the "real" user.
  109 
  110 =cut
  111 
  112 sub setCachedUser {
  113   my ($self, $userID) = @_;
  114   my $r = $self->{r};
  115   my $db = $r->db;
  116 
  117   delete $self->{userID};
  118   delete $self->{PermissionLevel};
  119 
  120   if (defined $userID) {
  121     $self->{userID} = $userID;
  122     if (! $db -> existsUser($userID) && defined($r -> param("lis_person_sourcedid"))) {
  123       # This is a new user referred via an LTI link.
  124       # Do not attempt to cache the permission here.
  125       # Rather, the LTIBasic authentication module should cache the permission.
  126       return 1;
  127     }
  128     my $PermissionLevel;
  129     my $tryAgain=1;
  130     my $count=0;
  131     while ($tryAgain && $count < 2) {
  132       eval {$PermissionLevel = $db->getPermissionLevel($userID); # checked
  133         };
  134       if ($@) {
  135         $count++;
  136       }
  137       else {
  138         $tryAgain=0;
  139       }
  140     }
  141     if (defined $PermissionLevel and defined $PermissionLevel -> permission
  142       and $PermissionLevel -> permission ne "") {
  143       # cache the  permission level record in this request to avoid later database calls
  144       $self->{PermissionLevel} = $PermissionLevel;
  145     }
  146     elsif (defined($r -> param("lis_person_sourcedid"))
  147         or defined($r -> param("lis_person_sourced_id"))
  148         or defined($r -> param("lis_person_source_id"))
  149         or defined($r -> param("lis_person_sourceid"))
  150         or defined($r -> param("lis_person_contact_email_primary")) ) {
  151       # This is a new user referred via an LTI link.
  152       # Do not attempt to cache the permission here.
  153       # Rather, the LTIBasic authentication module should cache the permission.
  154       return 1;
  155     }
  156     elsif (defined($r -> param("oauth_nonce"))) {
  157       # This is a LTI attempt that doesn't have an lis_person_sourcedid username.
  158       croak ("Your request did not specify your username.  Perhaps you were attempting to authenticate via LTI but the LTI tool did not transmit "
  159         . "any variant of the lis_person_sourced_id parameter and did not transmit the lis_person_contact_email_primary parameter.");
  160     }
  161 
  162     else {
  163       if ($r->{permission_retrieval_error} == 0) {
  164         $r->{permission_retrieval_error}=1;
  165         croak "Unable to retrieve your permissions, perhaps due to a collision "
  166           . "between your request and that of another user "
  167           . "(or possibly an unfinished request of yours). "
  168           . "Please press the BACK button on your browser and try again.";
  169       }
  170     }
  171   } else {
  172     warn "setCachedUser() called with userID undefined.";
  173   }
  174 }
  175 
  176 =item hasPermissions($userID, $activity)
  177 
  178 Checks the %permissionLevels hash in the course environment to determine if the
  179 user $userID has permission to engage in the activity $activity. If the user's
  180 permission level is greater than or equal to the level associated with $activty,
  181 a true value is returned. Otherwise, a false value is returned.
  182 
  183 If $userID has been cached using the setCachedUser() call, the cached data is
  184 used. Otherwise, the user's PermissionLevel is looked up in the WeBWorK
  185 database.
  186 
  187 If the user does not have a PermissionLevel record, the permission level record
  188 is empty, or the activity does not appear in %permissionLevels, hasPermissions()
  189 assumes that the user does not have permission.
  190 
  191 =cut
  192 
  193 # This currently only uses two of it's arguments, but it accepts any number, in
  194 # case in the future calculating certain permissions requires more information.
  195 sub hasPermissions {
  196   if (@_ != 3 and not( @_==4 and $_[3] eq 'equal') ) {
  197     shift @_; # get rid of self
  198     my $nargs = @_;
  199     croak "hasPermissions called with $nargs arguments instead of the expected 2: '@_'"
  200   }
  201 
  202   my ($self, $userID, $activity, $exactness) = @_;
  203   if (!defined($exactness) ) {$exactness='ge';}
  204   my $r = $self->{r};
  205   my $ce = $r->ce;
  206   my $db = $r->db;
  207 
  208   # this may need to be changed if we get other permission level data sources
  209   return 0 unless defined $db;
  210 
  211   # this may need to be changed if we want to control what unauthenticated users
  212   # can do with the permissions system
  213   return 0 unless defined $userID and $userID ne "";
  214 
  215   my $PermissionLevel;
  216 
  217   if (not defined($self->{userID})) {
  218     #warn "self->{userID} is undefined";
  219     $self-> setCachedUser($userID);
  220   }
  221 
  222   my $cachedUserID = $self->{userID};
  223   if (defined $cachedUserID and $cachedUserID ne "" and $cachedUserID eq $userID) {
  224     # this is the same user -- we can skip the database call
  225     $PermissionLevel = $self->{PermissionLevel};
  226   } else {
  227     # a different user, or no user was defined before
  228     #my $prettyCachedUserID = defined $cachedUserID ? "'$cachedUserID'" : "undefined";
  229     #warn "hasPermissions called with user  $userID , but cached user is $prettyCachedUserID. Accessing database.\n";
  230     $PermissionLevel = $db->getPermissionLevel($userID); # checked
  231   }
  232 
  233   my $permission_level;
  234 
  235   if (defined $PermissionLevel) {
  236     $permission_level = $PermissionLevel->permission;
  237   }
  238   elsif (defined($r -> param("lis_person_sourcedid"))){
  239     # This is an LTI login.  Let's see if the LITBasic authentication module will handle this.
  240     #return 1;
  241   }
  242   else {
  243     # uh, oh. this user has no permission level record!
  244     if ($r -> {permission_retrieval_error} != 1) {
  245       warn "User '$userID' has no PermissionLevel record -- assuming no permission.";
  246     }
  247     return 0;
  248   }
  249 
  250   unless (defined $permission_level and $permission_level ne "") {
  251     warn "User '$userID' has empty permission level -- assuming no permission.";
  252     return 0;
  253   }
  254 
  255   my $userRoles = $ce->{userRoles};
  256   my $permissionLevels = $ce->{permissionLevels};
  257 
  258   if (exists $permissionLevels->{$activity}) {
  259     my $activity_role = $permissionLevels->{$activity};
  260     if (defined $activity_role) {
  261       if (exists $userRoles->{$activity_role}) {
  262         my $role_permlevel = $userRoles->{$activity_role};
  263         if (defined $role_permlevel) {
  264           if ($exactness eq 'ge') {
  265             return $permission_level >= $role_permlevel;
  266           }
  267           elsif ($exactness eq 'equal') {
  268             return $permission_level == $role_permlevel;
  269           }
  270           else {
  271             return 0;
  272           }
  273         } else {
  274 #         warn "Role '$activity_role' has undefined permission level -- assuming no permission.";
  275           return 0;
  276         }
  277       } else {
  278 #       warn "Role '$activity_role' for activity '$activity' not found in \%userRoles -- assuming no permission.";
  279         return 0;
  280       }
  281     } else {
  282 #     warn "Undefined Role, -- assuming no one has permission to perform $activity.";
  283       return 0; # undefiend $activity_role, no one has permission to perform $activity
  284     }
  285   } else {
  286 #   warn "Activity '$activity' not found in \%permissionLevels -- assuming no permission.";
  287     return 0;
  288   }
  289 }
  290 
  291 #########################  IU Addition  ###############
  292 sub hasExactPermissions {
  293   my ($self, $userID, $activity) = @_;
  294   my $r = $self->{r};
  295   my $ce = $r->ce;
  296   my $db = $r->db;
  297 
  298 # my $Permission = $db->getPermissionLevel($user); # checked
  299 # return 0 unless defined $Permission;
  300 # my $permissionLevel = $Permission->permission();
  301 
  302 ##
  303   my $PermissionLevel;
  304 
  305   if (not defined($self->{userID})) {
  306     #warn "self->{userID} is undefined";
  307     $self-> setCachedUser($userID);
  308   }
  309 
  310   my $cachedUserID = $self->{userID};
  311   if (defined $cachedUserID and $cachedUserID ne "" and $cachedUserID eq $userID) {
  312     # this is the same user -- we can skip the database call
  313     $PermissionLevel = $self->{PermissionLevel};
  314   } else {
  315     # a different user, or no user was defined before
  316     #my $prettyCachedUserID = defined $cachedUserID ? "'$cachedUserID'" : "undefined";
  317     #warn "hasPermissions called with user  $userID , but cached user is $prettyCachedUserID. Accessing database.\n";
  318     $PermissionLevel = $db->getPermissionLevel($userID); # checked
  319   }
  320 
  321   my $permission_level;
  322 
  323   if (defined $PermissionLevel) {
  324     $permission_level = $PermissionLevel->permission;
  325   } else {
  326     # uh, oh. this user has no permission level record!
  327     if ($r -> {permission_retrieval_error} != 1) {
  328       warn "User '$userID' has no PermissionLevel record -- assuming no permission.";
  329     }
  330     return 0;
  331   }
  332 
  333   unless (defined $permission_level and $permission_level ne "") {
  334     warn "User '$userID' has empty permission level -- assuming no permission.";
  335     return 0;
  336   }
  337 
  338 ##
  339 
  340   my $permissionLevels = $ce->{permissionLevels};
  341   if (exists $permissionLevels->{$activity}) {
  342     if (defined $permissionLevels->{$activity}) {
  343       return $permission_level == $permissionLevels->{$activity};
  344     } else {
  345       return 0;
  346     }
  347   } else {
  348     die "Activity '$activity' not found in %permissionLevels. Can't continue.\n";
  349   }
  350 }
  351 #######################################################
  352 
  353 #### set-level authorization routines
  354 
  355 sub checkSet {
  356   my $self = shift;
  357   my $r = $self->{r};
  358   my $ce = $r->ce;
  359   my $db = $r->db;
  360   my $urlPath = $r->urlpath;
  361 
  362   my $node_name = $urlPath->type;
  363 
  364   # first check to see if we have to worried about set-level access
  365   #    restrictions
  366   return 0 unless (grep {/^$node_name$/}
  367        (qw(problem_list problem_detail gateway_quiz
  368            proctored_gateway_quiz)));
  369 
  370   # to check set restrictions we need a set and a user
  371   my $setName = $urlPath->arg("setID");
  372   my $userName = $r->param("user");
  373   my $effectiveUserName = $r->param("effectiveUser");
  374 
  375   # if there is no input userName, then the content generator will
  376   #    be forcing a login, so just bail
  377   return 0 if ( ! $userName || ! $effectiveUserName );
  378 
  379   # do we have a cached set that we can use?
  380   my $set = $self->{merged_set};
  381 
  382   if ( $setName =~ /,v(\d+)$/ ) {
  383     my $verNum = $1;
  384     $setName =~ s/,v\d+$//;
  385 
  386     if ( $set && $set->set_id eq $setName &&
  387          $set->user_id eq $effectiveUserName &&
  388          $set->version_id eq $verNum ) {
  389       # then we can just use this set and skip the rest
  390 
  391     } elsif ( $setName eq 'Undefined_Set' and
  392         $self->hasPermissions($userName, "access_instructor_tools") ) {
  393         # this is the case of previewing a problem
  394         #    from a 'try it' link
  395       return 0;
  396     } else {
  397       if ($db->existsSetVersion($effectiveUserName,$setName,$verNum)) {
  398         $set = $db->getMergedSetVersion($effectiveUserName,$setName,$verNum);
  399       } else {
  400         return "Requested version ($verNum) of set " .
  401           "'$setName' is not assigned to user " .
  402           "$effectiveUserName.";
  403       }
  404     }
  405     if ( ! $set ) {
  406       return "Requested set '$setName' could not be found " .
  407         "in the database for user $effectiveUserName.";
  408     }
  409   } else {
  410 
  411     if ( $set && $set->set_id eq $setName &&
  412          $set->user_id eq $effectiveUserName ) {
  413       # then we can just use this set, and skip the rest
  414 
  415     } else {
  416       if ( $db->existsUserSet($effectiveUserName,$setName) ) {
  417         $set = $db->getMergedSet($effectiveUserName,$setName);
  418       } elsif ( $setName eq 'Undefined_Set' and
  419         $self->hasPermissions($userName, "access_instructor_tools") ) {
  420         # this is the weird case of the library
  421         #   browser, when we don't actually have
  422         #   a set to look at, but this only happens among
  423         #   instructor tool users.
  424         return 0;
  425       } else {
  426         return "Requested set '$setName' is not " .
  427           "assigned to user $effectiveUserName.";
  428       }
  429     }
  430     if ( ! $set ) {
  431       return "Requested set '$setName' could not be found " .
  432         "in the database for user $effectiveUserName.";
  433     }
  434   }
  435   # cache the set for future use as needed.  this should probably
  436   #    be more sophisticated than this
  437   $self->{merged_set} = $set;
  438 
  439   # now we know that the set is assigned to the appropriate user;
  440   #    check to see if we're trying to access a set that's not open
  441   if ( before($set->open_date) &&
  442        ! $self->hasPermissions($userName, "view_unopened_sets") ) {
  443     return "Requested set '$setName' is not yet open.";
  444   }
  445 
  446   # also check to make sure that the set is visible, or that we're
  447   #    allowed to view hidden sets
  448   # (do we need to worry about visible not being set at this point?)
  449   my $visible = ( $set && $set->visible ne '0' &&
  450         $set->visible ne '1' ) ? 1 : $set->visible;
  451   if ( ! $visible &&
  452        ! $self->hasPermissions($userName, "view_hidden_sets") ) {
  453     return "Requested set '$setName' is not available yet.";
  454   }
  455 
  456   # check to be sure that gateways are being sent to the correct
  457   #    content generator
  458   if (defined($set->assignment_type) &&
  459       $set->assignment_type =~ /gateway/ &&
  460       ($node_name eq 'problem_list' || $node_name eq 'problem_detail')) {
  461     return "Requested set '$setName' is a test/quiz assignment " .
  462       "but the regular homework assignment content " .
  463       "generator $node_name was called.  Try re-entering " .
  464       "the set from the problem sets listing page.";
  465   } elsif ( (! defined($set->assignment_type) ||
  466        $set->assignment_type eq 'homework') &&
  467       $node_name =~ /gateway/ ) {
  468     return "Requested set '$setName' is a homework assignment " .
  469       "but the gateway/quiz content " .
  470       "generator $node_name was called.  Try re-entering " .
  471       "the set from the problem sets listing page.";
  472   }
  473 
  474   # and check that if we're entering a proctored assignment that we
  475   #    have a valid proctor login; this is necessary to make sure that
  476   #    someone doesn't use the unproctored url path to obtain access
  477   #    to a proctored assignment.
  478   if (defined($set->assignment_type) &&
  479       $set->assignment_type =~ /proctored/ &&
  480       ! WeBWorK::Authen::Proctor->new($r,$ce,$db)->verify() ) {
  481     return "Requested set '$setName' is a proctored test/quiz " .
  482       "assignment, but no valid proctor authorization " .
  483       "has been obtained.";
  484   }
  485 
  486   # and whether there are ip restrictions that we need to check
  487   my $badIP = $self->invalidIPAddress($set);
  488   return $badIP if $badIP;
  489 
  490   return 0;
  491 }
  492 
  493 sub invalidIPAddress {
  494 # this exists as a separate routine because we need to check multiple
  495 #    sets in Hardcopy; having this routine to check the set allows us to do
  496 #    that for all sets individually there.
  497 
  498   my $self = shift;
  499   my $set = shift;
  500 
  501   my $r = $self->{r};
  502   my $db = $r->db;
  503   my $urlPath = $r->urlpath;
  504 # my $setName = $urlPath->arg("setID");  # not always defined
  505   my $setName = $set->set_id;
  506   my $userName = $r->param("user");
  507   my $effectiveUserName = $r->param("effectiveUser");
  508 
  509   return 0 if ($set->restrict_ip eq '' || $set->restrict_ip eq 'No' ||
  510          $self->hasPermissions($userName,'view_ip_restricted_sets'));
  511 
  512   my $clientIP = new Net::IP($r->connection->remote_ip);
  513   # make sure that we're using the non-versioned set name
  514   $setName =~ s/,v\d+$//;
  515 
  516   my $restrictType = $set->restrict_ip;
  517   my @restrictLocations = $db->getAllMergedSetLocations($effectiveUserName,$setName);
  518   my @locationIDs = ( map {$_->location_id} @restrictLocations );
  519   my @restrictAddresses = ( map {$db->listLocationAddresses($_)} @locationIDs );
  520 
  521   # if there are no addresses in the locations, return an error that
  522   #    says this
  523   return "Client ip address " . $clientIP->ip() . " is not allowed to " .
  524       "work this assignment, because the assignment has ip address " .
  525       "restrictions and there are no allowed locations associated " .
  526       "with the restriction.  Contact your professor to have this " .
  527       "problem resolved." if ( ! @restrictAddresses );
  528 
  529   # build a set of IP objects to match against
  530   my @restrictIPs = ( map {new Net::IP($_)} @restrictAddresses );
  531 
  532   # and check the clientAddress against these: is $clientIP
  533   #    in @restrictIPs?
  534   my $inRestrict = 0;
  535   foreach my $rIP ( @restrictIPs ) {
  536     if ($rIP->overlaps($clientIP) == $IP_B_IN_A_OVERLAP ||
  537         $rIP->overlaps($clientIP) == $IP_IDENTICAL) {
  538       $inRestrict = $rIP->ip();
  539       last;
  540     }
  541   }
  542 
  543   # this is slightly complicated by having to check relax_restrict_ip
  544   my $badIP = '';
  545   if ( $restrictType eq 'RestrictTo' && ! $inRestrict ) {
  546     $badIP = "Client ip address " . $clientIP->ip() .
  547       " is not in the list of addresses from " .
  548       "which this assignment may be worked.";
  549   } elsif ( $restrictType eq 'DenyFrom' && $inRestrict ) {
  550     $badIP = "Client ip address " . $clientIP->ip() .
  551       " is in the list of addresses from " .
  552       "which this assignment may not be worked.";
  553   } else {
  554     return 0;
  555   }
  556 
  557   # if we're here, we failed the IP check, and so need to consider
  558   #    if ip restrictions were relaxed.  the set we were passed in
  559   #    is either the merged userset or the merged versioned userset,
  560   #    depending on whether the set is versioned or not
  561 
  562   my $relaxRestrict = $set->relax_restrict_ip;
  563   return $badIP if ( $relaxRestrict eq 'No' );
  564 
  565   if ( $set->assignment_type =~ /gateway/ ) {
  566     if ( $relaxRestrict eq 'AfterAnswerDate' ) {
  567       # in this case we need to go and get the userset,
  568       #    not the versioned set (which we already have)
  569       #    drat!
  570       my $userset = $db->getMergedSet($set->user_id,$setName);
  571       return( ! $userset || before($userset->answer_date)
  572         ? $badIP : 0 );
  573     } else {
  574       # this is easier; just look at the current answer date
  575       return( before($set->answer_date) ? $badIP : 0 );
  576     }
  577   } else {
  578     # the set isn't versioned, so assume that $relaxRestrict
  579     #    is 'AfterAnswerDate', regardless of what it actually
  580     #    is; 'AfterVersionAnswerDate' doesn't make sense in
  581     #    this case
  582     return( before($set->answer_date) ? $badIP : 0 );
  583   }
  584 }
  585 
  586 =back
  587 
  588 =cut
  589 
  590 =head1 AUTHOR
  591 
  592 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam
  593 Hathaway, sh002i at math.rochester.edu.
  594 
  595 =cut
  596 
  597 
  598 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9