[LON-CAPA-cvs] cvs: loncom /homework essayresponse.pm externalresponse.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Thu Dec 4 10:41:36 EST 2014
raeburn Thu Dec 4 15:41:36 2014 EDT
Modified files:
/loncom/homework essayresponse.pm externalresponse.pm
/loncom/lonnet/perl lonnet.pm
Log:
Bug 6690
- Set IP based-access for files submitted to externalresponse. If url
attribute in externalresponse tag begins http://machine.somewhere.toplevel
(or https:// etc.) access will be permitted from IP address which resolves
to machine.somewhere.toplevel
Work in progress
-------------- next part --------------
Index: loncom/homework/essayresponse.pm
diff -u loncom/homework/essayresponse.pm:1.118 loncom/homework/essayresponse.pm:1.119
--- loncom/homework/essayresponse.pm:1.118 Tue Jan 21 14:38:55 2014
+++ loncom/homework/essayresponse.pm Thu Dec 4 15:41:30 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# essay (ungraded) style responses
#
-# $Id: essayresponse.pm,v 1.118 2014/01/21 14:38:55 kruse Exp $
+# $Id: essayresponse.pm,v 1.119 2014/12/04 15:41:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -286,7 +286,7 @@
}
sub file_submission {
- my ($part,$id,$award,$uploadedflag,$totalsize,$deletions)=@_;
+ my ($part,$id,$award,$uploadedflag,$totalsize,$deletions,$context,$info)=@_;
my $files;
my $jspart=$part;
$jspart=~s/\./_/g;
@@ -513,6 +513,16 @@
$$uploadedflag=1;
}
}
+ if ($context eq 'externalresponse') {
+ my @todelete = keys(%port_delete);
+ if (@tolock || @todelete) {
+ if (ref($info) eq 'HASH') {
+ if ($info->{'ip'}) {
+ &Apache::lonnet::automated_portfile_access('ip',\@tolock,\@todelete,$info);
+ }
+ }
+ }
+ }
&Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]);
&Apache::lonnet::mark_as_readonly($udom,$uname,[@tolock],[$symb,$crsid]);
&Apache::lonnet::clear_selected_files($uname);
Index: loncom/homework/externalresponse.pm
diff -u loncom/homework/externalresponse.pm:1.26 loncom/homework/externalresponse.pm:1.27
--- loncom/homework/externalresponse.pm:1.26 Mon Jan 13 15:29:10 2014
+++ loncom/homework/externalresponse.pm Thu Dec 4 15:41:30 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# external style responses
#
-# $Id: externalresponse.pm,v 1.26 2014/01/13 15:29:10 bisitz Exp $
+# $Id: externalresponse.pm,v 1.27 2014/12/04 15:41:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -211,7 +211,22 @@
}
my $uploadedflag=0;
my $totalsize=0;
- &Apache::essayresponse::file_submission($part,$id,\$award,\$uploadedflag,\$totalsize,\@deletions);
+ my %info;
+ my $url = &Apache::lonxml::get_param('url',$parstack,$safeeval);
+ if ($url =~ m{^https?://([^/]+)/}) {
+ use Socket;
+ my $ip = gethostbyname($1);
+ if (length($ip) eq 4) {
+ $info{'ip'} = inet_ntoa($ip);
+ }
+ } elsif ($url =~ m{^/}) {
+ my $ip = &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'});
+ if ($ip =~ /^[\d\.]+$/) {
+ $info{'ip'} = $ip;
+ }
+ }
+ &Apache::essayresponse::file_submission($part,$id,\$award,\$uploadedflag,\$totalsize,
+ \@deletions,'externalresponse',\%info);
$Apache::lonhomework::results{"resource.$part.$id.submission"}=$response;
$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award;
my %previous=&Apache::response::check_for_previous($response,$part,$id);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1270 loncom/lonnet/perl/lonnet.pm:1.1271
--- loncom/lonnet/perl/lonnet.pm:1.1270 Mon Dec 1 22:53:00 2014
+++ loncom/lonnet/perl/lonnet.pm Thu Dec 4 15:41:36 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1270 2014/12/01 22:53:00 raeburn Exp $
+# $Id: lonnet.pm,v 1.1271 2014/12/04 15:41:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -9299,49 +9299,130 @@
}
sub make_public_indefinitely {
- my ($requrl) = @_;
+ my (@requrl) = @_;
+ return &automated_portfile_access('public',\@requrl);
+}
+
+sub automated_portfile_access {
+ my ($accesstype,$addsref,$delsref,$info) = @_;
+ return unless (($accesstype eq 'public') || ($accesstype eq 'ip'));
+ my %urls;
+ if (ref($addsref) eq 'ARRAY') {
+ foreach my $requrl (@{$addsref}) {
+ if (&is_portfolio_url($requrl)) {
+ unless (exists($urls{$requrl})) {
+ $urls{$requrl} = 'add';
+ }
+ }
+ }
+ }
+ if (ref($delsref) eq 'ARRAY') {
+ foreach my $requrl (@{$delsref}) {
+ if (&is_portfolio_url($requrl)) {
+ unless (exists($urls{$requrl})) {
+ $urls{$requrl} = 'delete';
+ }
+ }
+ }
+ }
+ unless (keys(%urls)) {
+ return 'invalid';
+ }
+ my $ip;
+ if ($accesstype eq 'ip') {
+ if (ref($info) eq 'HASH') {
+ if ($info->{'ip'} ne '') {
+ $ip = $info->{'ip'};
+ }
+ }
+ if ($ip eq '') {
+ return 'invalid';
+ }
+ }
+ my $errors;
my $now = time;
- my $action = 'activate';
- my $aclnum = 0;
- if (&is_portfolio_url($requrl)) {
+ my %current_perms;
+ foreach my $requrl (sort(keys(%urls))) {
+ my $action;
+ if ($urls{$requrl} eq 'add') {
+ $action = 'activate';
+ } else {
+ $action = 'none';
+ }
+ my $aclnum = 0;
my (undef,$udom,$unum,$file_name,$group) =
&parse_portfolio_url($requrl);
- my $current_perms = &get_portfile_permissions($udom,$unum);
- my %access_controls = &get_access_controls($current_perms,
+ unless (exists($current_perms{$unum.':'.$udom})) {
+ $current_perms{$unum.':'.$udom} = &get_portfile_permissions($udom,$unum);
+ }
+ my %access_controls = &get_access_controls($current_perms{$unum.':'.$udom},
$group,$file_name);
foreach my $key (keys(%{$access_controls{$file_name}})) {
my ($num,$scope,$end,$start) =
($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
- if ($scope eq 'public') {
- if ($start <= $now && $end == 0) {
- $action = 'none';
- } else {
+ if ($scope eq $accesstype) {
+ if (($start <= $now) && ($end == 0)) {
+ if ($accesstype eq 'ip') {
+ if (ref($access_controls{$file_name}{$key}) eq 'HASH') {
+ if (ref($access_controls{$file_name}{$key}{'ip'}) eq 'ARRAY') {
+ if (grep(/^\Q$ip\E$/,@{$access_controls{$file_name}{$key}{'ip'}})) {
+ if ($urls{$requrl} eq 'add') {
+ $action = 'none';
+ last;
+ } else {
+ $action = 'delete';
+ $aclnum = $num;
+ last;
+ }
+ }
+ }
+ }
+ } elsif ($accesstype eq 'public') {
+ if ($urls{$requrl} eq 'add') {
+ $action = 'none';
+ last;
+ } else {
+ $action = 'delete';
+ $aclnum = $num;
+ last;
+ }
+ }
+ } elsif ($accesstype eq 'public') {
$action = 'update';
$aclnum = $num;
+ last;
}
- last;
}
}
if ($action eq 'none') {
- return 'ok';
+ next;
} else {
my %changes;
my $newend = 0;
my $newstart = $now;
- my $newkey = $aclnum.':public_'.$newend.'_'.$newstart;
+ my $newkey = $aclnum.':'.$accesstype.'_'.$newend.'_'.$newstart;
$changes{$action}{$newkey} = {
- type => 'public',
+ type => $accesstype,
time => {
start => $newstart,
end => $newend,
},
};
+ if ($accesstype eq 'ip') {
+ $changes{$action}{$newkey}{'ip'} = [$ip];
+ }
my ($outcome,$deloutcome,$new_values,$translation) =
&modify_access_controls($file_name,\%changes,$udom,$unum);
- return $outcome;
+ unless ($outcome eq 'ok') {
+ $errors .= $outcome.' ';
+ }
}
+ }
+ if ($errors) {
+ $errors =~ s/\s$//;
+ return $errors;
} else {
- return 'invalid';
+ return 'ok';
}
}
More information about the LON-CAPA-cvs
mailing list