--- loncom/lonnet/perl/lonnet.pm	2019/01/27 14:40:02	1.1401
+++ loncom/lonnet/perl/lonnet.pm	2019/01/27 16:02:58	1.1402
@@ -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 @@ sub set_adhoc_privileges {
     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 @@ sub allowed {
             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 @@ sub allowed {
                     $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 @@ sub allowed {
                   =~/\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 @@ sub allowed {
 	return 'A';
     } elsif ($thisallowed eq 'B') {
         return 'B';
+    } elsif ($thisallowed eq 'D') {
+        return 'D';
     }
    return 'F';
 }
@@ -8569,6 +8581,93 @@ sub has_comm_blocking {
 }
 }
 
+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,@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 @@ prevents recursive calls to &allowed.
  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 *