[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom loncapa_apache.conf loncom/auth lonacc.pm lonauth.pm lonlogin.pm lonprotected.pm migrateuser.pm switchserver.pm loncom/lonnet/perl lonnet.pm

raeburn raeburn at source.lon-capa.org
Sun Jan 27 11:03:09 EST 2019


raeburn		Sun Jan 27 16:03:09 2019 EDT

  Added files:                 
    /loncom/auth	lonprotected.pm 

  Modified files:              
    /loncom/auth	lonacc.pm lonauth.pm lonlogin.pm migrateuser.pm 
                	switchserver.pm 
    /loncom	loncapa_apache.conf 
    /loncom/lonnet/perl	lonnet.pm 
    /doc/loncapafiles	loncapafiles.lpml 
  Log:
  - Bug 6400
    - Enforce access restrictions for content which is deeplink-only (users
      with "advanced priv for current role are exempt).
    - Support "key" link type in deeplink parameter (requested link must either
      be sent with linkkey as element in POSTed data, or with linkkey in query 
      string).  Corresponding value must match key set in deeplink parameter.
  
  
-------------- next part --------------
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.174 loncom/auth/lonacc.pm:1.175
--- loncom/auth/lonacc.pm:1.174	Sat Dec 29 23:24:52 2018
+++ loncom/auth/lonacc.pm	Sun Jan 27 16:02:43 2019
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Cookie Based Access Handler
 #
-# $Id: lonacc.pm,v 1.174 2018/12/29 23:24:52 raeburn Exp $
+# $Id: lonacc.pm,v 1.175 2019/01/27 16:02:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -102,6 +102,7 @@
 use Apache::lonlocal;
 use Apache::restrictedaccess();
 use Apache::blockedaccess();
+use Apache::lonprotected();
 use Fcntl qw(:flock);
 use LONCAPA qw(:DEFAULT :match);
 
@@ -634,6 +635,10 @@
                 &Apache::blockedaccess::setup_handler($r);
                 return OK;
             }
+            if ($access eq 'D') {
+                &Apache::lonprotected::setup_handler($r);
+                return OK;
+            }
 	    if (($access ne '2') && ($access ne 'F')) {
                 if ($requrl =~ m{^/res/}) {
                     $access = &Apache::lonnet::allowed('bro',$requrl);
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.156 loncom/auth/lonauth.pm:1.157
--- loncom/auth/lonauth.pm:1.156	Wed Dec 26 20:10:21 2018
+++ loncom/auth/lonauth.pm	Sun Jan 27 16:02:43 2019
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # User Authentication Module
 #
-# $Id: lonauth.pm,v 1.156 2018/12/26 20:10:21 raeburn Exp $
+# $Id: lonauth.pm,v 1.157 2019/01/27 16:02:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -302,6 +302,13 @@
         my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl});
         if ($firsturl ne '') {
             $retry .= (($retry=~/\?/)?'&':'?').'firsturl='.$firsturl;
+            if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) {
+                unless (exists($form->{linkprot})) {
+                    if (exists($form->{linkkey})) {
+                        $retry .= 'linkkey='.$form->{linkkey};
+                    }
+                }
+            }
         }
     }
     if (exists($form->{linkprot})) {
@@ -374,6 +381,9 @@
             my $dest = '/adm/roles';
             if ($env{'form.firsturl'} ne '') {
                 $dest = $env{'form.firsturl'};
+                if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+                    &Apache::lonnet::appenv({'request.deeplink.login' => $env{'form.firsturl'}}); 
+                }
             }
             $r->print(
                $start_page
@@ -445,7 +455,7 @@
         return OK;
     }
 
-    my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr,$linkprotstr)=split(/&/,$tmpinfo);
+    my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr,$linkstr)=split(/&/,$tmpinfo);
     if ($rolestr) {
         $rolestr = &unescape($rolestr);
     }
@@ -455,8 +465,8 @@
     if ($iptokenstr) {
         $iptokenstr = &unescape($iptokenstr);
     }
-    if ($linkprotstr) {
-        $linkprotstr = &unescape($linkprotstr);
+    if ($linkstr) {
+        $linkstr = &unescape($linkstr);
     }
     if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) {
         $form{'firsturl'} = $firsturl;
@@ -470,8 +480,10 @@
     if ($iptokenstr =~ /^iptoken=/) {
         (undef,$form{'iptoken'}) = split('=',$iptokenstr);
     }
-    if ($linkprotstr =~ /^linkprot=/) {
-        (undef,$form{'linkprot'}) = split('=',$linkprotstr);
+    if ($linkstr =~ /^linkprot=/) {
+        (undef,$form{'linkprot'}) = split('=',$linkstr);
+    } elsif ($linkstr =~ /^linkkey=/) {
+        (undef,$form{'linkkey'}) = split('=',$linkstr);
     }
 
     my $upass = $ENV{HTTPS} ? $form{'upass0'} 
@@ -655,6 +667,11 @@
             }
             if ($form{'linkprot'}) {
                 $env{'request.linkprot'} = $form{'linkprot'};
+            } elsif ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+                if ($form{'linkkey'}) {
+                    $env{'request.linkkey'} = $form{'linkkey'};
+                }
+                $env{'request.deeplink.login'} = $form{'firsturl'};
             }
             $r->internal_redirect($switchto);
         } else {
@@ -679,6 +696,12 @@
                 }
                 if ($form{'linkprot'}) {
                     $env{'request.linkprot'} = $form{'linkprot'};
+                } elsif ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+                    if ($form{'linkkey'}) {
+                        $env{'request.linkkey'} = $form{'linkkey'};
+                    }
+                    $env{'request.deeplink.login'} = $form{'firsturl'};
+
                 }
                 $r->internal_redirect($switchto);
             } else {
@@ -711,6 +734,11 @@
                          undef,\%form);
                 if ($form{'linkprot'}) {
                     $env{'request.linkprot'} = $form{'linkprot'};
+                } elsif ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+                    if ($form{'linkkey'}) {
+                        $env{'request.linkkey'} = $form{'linkkey'};
+                    }
+                    $env{'request.deeplink.login'} = $form{'firsturl'};
                 }
                 $r->internal_redirect('/adm/switchserver?otherserver='.$unloaded.'&origurl='.$firsturl);
                 return OK;
@@ -726,6 +754,14 @@
                 $extra_env = {'user.linkprotector' => $linkprotector,
                               'user.linkproturi'   => $uri,};
             }
+        } elsif ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+            if ($form{'linkkey'}) {
+                $extra_env = {'user.deeplinkkey' => $form{'linkkey'},
+                              'user.keyedlinkuri' => $form{'firsturl'},
+                              'request.deeplink.login' => $form{'firsturl'}};
+            } else {
+                $extra_env = {'request.deeplink.login' => $form{'firsturl'}};
+            }
         }
         &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,$extra_env,
                  \%form);
@@ -793,6 +829,11 @@
                      $form);
             if ($form->{'linkprot'}) {
                 $env{'request.linkprot'} = $form->{'linkprot'};
+            } elsif ($form->{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+                if ($form->{'linkkey'}) {
+                    $env{'request.linkkey'} = $form->{'linkkey'};
+                }
+                $env{'request.deeplink.login'} = $form->{'firsturl'};
             }
             my ($otherserver) = &Apache::lonnet::choose_server($udom);
             $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.178 loncom/auth/lonlogin.pm:1.179
--- loncom/auth/lonlogin.pm:1.178	Thu Dec 27 18:14:38 2018
+++ loncom/auth/lonlogin.pm	Sun Jan 27 16:02:43 2019
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Login Screen
 #
-# $Id: lonlogin.pm,v 1.178 2018/12/27 18:14:38 raeburn Exp $
+# $Id: lonlogin.pm,v 1.179 2019/01/27 16:02:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -47,7 +47,7 @@
 	(join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
 	      $ENV{'REDIRECT_QUERY_STRING'}),
 	 ['interface','username','domain','firsturl','localpath','localres',
-	  'token','role','symb','iptoken','btoken','ltoken']);
+	  'token','role','symb','iptoken','btoken','ltoken','linkkey']);
     if (!defined($env{'form.firsturl'})) {
         &Apache::lonacc::get_posted_cgi($r,['firsturl']);
     }
@@ -56,6 +56,10 @@
             $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
         }
     }
+    if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
+        (!$env{'form.ltoken'}) && (!$env{'form.linkkey'})) {
+        &Apache::lonacc::get_posted_cgi($r,['linkkey']);
+    }
 
 # -- check if they are a migrating user
     if (defined($env{'form.token'})) {
@@ -131,6 +135,9 @@
                 }
                 &Apache::lonnet::tmpdel($env{'form.ltoken'});
                 delete($env{'form.ltoken'});
+            } elsif ($env{'form.linkkey'}) {
+                $info{'linkkey'} = $env{'form.linkkey'};
+                delete($env{'form.linkkey'});
             }
             my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
             if ($balancer_token) {
@@ -151,13 +158,15 @@
 # it a balancer cookie for an active session on this server.
 #
 
-    my ($balcookie,$linkprot);
+    my ($balcookie,$linkprot,$linkkey);
     if ($env{'form.btoken'}) {
         my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
         $balcookie = $info{'balcookie'};
         if ($balcookie) {
             if ($info{'linkprot'}) {
                 $linkprot = $info{'linkprot'};
+            } elsif ($info{'linkkey'}) {
+                $linkkey = $info{'linkkey'};
             }
         }    
         &Apache::lonnet::tmpdel($env{'form.btoken'});
@@ -213,7 +222,7 @@
                 }
                 if ($env{'user.linkproturi'}) {
                     my @proturis = split(/,/,$env{'user.linkproturi'});
-                    unless(grep(/^\Q$deeplink\E$/, at proturis)) {
+                    unless (grep(/^\Q$deeplink\E$/, at proturis)) {
                         push(@proturis,$deeplink);
                         @proturis = sort @proturis;
                         &Apache::lonnet::appenv({'user.linkproturi' => join(',', at proturis)});
@@ -222,6 +231,31 @@
                     &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
                 }
             }
+        } elsif (($env{'form.linkkey'}) || ($linkkey)) {
+            if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+                if ($linkkey eq '') {
+                    $linkkey = $env{'form.linkkey'};
+                }
+                if ($env{'user.deeplinkkey'}) {
+                    my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
+                    unless (grep(/^\Q$linkkey\E$/, at linkkeys)) {
+                        push(@linkkeys,$linkkey);
+                        &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});  
+                    }
+                } else {
+                    &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
+                }
+                my $deeplink = $env{'form.firsturl'}; 
+                if ($env{'user.keyedlinkuri'}) {
+                    my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
+                    unless (grep(/^\Q$deeplink\E$/, at keyeduris)) {
+                        push(@keyeduris,$deeplink);
+                        &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
+                    }
+                } else {
+                    &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
+                }
+            }
         }
 	$r->print(
                   $start_page
@@ -373,6 +407,11 @@
             }
             $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
         }
+    } elsif ($env{'form.linkkey'}) {
+        if (!$tokenextras) {
+            $tokenextras = '&&&';
+        }
+        $tokenextras .= '&linkkey='.&escape($env{'form.linkkey'});
     }
     my $logtoken=Apache::lonnet::reply(
        'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
Index: loncom/auth/migrateuser.pm
diff -u loncom/auth/migrateuser.pm:1.42 loncom/auth/migrateuser.pm:1.43
--- loncom/auth/migrateuser.pm:1.42	Wed Dec 26 20:10:21 2018
+++ loncom/auth/migrateuser.pm	Sun Jan 27 16:02:43 2019
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Starts a user off based of an existing token.
 #
-# $Id: migrateuser.pm,v 1.42 2018/12/26 20:10:21 raeburn Exp $
+# $Id: migrateuser.pm,v 1.43 2019/01/27 16:02:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -674,6 +674,9 @@
 						     $handle);
             if ($data{'linkprot'} ne '') {
                 my ($linkprotector,$deeplink) = split(/:/,$data{'linkprot'},2);
+                if ($deeplink ne '') {
+                    &Apache::lonnet::appenv({'request.deeplink.login' => $deeplink});
+                }
                 if ($env{'user.linkprotector'}) {
                     my @protectors = split(/,/,$env{'user.linkprotector'});
                     unless (grep(/^\Q$linkprotector\E$/, at protectors)) {
@@ -683,7 +686,7 @@
                     }
                 } else {
                     &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
-                }   
+                }
                 if ($env{'user.linkproturi'}) {
                     my @proturis = split(/,/,$env{'user.linkproturi'});
                     unless(grep(/^\Q$deeplink\E$/, at proturis)) {
@@ -694,6 +697,30 @@
                 } else {
                     &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
                 }
+            } elsif ($data{'deeplink.login'}) {
+                my $deeplink = $data{'deeplink.login'};
+                if ($data{'linkkey'}) {
+                    my $linkkey = $data{'linkkey'};
+                    if ($env{'user.deeplinkkey'}) {
+                        my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
+                        unless (grep(/^\Q$linkkey\E$/, at linkkeys)) {
+                            push(@linkkeys,$linkkey);
+                            &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
+                        }
+                    } else {
+                        &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
+                    }
+                    if ($env{'user.keyedlinkuri'}) {
+                        my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
+                        unless (grep(/^\Q$deeplink\E$/, at keyeduris)) {
+                            push(@keyeduris,$deeplink);
+                            &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
+                        }
+                    } else {
+                        &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
+                    }
+                }
+                &Apache::lonnet::appenv({'request.deeplink.login' => $data{'deeplink.login'}});
             }
             if ($data{'lti.login'}) {
                 my $needslogout;
@@ -799,6 +826,21 @@
                                           'user.linkproturi' => $linkuri,};
                         }
                     }
+                } elsif ($data{'deeplink.login'}) {
+                    if ($data{'linkkey'}) {
+                        if (ref($extra_env) eq 'HASH') {
+                            $extra_env->{'user.deeplinkkey'} = $data{'linkkey'};
+                            $extra_env->{'user.keyedlinkuri'} = $data{'deeplink.login'},
+                        } else {
+                            $extra_env = {'user.deeplinkkey' => $data{'linkkey'},
+                                          'user.keyedlinkuri' => $data{'deeplink.login'}};
+                        }
+                    }
+                    if (ref($extra_env) eq 'HASH') {
+                        $extra_env->{'request.deeplink.login' => $data{'deeplink.login'}};
+                    } else {
+                        $extra_env = {'request.deeplink.login' => $data{'deeplink.login'}};
+                    }
                 }
             }
             my $skipcritical;
Index: loncom/auth/switchserver.pm
diff -u loncom/auth/switchserver.pm:1.47 loncom/auth/switchserver.pm:1.48
--- loncom/auth/switchserver.pm:1.47	Wed Dec 26 20:10:21 2018
+++ loncom/auth/switchserver.pm	Sun Jan 27 16:02:43 2019
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Switch Servers Handler
 #
-# $Id: switchserver.pm,v 1.47 2018/12/26 20:10:21 raeburn Exp $
+# $Id: switchserver.pm,v 1.48 2019/01/27 16:02:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -283,6 +283,12 @@
     if ($env{'request.linkprot'}) {
         $info{'linkprot'} = $env{'request.linkprot'};
     }
+    if ($env{'request.deeplink.login'}) {
+        $info{'deeplink.login'} = $env{'request.deeplink.login'};
+        if ($env{'request.linkkey'}) {
+            $info{'linkkey'} = $env{'request.linkkey'};
+        }
+    }
     if ($env{'request.lti.login'}) {
         $info{'lti.login'} = $env{'request.lti.login'};
     }
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.266 loncom/loncapa_apache.conf:1.267
--- loncom/loncapa_apache.conf:1.266	Sun Jan 20 23:40:32 2019
+++ loncom/loncapa_apache.conf	Sun Jan 27 16:02:51 2019
@@ -2,7 +2,7 @@
 ## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
 ##
 
-# $Id: loncapa_apache.conf,v 1.266 2019/01/20 23:40:32 raeburn Exp $
+# $Id: loncapa_apache.conf,v 1.267 2019/01/27 16:02:51 raeburn Exp $
 
 #
 # LON-CAPA Section (extensions to httpd.conf daemon configuration)
@@ -788,6 +788,17 @@
 ErrorDocument     500 /adm/errorhandler
 </Location>
 
+<Location /adm/protected>
+PerlAccessHandler      Apache::publiccheck
+AuthType LONCAPA
+Require valid-user
+PerlAuthzHandler       Apache::lonacc
+SetHandler perl-script
+PerlHandler Apache::lonprotected
+ErrorDocument     403 /adm/login
+ErrorDocument     500 /adm/errorhandler
+</Location>
+
 <Location /adm/logout>
 AuthType LONCAPA
 Require valid-user
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1401 loncom/lonnet/perl/lonnet.pm:1.1402
--- loncom/lonnet/perl/lonnet.pm:1.1401	Sun Jan 27 14:40:02 2019
+++ loncom/lonnet/perl/lonnet.pm	Sun Jan 27 16:02:58 2019
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1401 2019/01/27 14:40:02 raeburn Exp $
+# $Id: lonnet.pm,v 1.1402 2019/01/27 16:02:58 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -6709,7 +6709,8 @@
     my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash);
     &appenv(\%userroles,[$role,'cm']);
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);
-    unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
+    unless (($caller eq 'constructaccess' && $env{'request.course.id'}) ||
+            ($caller eq 'tiny')) {
         &appenv( {'request.role'        => $spec,
                   'request.role.domain' => $dcdom,
                   'request.course.sec'  => $sec,
@@ -7983,7 +7984,10 @@
             if ($env{'user.priv.'.$env{'request.role'}.'./'}
                   =~/\Q$priv\E\&([^\:]*)/) {
                 my $value = $1;
-                if ($noblockcheck) {
+                my $deeplinkblock = &deeplink_check($priv,$symb,$uri);
+                if ($deeplinkblock) {
+                    $thisallowed='D';
+                } elsif ($noblockcheck) {
                     $thisallowed.=$value;
                 } else {
                     my @blockers = &has_comm_blocking($priv,$symb,$uri);
@@ -8003,7 +8007,10 @@
                     $refuri=&declutter($refuri);
                     my ($match) = &is_on_map($refuri);
                     if ($match) {
-                        if ($noblockcheck) {
+                        my $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
+                        if ($deeplinkblock) {
+                            $thisallowed='D';
+                        } elsif ($noblockcheck) {
                             $thisallowed='F';
                         } else {
                             my @blockers = &has_comm_blocking($priv,$symb,$refuri);
@@ -8108,7 +8115,10 @@
                   =~/\Q$priv\E\&([^\:]*)/) {
                   my $value = $1;
                   if ($priv eq 'bre') {
-                      if ($noblockcheck) {
+                      my $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
+                      if ($deeplinkblock) {
+                          $thisallowed = 'D';
+                      } elsif ($noblockcheck) {
                           $thisallowed.=$value;
                       } else {
                           my @blockers = &has_comm_blocking($priv,$symb,$refuri);
@@ -8276,6 +8286,8 @@
 	return 'A';
     } elsif ($thisallowed eq 'B') {
         return 'B';
+    } elsif ($thisallowed eq 'D') {
+        return 'D';
     }
    return 'F';
 }
@@ -8569,6 +8581,93 @@
 }
 }
 
+sub deeplink_check {
+    my ($priv,$symb,$uri) = @_;
+    return unless ($env{'request.course.id'});
+    return unless ($priv eq 'bre');
+    return if ($env{'request.state'} eq 'construct');
+    return if ($env{'request.role.adv'});
+    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+    my (%possibles, at symbs);
+    if (!$symb) {
+        $symb = &symbread($uri,1,1,1,\%possibles);
+    }
+    if ($symb) {
+        @symbs = ($symb);
+    } elsif (keys(%possibles)) {
+        @symbs = keys(%possibles);
+    }
+
+    my ($login,$switchrole,$allow);
+    if ($env{'request.deeplink.login'} =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
+        my $key = $1;
+        my $tinyurl;
+        my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
+        if (defined($cached)) {
+             $tinyurl = $result;
+        } else {
+             my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+             my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
+             if ($currtiny{$key} ne '') {
+                 $tinyurl = $currtiny{$key};
+                 &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
+             }
+        }
+        if ($tinyurl ne '') {
+            my ($cnumreq,$posslogin) = split(/\&/,$tinyurl);
+            if ($cnumreq eq $cnum) {
+                $login = $posslogin;
+            } else {
+                $switchrole = 1;
+            }
+        }
+    }
+    foreach my $symb (@symbs) {
+        last if ($allow);
+        my $deeplink = &EXT("resource.0.deeplink",$symb);
+        if ($deeplink eq '') {
+            $allow = 1;
+        } else {
+            my ($listed,$scope,$access) = split(/,/,$deeplink);
+            if ($access eq 'any') {
+                $allow = 1;
+            } elsif ($login) {
+                if ($access eq 'only') {
+                    if ($scope eq 'res') {
+                        if ($symb eq $login) {
+                            $allow = 1;
+                        }
+                    } elsif ($scope eq 'map') {
+#FIXME Compare map for $env{'request.deeplink.login'} with map for $symb
+                    } elsif ($scope eq 'rec') {
+#FIXME Recurse up for $env{'request.deeplink.login'} with map for $symb
+                    }
+                } else {
+                    my ($acctype,$item) = split(/:/,$access);
+                    if (($acctype eq 'lti') && ($env{'user.linkprotector'})) {
+                        if (grep(/^\Q$item\E$/,split(/,/,$env{'user.linkprotector'}))) {
+                            my %tinyurls = &get('tiny',[$symb],$cdom,$cnum);
+                            if (grep(/\Q$tinyurls{$symb}\E$/,split(/,/,$env{'user.linkproturis'}))) {
+                                $allow = 1;
+                            }
+                        }
+                    } elsif (($acctype eq 'key') && ($env{'user.deeplinkkey'})) {
+                        if (grep(/^\Q$item\E$/,split(/,/,$env{'user.deeplinkkey'}))) {
+                            my %tinyurls = &get('tiny',[$symb],$cdom,$cnum);
+                            if (grep(/\Q$tinyurls{$symb}\E$/,split(/,/,$env{'user.keyedlinkuri'}))) {
+                                $allow = 1;
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return if ($allow);
+    return 1;
+}
+
 # -------------------------------- Deversion and split uri into path an filename   
 
 #
@@ -14977,6 +15076,7 @@
  2: browse allowed
  A: passphrase authentication needed
  B: access temporarily blocked because of a blocking event in a course.
+ D: access blocked because access is required via session initiated via deep-link 
 
 =item *
 
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.977 doc/loncapafiles/loncapafiles.lpml:1.978
--- doc/loncapafiles/loncapafiles.lpml:1.977	Wed Dec 12 20:10:54 2018
+++ doc/loncapafiles/loncapafiles.lpml	Sun Jan 27 16:03:08 2019
@@ -2,7 +2,7 @@
  "http://lpml.sourceforge.net/DTD/lpml.dtd">
 <!-- loncapafiles.lpml -->
 
-<!-- $Id: loncapafiles.lpml,v 1.977 2018/12/12 20:10:54 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.978 2019/01/27 16:03:08 raeburn Exp $ -->
 
 <!--
 
@@ -6739,7 +6739,14 @@
 <source>loncom/auth/blockedaccess.pm</source>
 <target dist='default'>home/httpd/lib/perl/Apache/blockedaccess.pm</target>
 <categoryname>handler</categoryname>
-<description>Information about course-based blocking conditions for files with blocked access (currently affects portfolio files)</description>
+<description>Information about course-based blocking conditions for files with blocked access (currently affects portfolio files) and resources in a course</description>
+<status>works/unverified</status>
+</file>
+<file>
+<source>loncom/auth/lonprotected.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/lonprotected.pm</target>
+<categoryname>handler</categoryname>
+<description>Information about deeplink-only access for a resource</description>
 <status>works/unverified</status>
 </file>
 <file>

Index: loncom/auth/lonprotected.pm
+++ loncom/auth/lonprotected.pm
# The LearningOnline Network
# Information about deep-link only access for a resource
#
# $Id: lonprotected.pm,v 1.1 2019/01/27 16:02:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::lonprotected

use strict;
use Apache::Constants qw(:common :http REDIRECT);
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonlocal;

sub handler {
    my $r = shift;
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    return OK if $r->header_only;

    &Apache::lonlocal::get_language_handle($r);
    my $origurl = $r->uri;

    my ($blocktext,$title);
    if ($origurl eq '/adm/protected') {
        $blocktext = '<div>'.
                     &mt('This page is displayed when access is blocked to course/community content, in the case where access via a deep-link is required.').
                     '<br />'.&mt("The restriction to access via a deep-link which can be set for specific content or a folder in a course does not apply to course personnel with elevated privileges in the course.").
                     '<div>';
        $title = 'Access Information';
    } elsif ($env{'request.course.id'}) {
        my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
        my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
        $blocktext = '<h2>'.&mt('Access denied').'</h2>'."\n".
                     '<div>'.
                     &mt('The resource you are trying to display must be accessed via a link to the resource from a web page external to LON-CAPA ').
                     '</div>';
       $title = 'Access Blocked';
    } else {
        my $server = &Apache::lonnet::absolute_url();
        $r->header_out(Location => $server.$origurl);
        return REDIRECT;
    }
    $r->print(&Apache::loncommon::start_page($title));
    $r->print($blocktext);
    $r->print(&Apache::loncommon::end_page());
    return OK;
}

sub setup_handler {
    my ($r) = @_;
    $r->set_handlers('PerlHandler'=>
                     [\&Apache::lonprotected::handler]);
    $r->handler('perl-script');
}

1;


More information about the LON-CAPA-cvs mailing list