--- loncom/interface/lonsource.pm 2005/04/07 04:46:36 1.10 +++ loncom/interface/lonsource.pm 2017/09/29 19:18:10 1.37 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA -# Souce Code handler +# Source Code handler # -# $Id: lonsource.pm,v 1.10 2005/04/07 04:46:36 albertel Exp $ +# $Id: lonsource.pm,v 1.37 2017/09/29 19:18:10 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,126 +31,137 @@ package Apache::lonsource; use strict; -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); 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; +use LONCAPA qw(:DEFAULT :match); sub make_link { my ($filename, $listname) = @_; - my $sourcelink = "http://".$ENV{'SERVER_NAME'}. - "/adm/source/?filename=".$filename."&listname=".$listname; - + my $sourcelink = '/adm/source?inhibitmenu=yes&filename='. + &escape(&escape($filename)).'&listname='. + &escape(&escape($listname)); return $sourcelink; } sub stage_2 { - my ($r, $filename, $author, $listname) = @_; - $filename = $filename; - &Apache::loncommon::content_type($r,'text/html'); - my ($uname, $udom) = &Apache::loncacc::constructaccess('/~'.$author.'/',$r->dir_config('lonDefDomain')); - $r->send_http_header; - my $html=&Apache::lonxml::xmlbegin(); - $r->print($html.'
'
+ .&mt('Cannot delete non-obsolete published file.')
+ .'
'
+ .&mt('Please use the code view in previous window to use shared code.')
+ .'
');
+ $r->print('
'.&mt('Error:').' '.$!.'
'); return 0; } } else { - $r->print(''.&mt('No such file').'.
'); + $r->print(''.&mt('No such file').'
'); return 0; } - ©_file($r, $author_name, $newpath, $filename, $path_to_new_file); + ©_file($r, $newpath, $filename, $path_to_new_file); + $r->print(&Apache::loncommon::end_page()); + return; } } sub copy_file { - my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_; - $r->print("Creating directories"); - my $path = '/home/'.$author_name.'/public_html/'; + my ($r, $newpath, $filename, $path_to_new_file) = @_; + $r->print(''.&mt('Creating directories').''); + +#Figure out if we are author or co-author + my ($role,$author_name,$domain)=©_author(); + + my $path = $r->dir_config('lonDocRoot')."/priv/$domain/$author_name/"; my @directories = split(/\//,$newpath); + foreach my $now_checking (@directories) { if($now_checking ne '') { $path = $path.'/'.$now_checking; @@ -158,90 +169,246 @@ sub copy_file { else { unless(mkdir($path, 02770)) { - $r->print(''.&mt('Error').': '.$!.''); + $r->print(''.&mt('Error:').' '.$!.'
'); return 0; } unless(chmod(02770, ($path))) { - $r->print(' '.&mt('Error').': '.$!.''); + $r->print(''.&mt('Error:').' '.$!.'
'); return 0; } } } else { } #Just move along } - $r->print("'. + &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.'). + '
'.&mt('Close Window'). + ''. + &mt('Source code is displayed, but you can not copy to Authoring Space on this server.'). + '
'.&mt('Close Window'). + ''. + &mt('Unable to retrieve file contents.'). + '
'.&mt('Close Window').'' + ); + } + $r->print(&Apache::loncommon::end_page()); + return; } +sub includemeta { + my ($file_output,$orgfilename)=@_; + my $escfilename=&escape($orgfilename); + my $copytime=time; + if ($file_output=~/\]*\>)/$1\n\/i; + } + if ($file_output=~/\]*\>)/$1\n\/i; + } + if ($file_output eq '-1') { + return; + } else { + return $file_output; + } +} + +sub get_path_to_newfile { + my ($r,$newpath,$listname) = @_; + + #Figure out if we are author or co-author + my ($role,$author_name,$domain) = ©_author(); + + # Construct path to copy and filter out any possibly nasty stuff + my $path = $r->dir_config('lonDocRoot')."/priv/$domain/$author_name/"; + my $path_to_new_file = $path."$newpath/$listname"; + $path_to_new_file=~s/\.\.//g; + $path_to_new_file=~s/\~//g; + $path_to_new_file=~s/\/+/\//g; + + #Just checking again for access as we want to make sure that it is really ok + #now that we have the real path + + my ($uname,$udom)= &Apache::lonnet::constructaccess($path_to_new_file); + + if (!$uname || !$udom) { + $r->print(&Apache::loncommon::start_page('Not Allowed',undef,{'only_body' => 1})); + $r->print(&mt('Not allowed to create file [_1]', $path_to_new_file)); + $r->print(&Apache::loncommon::end_page()); + if (wantarray) { + return(); + } else { + return; + } + } + if (wantarray) { + return ($path_to_new_file,$uname,$udom); + } else { + return $path_to_new_file; + } +} sub handler { my $r=shift; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['filename','listname']); - my $filename = $ENV{'form.filename'}; - my $listname = $ENV{'form.listname'}; - my $source = &Apache::lonnet::metadata($filename,'sourceavail'); - if ($source ne 'open') { - $ENV{'user.error.msg'}="$filename:cre:1:1:Source code not available"; + ['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'}; + + if ($viewonly) { + my $canview; + $filename =~ s/\.\.//g; + $filename =~ s/\~//g; + $filename =~ s/\/+/\//g; + if (($env{'request.course.id'}) && (&Apache::lonnet::is_on_map($filename))) { + if ((&Apache::lonnet::metadata(&Apache::lonenc::check_decrypt($filename)) eq 'open') && + (&Apache::lonnet::allowed('cre','/'))) { + $canview = 1; + } elsif (&Apache::lonnet::allowed('vxc',$env{'request.course.id'})) { + 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 (($env{'request.course.adhocsrcaccess'} ne '') && + (grep(/^\Q$auname\E$/,split(/,/,$env{'request.course.adhocsrcaccess'})))) { + $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; - } - if ((!&Apache::lonnet::allowed('cre',$filename)) || - (!&Apache::lonnet::allowed('bre',$filename))) { - $ENV{'user.error.msg'}="$filename:bre:1:1:Access to resource denied"; + } + unless (&Apache::lonnet::allowed('bre',$filename)) { + $env{'user.error.msg'}="$shownfilename:bre:1:1:Access to resource denied"; return HTTP_NOT_ACCEPTABLE; - } - if ($ENV{'form.action'} eq 'stage2') { - my $author = &Apache::lonnet::metadata($filename,'authorspace'); - ($author) = split('@',$author); #strip the domain of the author name - &stage_2($r, $ENV{'form.filename'}, $author, $listname); - } elsif($ENV{'form.action'} eq 'copy_stage') { - ©_stage($r, $filename,$ENV{'form.listname'},$ENV{'form.newpath'}); - } elsif($ENV{'form.action'} eq 'delete_confirm') { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - &delete_copy_file($r, $ENV{'form.author'}, $ENV{'form.newpath'}, $ENV{'form.filename'}, $ENV{'form.path'}, '0'); - } else { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - $r->print(''); - $r->print('