--- loncom/interface/lonsource.pm	2015/05/25 15:36:11	1.35
+++ loncom/interface/lonsource.pm	2020/02/17 23:04:18	1.40
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Source Code handler
 #
-# $Id: lonsource.pm,v 1.35 2015/05/25 15:36:11 raeburn Exp $
+# $Id: lonsource.pm,v 1.40 2020/02/17 23:04:18 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -37,6 +37,7 @@ use Apache::lonhtmlcommon();
 use Apache::lonsequence();
 use Apache::Constants qw(:common :http);
 use Apache::lonmeta;
+use Apache::lonenc();
 use Apache::File;
 use Apache::lonlocal;
 use HTML::Entities;
@@ -44,8 +45,9 @@ use LONCAPA qw(:DEFAULT :match);
 
 sub make_link {
     my ($filename, $listname) = @_;
-    my $sourcelink = "/adm/source?inhibitmenu=yes&filename=".$filename."&listname=".$listname;
-
+    my $sourcelink = '/adm/source?inhibitmenu=yes&filename='.
+                     &escape(&escape($filename)).'&listname='.
+                     &escape(&escape($listname));
     return $sourcelink;
 }
 
@@ -195,16 +197,27 @@ sub copy_file {
 }
 
 sub print_item {
-    my ($r,$filename,$listname) = @_;
-    my $file_output = 
-        &includemeta(&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$filename),
-                                              $filename);
+    my ($r,$filename,$listname,$context) = @_;
+    my $file_output;
+    if ($context eq 'view') {
+        $file_output =
+            &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$filename);
+    } else {
+        $file_output =
+            &includemeta(&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$filename),
+                                                  $filename);
+    }
     $r->print(&Apache::loncommon::start_page('View Source Code',undef,
                                              {'only_body' => 1}));
     if ($file_output ne '') {
         my $access_to_cstr;
         my $lonhost = $r->dir_config('lonHostID');
-        if (&Apache::lonnet::is_library($lonhost)) {
+        if ($context eq 'view') {
+            $r->print('<form name="view" action="" target="_parent" method="post"><span class="LC_info">'.
+                      &mt('Source code is displayed below.').
+                      '</span>'.('&nbsp;' x4).'<input type="button" name="close" onclick="window.close();"'.
+                      ' value="'.&mt('Close Window').'" /></form><hr />');
+        } elsif (&Apache::lonnet::is_library($lonhost)) {
             my @possdoms = &Apache::lonnet::current_machine_domains();
             foreach my $dom (@possdoms) {
                 if ($env{"user.role.au./$dom/"}) {
@@ -331,21 +344,53 @@ sub get_path_to_newfile {
 sub handler {
     my $r=shift;
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
-                                            ['filename','listname']);
+                                            ['filename','listname','viewonly']);
     my $filename = $env{'form.filename'};
+    my $shownfilename = $filename;
+    $shownfilename =~ s/(`)/'/g;
+    $shownfilename =~ s/\$/\(\$\)/g;
     my $listname = $env{'form.listname'};
+    my $viewonly = $env{'form.viewonly'};
 
-    my $source = &Apache::lonnet::metadata($filename,'sourceavail');
-    if ($source ne 'open') {
-        $env{'user.error.msg'}="$filename:cre:1:1:Source code not available";
+    if ($viewonly) {
+        my $canview;
+        if ((&Apache::lonnet::metadata($filename,'sourceavail') eq 'open') &&
+            (&Apache::lonnet::allowed('cre','/'))) {
+            $canview = 1;
+        } elsif (($env{'request.course.id'}) && (&Apache::lonnet::is_on_map($filename))) {
+            my $crs_sec = $env{'request.course.id'} . (($env{'request.course.sec'} ne '')
+                                                      ? "/$env{'request.course.sec'}"
+                                                      : '');
+            if (&Apache::lonnet::allowed('vxc',$crs_sec)) {
+                my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+                &Apache::lonenc::check_decrypt(\$filename);
+                if (($env{'request.role.domain'} eq $cdom) && ($filename =~ /$LONCAPA::assess_re/)) {
+                    my ($auname) = ($filename =~ m{^\Q/res/$cdom/\E($match_username)/});
+                    if (($auname ne '') && ($env{'request.course.adhocsrcaccess'} ne '') &&
+                        (grep(/^\Q$auname\E$/,split(/,/,$env{'request.course.adhocsrcaccess'})))) {
+                        $canview = 1;
+                    } elsif ((&Apache::lonnet::metadata($filename,'sourceavail') eq 'open') &&
+                             ($filename =~ m{^\Q/res/$cdom/}) &&
+                             (&Apache::lonnet::allowed('bre',$crs_sec))) {
+                        $canview = 1;
+                    }
+                }
+            }
+        }
+        unless ($canview) {
+            $env{'user.error.msg'}="$shownfilename:cre:1:1:Source code not available";
+            return HTTP_NOT_ACCEPTABLE;
+        }
+    } elsif (&Apache::lonnet::metadata($filename,'sourceavail') ne 'open') {
+        $env{'user.error.msg'}="$shownfilename:cre:1:1:Source code not available";
         return HTTP_NOT_ACCEPTABLE;
     }
     unless (&Apache::lonnet::allowed('bre',$filename)) {
-        $env{'user.error.msg'}="$filename:bre:1:1:Access to resource denied";
+        $env{'user.error.msg'}="$shownfilename:bre:1:1:Access to resource denied";
         return HTTP_NOT_ACCEPTABLE;
     }
-    unless (&Apache::lonnet::allowed('cre','/')) {
-        $env{'user.error.msg'}="$filename:cre:1:1:Access to source code denied";
+    unless (($viewonly) || (&Apache::lonnet::allowed('cre','/'))) {
+        $env{'user.error.msg'}="$shownfilename:cre:1:1:Access to source code denied";
         return HTTP_NOT_ACCEPTABLE;
     }
     my $newpath = $env{'form.newpath'};
@@ -353,7 +398,9 @@ sub handler {
     &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;
 
-    if ($env{'form.action'} eq 'stage2') {
+    if ($viewonly) {
+        &print_item($r,$filename,$listname,'view');
+    } elsif ($env{'form.action'} eq 'stage2') {
         &stage_2($r,$filename,$listname);
     } elsif($env{'form.action'} eq 'copy_stage') {
         &copy_stage($r,$filename,$listname,$newpath);