Return to lonsource.pm CVS log

Up to [LON-CAPA] / loncom / interface

- "View source" link in Functions bar for published assessment items in a
  course, where user does not have editing privileges, but does have vxc
  priv in course, and system-level bre priv, and item publised source open.

    1: # The LearningOnline Network with CAPA
    2: # Source Code handler
    3: #
    4: # $Id: lonsource.pm,v 1.38 2017/10/07 21:07:17 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: 
   31: package Apache::lonsource;
   32: 
   33: use strict;
   34: use Apache::lonnet;
   35: use Apache::loncommon();
   36: use Apache::lonhtmlcommon();
   37: use Apache::lonsequence();
   38: use Apache::Constants qw(:common :http);
   39: use Apache::lonmeta;
   40: use Apache::lonenc();
   41: use Apache::File;
   42: use Apache::lonlocal;
   43: use HTML::Entities;
   44: use LONCAPA qw(:DEFAULT :match);
   45: 
   46: sub make_link {
   47:     my ($filename, $listname) = @_;
   48:     my $sourcelink = '/adm/source?inhibitmenu=yes&filename='.
   49:                      &escape(&escape($filename)).'&listname='.
   50:                      &escape(&escape($listname));
   51:     return $sourcelink;
   52: }
   53: 
   54: sub stage_2 {
   55:     my ($r, $filename, $listname) = @_;
   56:     my ($author)=($filename=~/\/res\/[^\/]+\/([^\/]+)\//);
   57:     $r->print(&Apache::loncommon::start_page('Copy Problem Source Code to Authoring Space',undef,
   58:                                              {'only_body' => 1,})
   59:              .&mt('Please enter the directory that you would like the source code to go into.')
   60:              .'<p>'
   61:              .&mt('Note: the path is in reference to the root of your Authoring Space,'
   62:                  .' and new directories will be automatically created.')
   63:              .'</p>');
   64:     $r->print('<form name="copy" action="/adm/source" target="_parent" method="post">
   65:               <input type="hidden" name="filename" value="'.$filename.'" />
   66:               <input type="hidden" name="listname" value="'.$listname.'" />
   67:               <input type="hidden" name="action" value="copy_stage" />
   68:               <input type="text" size="50" name="newpath" value="/'.&mt('shared_source').'/'.$author.'" />&nbsp;
   69:               <input type="submit" value="'.&mt('Copy').'" />
   70:               </form>'.
   71:               &Apache::loncommon::end_page());
   72:     return OK;
   73: }
   74: 
   75: sub copy_author {
   76:     my $role;
   77:     my $domain;
   78:     my $author_name;
   79:     if ($env{'request.role'} =~ m{^ca\.}) {
   80:         ($role, $domain, $author_name) = split(/\//,$env{'request.role'});
   81:     } else {
   82:         $role = "au.";
   83:         $domain = $env{'user.domain'};
   84:         $author_name = $env{'user.name'};
   85:     }
   86:     return ($role,$author_name,$domain);
   87: }
   88: 
   89: 
   90: sub copy_stage {
   91:     my ($r, $filename, $listname, $newpath) = @_;
   92: 
   93:     my ($path_to_new_file,$uname,$udom) = &get_path_to_newfile($r,$newpath,$listname);
   94: 
   95:     #allowed
   96:     if ($path_to_new_file) {
   97:         $r->print(&Apache::loncommon::start_page('Copying Source',undef,{'only_body' => 1}));
   98:         my $result = &Apache::loncfile::exists($uname, $udom, $path_to_new_file);
   99:         $r->print($result);
  100:         if (($result) && ($result =~ /published/)) {
  101: 	    &delete_copy_file($r, $newpath, $filename, $path_to_new_file, '1');
  102:         } elsif (($result) && ($result =~ /exists\!/)) {
  103: 	    &confirm($r, $newpath, $filename, $listname);
  104:         } else {
  105: 	    &copy_file($r, $newpath, $filename, $path_to_new_file);
  106:         }
  107:         $r->print(&Apache::loncommon::end_page());
  108:     }
  109:     return;
  110: }
  111: 
  112: sub confirm {
  113:     my ($r, $newpath, $filename, $listname) = @_;
  114:     $r->print('<b>'.&mt('Press delete to remove file and replace it with a copy of the source you are viewing.').'</b><br /><br />');
  115:     $r->print('<form name="delete_confirm" action="/adm/source" target="_parent" method="post">
  116:               <input type="hidden" name="filename" value="'.$filename.'" />
  117:               <input type="hidden" name="listname" value="'.$listname.'" />
  118:               <input type="hidden" name="newpath" value="'.$newpath.'" />
  119:               <input type="hidden" name="action" value="delete_confirm" />
  120:               <input type="submit" value="Delete" />
  121:               </form>');
  122:     return;
  123: }
  124: 
  125: sub delete_copy_file {
  126:     my ($r, $newpath, $filename, $path_to_new_file, $type) = @_;
  127:     if ($type eq '1') {
  128:         $r->print('<p><span class="LC_warning">'
  129:                  .&mt('Cannot delete non-obsolete published file.')
  130:                  .'</span><br />'
  131:                  .&mt('Please use the code view in previous window to use shared code.')
  132:                  .'<br /><br />');
  133:         $r->print('<form name="delete_done" action="/adm/source" target="_parent" method="post">'
  134:                  .'<input type="button" value="'.&mt('Close Window').'" name="close"'
  135:                  .' onclick="window.close()" />'
  136:                  .'</form></p>');
  137:         return;
  138:     } else {
  139:         $r->print(&Apache::loncommon::start_page('Copying Source',undef,{'only_body' => 1}));
  140:         if (-e $path_to_new_file) {
  141:             unless (unlink($path_to_new_file)) {
  142:                 $r->print('<p class="LC_error"">'.&mt('Error:').' '.$!.'</p>');
  143:                 return 0;
  144:             }
  145:         } else {
  146:             $r->print('<p class="LC_error">'.&mt('No such file').'</p>');
  147:             return 0;
  148:         }
  149:         &copy_file($r, $newpath, $filename, $path_to_new_file);
  150:         $r->print(&Apache::loncommon::end_page());
  151:         return;
  152:     }
  153: }
  154: 
  155: sub copy_file {
  156:     my ($r, $newpath, $filename, $path_to_new_file) = @_;
  157:     $r->print('<b>'.&mt('Creating directories').'</b>');
  158: 
  159: #Figure out if we are author or co-author
  160:     my ($role,$author_name,$domain)=&copy_author();
  161: 
  162:     my $path = $r->dir_config('lonDocRoot')."/priv/$domain/$author_name/";
  163:     my @directories = split(/\//,$newpath);
  164: 
  165:     foreach my $now_checking (@directories) {
  166:         if($now_checking ne '') {
  167:             $path = $path.'/'.$now_checking;
  168:             if(-e $path) {} #More moving along, isn't recursion fun'
  169: 
  170:             else {
  171:                 unless(mkdir($path, 02770)) {
  172:                     $r->print('<p class="LC_error">'.&mt('Error:').' '.$!.'</p>');
  173:                     return 0;
  174:                 }
  175:                 unless(chmod(02770, ($path))) {
  176:                     $r->print('<p class="LC_error"> '.&mt('Error:').' '.$!.'</p>');
  177:                     return 0;
  178:                 }
  179:             }
  180:         } else { } #Just move along
  181: 
  182:     }
  183:     $r->print('<br /><b>'.&mt('Copying File').'</b>');
  184:     my $problem_filename = $Apache::lonnet::perlvar{'lonDocRoot'}.$filename;
  185:     my $file_output = &includemeta(&Apache::lonnet::getfile($problem_filename),$filename);
  186:     my $fs=Apache::File->new(">$path_to_new_file");
  187:     if (defined($fs)) {
  188:         print $fs $file_output;
  189:     }
  190:     $r->print("<br /><br />");
  191:     $r->print('<form name="copied_file" action="/adm/source" target="_parent" method="post">'
  192:               .'<input type="button" value="'
  193:               .&mt('Close Window').'" name="close" onclick="window.close()" />'
  194:               .'</form>');
  195:     #Some 1.3'ish feature is to include the derivative feature, will go here..'
  196:     return;
  197: }
  198: 
  199: sub print_item {
  200:     my ($r,$filename,$listname,$context) = @_;
  201:     my $file_output;
  202:     if ($context eq 'view') {
  203:         $file_output =
  204:             &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$filename);
  205:     } else {
  206:         $file_output =
  207:             &includemeta(&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$filename),
  208:                                                   $filename);
  209:     }
  210:     $r->print(&Apache::loncommon::start_page('View Source Code',undef,
  211:                                              {'only_body' => 1}));
  212:     if ($file_output ne '') {
  213:         my $access_to_cstr;
  214:         my $lonhost = $r->dir_config('lonHostID');
  215:         if ($context eq 'view') {
  216:             $r->print('<form name="view" action="" target="_parent" method="post"><span class="LC_info">'.
  217:                       &mt('Source code is displayed below.').
  218:                       '</span>'.('&nbsp;' x4).'<input type="button" name="close" onclick="window.close();"'.
  219:                       ' value="'.&mt('Close Window').'" /></form><hr />');
  220:         } elsif (&Apache::lonnet::is_library($lonhost)) {
  221:             my @possdoms = &Apache::lonnet::current_machine_domains();
  222:             foreach my $dom (@possdoms) {
  223:                 if ($env{"user.role.au./$dom/"}) {
  224:                     $access_to_cstr = 1;
  225:                     last;  
  226:                 }
  227:             }
  228:             unless ($access_to_cstr) {
  229:                 foreach my $key (keys(%env)) {
  230:                     if ($key =~ m{^\Quser.role.ca./\E($match_domain)/}) {
  231:                         my $adom = $1;
  232:                         if (grep(/^\Q$adom\E$/,@possdoms)) {
  233:                             $access_to_cstr = 1;
  234:                             last;
  235:                         }
  236:                     }
  237:                 }
  238:             }
  239:             if ($access_to_cstr) {
  240:                 $r->print('
  241:              <form name="copy" action="/adm/source" target="_parent" method="post">
  242:               <input type="button" value="'.&mt('Close Window').'" name="close" onclick="window.close();" />
  243:               <input type="hidden" name="filename" value="'.$filename.'" />
  244:               <input type="hidden" name="listname" value="'.$listname.'" />
  245:               <input type="hidden" name="action" value="stage2" />
  246:               <input type="submit" value="'.&mt('Copy to Authoring Space').'" />
  247:              </form><hr />
  248:                 ');
  249:             } else {
  250:                 $r->print('<p><span class="LC_info">'.
  251:                           &mt('Source code is displayed, but you can not copy to Authoring Space, as you do not have an author or co-author role on this server.').
  252:                           '</span></p><a href="javascript:window.close();">'.&mt('Close Window').
  253:                           '</a><br /><hr />'
  254:                          );
  255:             }
  256:         } else {
  257:             $r->print('<p><span class="LC_info">'.
  258:                       &mt('Source code is displayed, but you can not copy to Authoring Space on this server.').
  259:                           '</span></p><a href="javascript:window.close();">'.&mt('Close Window').
  260:                           '</a><br /><hr />'
  261:                      );
  262: 
  263:         }
  264:         my $count=0;
  265:         my $maxlength=-1;
  266:         foreach (split ("\n", $file_output)) {
  267:             $count+=int(length($_)/79);
  268:             $count++;
  269:             if (length($_) > $maxlength) {
  270:                 $maxlength = length($_);
  271:             }
  272:         }
  273:         my $rows = $count;
  274:         my $cols = $maxlength;
  275:         $r->print('<form name="showsrc" action="" method="post" onsubmit="return false">'."\n".
  276:                   '<textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.
  277:                   &HTML::Entities::encode($file_output,'<>&"').'</textarea></form>');
  278:     } else {
  279:         $r->print('<p class="LC_warning">'.
  280:                   &mt('Unable to retrieve file contents.').
  281:                   '</p><a href="javascript:window.close();">'.&mt('Close Window').'</a>'
  282:                  );
  283:     }
  284:     $r->print(&Apache::loncommon::end_page());
  285:     return;
  286: }
  287: 
  288: sub includemeta {
  289:     my ($file_output,$orgfilename)=@_;
  290:     my $escfilename=&escape($orgfilename);
  291:     my $copytime=time;
  292:     if ($file_output=~/\<meta\s*name\=\"isbasedonres\"/i) {
  293: 	$file_output=~s/(\<meta\s*name\=\"isbasedonres\"\s*content\=\"[^\"]*)\"/$1\,\Q$escfilename\E\"/i;
  294:     } else {
  295: 	$file_output=~s/(\<(?:html|problem)[^\>]*\>)/$1\n\<meta name=\"isbasedonres\" content=\"\Q$escfilename\E\" \/\>/i;
  296:     }
  297:     if ($file_output=~/\<meta\s*name\=\"isbasedontime\"/i) {
  298: 	$file_output=~s/(\<meta\s*name\=\"isbasedontime\"\s*content\=\"[^\"]*)\"/$1\,\Q$copytime\E\"/i;
  299:     } else {
  300: 	$file_output=~s/(\<(?:html|problem)[^\>]*\>)/$1\n\<meta name=\"isbasedontime\" content=\"\Q$copytime\E\" \/\>/i;
  301:     }
  302:     if ($file_output eq '-1') {
  303:         return;
  304:     } else {
  305:         return $file_output;
  306:     }
  307: }
  308: 
  309: sub get_path_to_newfile {
  310:     my ($r,$newpath,$listname) = @_;
  311: 
  312:     #Figure out if we are author or co-author
  313:     my ($role,$author_name,$domain) = &copy_author();
  314: 
  315:     # Construct path to copy and filter out any possibly nasty stuff
  316:     my $path = $r->dir_config('lonDocRoot')."/priv/$domain/$author_name/";
  317:     my $path_to_new_file = $path."$newpath/$listname";
  318:     $path_to_new_file=~s/\.\.//g;
  319:     $path_to_new_file=~s/\~//g;
  320:     $path_to_new_file=~s/\/+/\//g;
  321: 
  322:     #Just checking again for access as we want to make sure that it is really ok
  323:     #now that we have the real path
  324: 
  325:     my ($uname,$udom)= &Apache::lonnet::constructaccess($path_to_new_file);
  326: 
  327:     if (!$uname || !$udom) {
  328:         $r->print(&Apache::loncommon::start_page('Not Allowed',undef,{'only_body' => 1}));
  329:         $r->print(&mt('Not allowed to create file [_1]', $path_to_new_file));
  330:         $r->print(&Apache::loncommon::end_page());
  331:         if (wantarray) {
  332:             return();
  333:         } else {
  334:             return;
  335:         }
  336:     }
  337:     if (wantarray) {
  338:         return ($path_to_new_file,$uname,$udom);
  339:     } else {
  340:         return $path_to_new_file;
  341:     }
  342: }
  343: 
  344: sub handler {
  345:     my $r=shift;
  346:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  347:                                             ['filename','listname','viewonly']);
  348:     my $filename = $env{'form.filename'};
  349:     my $shownfilename = $filename;
  350:     $shownfilename =~ s/(`)/'/g;
  351:     $shownfilename =~ s/\$/\(\$\)/g;
  352:     my $listname = $env{'form.listname'};
  353:     my $viewonly = $env{'form.viewonly'};
  354: 
  355:     if ($viewonly) {
  356:         my $canview;
  357:         $filename =~ s/\.\.//g;
  358:         $filename =~ s/\~//g;
  359:         $filename =~ s/\/+/\//g;
  360:         if (($env{'request.course.id'}) && (&Apache::lonnet::is_on_map($filename))) {
  361:             if ((&Apache::lonnet::metadata(&Apache::lonenc::check_decrypt($filename)) eq 'open') &&
  362:                 (&Apache::lonnet::allowed('cre','/'))) {
  363:                 $canview = 1;
  364:             } elsif (&Apache::lonnet::allowed('vxc',$env{'request.course.id'})) {
  365:                 my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
  366:                 &Apache::lonenc::check_decrypt(\$filename);
  367:                 if (($env{'request.role.domain'} eq $cdom) && ($filename =~ /$LONCAPA::assess_re/)) {
  368:                     my ($auname) = ($filename =~ m{^\Q/res/$cdom/\E($match_username)/});
  369:                     if (($auname ne '') && ($env{'request.course.adhocsrcaccess'} ne '') &&
  370:                         (grep(/^\Q$auname\E$/,split(/,/,$env{'request.course.adhocsrcaccess'})))) {
  371:                         $canview = 1;
  372:                     } elsif ((&Apache::lonnet::metadata($filename) eq 'open') &&
  373:                              ($filename =~ m{^\Q/res/$cdom/}) &&
  374:                              (&Apache::lonnet::allowed('bre','/'))) {
  375:                         $canview = 1;
  376:                     }
  377:                 }
  378:             }
  379:         }
  380:         unless ($canview) {
  381:             $env{'user.error.msg'}="$shownfilename:cre:1:1:Source code not available";
  382:             return HTTP_NOT_ACCEPTABLE;
  383:         }
  384:     } elsif (&Apache::lonnet::metadata($filename,'sourceavail') ne 'open') {
  385:         $env{'user.error.msg'}="$shownfilename:cre:1:1:Source code not available";
  386:         return HTTP_NOT_ACCEPTABLE;
  387:     }
  388:     unless (&Apache::lonnet::allowed('bre',$filename)) {
  389:         $env{'user.error.msg'}="$shownfilename:bre:1:1:Access to resource denied";
  390:         return HTTP_NOT_ACCEPTABLE;
  391:     }
  392:     unless ($viewonly) {
  393:         unless (&Apache::lonnet::allowed('cre','/')) {
  394:             $env{'user.error.msg'}="$shownfilename:cre:1:1:Access to source code denied";
  395:             return HTTP_NOT_ACCEPTABLE;
  396:         }
  397:     }
  398:     my $newpath = $env{'form.newpath'};
  399: 
  400:     &Apache::loncommon::content_type($r,'text/html');
  401:     $r->send_http_header;
  402: 
  403:     if ($viewonly) {
  404:         &print_item($r,$filename,$listname,'view');
  405:     } elsif ($env{'form.action'} eq 'stage2') {
  406:         &stage_2($r,$filename,$listname);
  407:     } elsif($env{'form.action'} eq 'copy_stage') {
  408:         &copy_stage($r,$filename,$listname,$newpath);
  409:     } elsif($env{'form.action'} eq 'delete_confirm') {
  410:         my $path_to_new_file = &get_path_to_newfile($r,$newpath,$listname);
  411:         if ($path_to_new_file) {
  412:             &delete_copy_file($r, $newpath, $filename, $path_to_new_file, '0');
  413:         }
  414:     } else {
  415:         &print_item($r,$filename,$listname);
  416:     }
  417:     return OK;
  418: }
  419: 
  420: 1;
  421: 
  422: