--- loncom/lonnet/perl/lonnet.pm	2014/11/24 02:36:21	1.1269
+++ loncom/lonnet/perl/lonnet.pm	2015/04/13 16:30:32	1.1281
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1269 2014/11/24 02:36:21 raeburn Exp $
+# $Id: lonnet.pm,v 1.1281 2015/04/13 16:30:32 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -849,10 +849,8 @@ sub spareserver {
     if (ref($spareshash) eq 'HASH') {
         if (ref($spareshash->{'primary'}) eq 'ARRAY') {
             foreach my $try_server (@{ $spareshash->{'primary'} }) {
-                if ($uint_dom) {
-                    next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
-                                                 $try_server));
-                }
+                next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+                                             $try_server));
 	        ($spare_server, $lowest_load) =
 	            &compare_server_load($try_server, $spare_server, $lowest_load);
             }
@@ -863,10 +861,8 @@ sub spareserver {
         if (!$found_server) {
             if (ref($spareshash->{'default'}) eq 'ARRAY') { 
 	        foreach my $try_server (@{ $spareshash->{'default'} }) {
-                    if ($uint_dom) {
-                        next unless (&spare_can_host($udom,$uint_dom,
-                                                     $remotesessions,$try_server));
-                    }
+                    next unless (&spare_can_host($udom,$uint_dom,
+                                                 $remotesessions,$try_server));
 	            ($spare_server, $lowest_load) =
 		        &compare_server_load($try_server, $spare_server, $lowest_load);
                 }
@@ -1178,19 +1174,27 @@ sub can_host_session {
 sub spare_can_host {
     my ($udom,$uint_dom,$remotesessions,$try_server)=@_;
     my $canhost=1;
-    my @intdoms;
-    my $internet_names = &Apache::lonnet::get_internet_names($try_server);
-    if (ref($internet_names) eq 'ARRAY') {
-        @intdoms = @{$internet_names};
-    }
-    unless (grep(/^\Q$uint_dom\E$/,@intdoms)) {
-        my $serverhomeID = &Apache::lonnet::get_server_homeID($try_server);
-        my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
-        my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
-        my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server);
-        $canhost = &can_host_session($udom,$try_server,$remoterev,
-                                     $remotesessions,
-                                     $defdomdefaults{'hostedsessions'});
+    my $try_server_hostname = &hostname($try_server);
+    my $serverhomeID = &get_server_homeID($try_server_hostname);
+    my $serverhomedom = &host_domain($serverhomeID);
+    my %defdomdefaults = &get_domain_defaults($serverhomedom);
+    if (ref($defdomdefaults{'offloadnow'}) eq 'HASH') {
+        if ($defdomdefaults{'offloadnow'}{$try_server}) {
+            $canhost = 0;
+        }
+    }
+    if (($canhost) && ($uint_dom)) {
+        my @intdoms;
+        my $internet_names = &get_internet_names($try_server);
+        if (ref($internet_names) eq 'ARRAY') {
+            @intdoms = @{$internet_names};
+        }
+        unless (grep(/^\Q$uint_dom\E$/,@intdoms)) {
+            my $remoterev = &get_server_loncaparev(undef,$try_server);
+            $canhost = &can_host_session($udom,$try_server,$remoterev,
+                                         $remotesessions,
+                                         $defdomdefaults{'hostedsessions'});
+        }
     }
     return $canhost;
 }
@@ -2076,6 +2080,11 @@ sub get_domain_defaults {
     }
     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
         $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
+        $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'};
+        $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'};
+        if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
+            $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
+        }
         foreach my $type (@coursetypes) {
             if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
                 unless ($type eq 'community') {
@@ -2085,6 +2094,12 @@ sub get_domain_defaults {
             if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                 $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
             }
+            if ($domdefaults{'postsubmit'} eq 'on') {
+                if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
+                    $domdefaults{$type.'postsubtimeout'} = 
+                        $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; 
+                }
+            }
         }
     }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {
@@ -2094,6 +2109,9 @@ sub get_domain_defaults {
         if (ref($domconfig{'usersessions'}{'hosted'}) eq 'HASH') {
             $domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'};
         }
+        if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
+            $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};
+        }
     }
     if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
         if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
@@ -2723,7 +2741,12 @@ sub ssi {
     &Apache::lonenc::check_encrypt(\$fn);
     if (%form) {
       $request=new HTTP::Request('POST',&absolute_url().$fn);
-      $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form)));
+      $request->content(join('&',map { 
+            my $name = escape($_);
+            "$name=" . ( ref($form{$_}) eq 'ARRAY' 
+            ? join("&$name=", map {escape($_) } @{$form{$_}}) 
+            : &escape($form{$_}) );    
+        } keys(%form)));
     } else {
       $request=new HTTP::Request('GET',&absolute_url().$fn);
     }
@@ -5100,7 +5123,7 @@ sub privileged {
         my %rolesdump = &dump("roles", $domain, $username) or return 0;
         my $now = time;
 
-        for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) {
+        for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys(%rolesdump)}) {
             my ($trole, $tend, $tstart) = split(/_/, $role);
             if (grep(/^\Q$trole\E$/,@{$roles})) {
                 return 1 unless ($tend && $tend < $now) 
@@ -5189,7 +5212,7 @@ sub rolesinit {
     my %allroles=();
     my %allgroups=();
 
-    for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) {
+    for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
         my $role = $rolesdump{$area};
         $area =~ s/\_\w\w$//;
 
@@ -6035,6 +6058,9 @@ sub get_timebased_id {
     } else {
         $error = "error: could not obtain lockfile\n";
         $dellock = 'ok';
+        if (($prefix eq 'paste') && ($namespace eq 'courseeditor') && ($keyid eq 'num')) {
+            $dellock = 'nolock';
+        }
     }
     return ($newid,$dellock,$error);
 }
@@ -6050,9 +6076,9 @@ sub sixnum_code {
 # -------------------------------------------------- portfolio access checking
 
 sub portfolio_access {
-    my ($requrl) = @_;
+    my ($requrl,$clientip) = @_;
     my (undef,$udom,$unum,$file_name,$group) = &parse_portfolio_url($requrl);
-    my $result = &get_portfolio_access($udom,$unum,$file_name,$group);
+    my $result = &get_portfolio_access($udom,$unum,$file_name,$group,$clientip);
     if ($result) {
         my %setters;
         if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
@@ -6078,7 +6104,7 @@ sub portfolio_access {
 }
 
 sub get_portfolio_access {
-    my ($udom,$unum,$file_name,$group,$access_hash) = @_;
+    my ($udom,$unum,$file_name,$group,$clientip,$access_hash) = @_;
 
     if (!ref($access_hash)) {
 	my $current_perms = &get_portfile_permissions($udom,$unum);
@@ -6087,7 +6113,7 @@ sub get_portfolio_access {
 	$access_hash = $access_controls{$file_name};
     }
 
-    my ($public,$guest,@domains,@users,@courses,@groups);
+    my ($public,$guest,@domains,@users,@courses,@groups,@ips);
     my $now = time;
     if (ref($access_hash) eq 'HASH') {
         foreach my $key (keys(%{$access_hash})) {
@@ -6111,10 +6137,25 @@ sub get_portfolio_access {
                 push(@courses,$key);
             } elsif ($scope eq 'group') {
                 push(@groups,$key);
+            } elsif ($scope eq 'ip') {
+                push(@ips,$key);
             }
         }
         if ($public) {
             return 'ok';
+        } elsif (@ips > 0) {
+            my $allowed;
+            foreach my $ipkey (@ips) {
+                if (ref($access_hash->{$ipkey}{'ip'}) eq 'ARRAY') {
+                    if (&Apache::loncommon::check_ip_acc(join(',',@{$access_hash->{$ipkey}{'ip'}}),$clientip)) {
+                        $allowed = 1;
+                        last; 
+                    }
+                }
+            }
+            if ($allowed) {
+                return 'ok';
+            }
         }
         if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
             if ($guest) {
@@ -6598,7 +6639,7 @@ sub customaccess {
 # ------------------------------------------------- Check for a user privilege
 
 sub allowed {
-    my ($priv,$uri,$symb,$role)=@_;
+    my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_;
     my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
@@ -6793,11 +6834,16 @@ sub allowed {
         if ($match) {
             if ($env{'user.priv.'.$env{'request.role'}.'./'}
                   =~/\Q$priv\E\&([^\:]*)/) {
-                my @blockers = &has_comm_blocking($priv,$symb,$uri);
-                if (@blockers > 0) {
-                    $thisallowed = 'B';
+                my $value = $1;
+                if ($noblockcheck) {
+                    $thisallowed.=$value;
                 } else {
-                    $thisallowed.=$1;
+                    my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                    if (@blockers > 0) {
+                        $thisallowed = 'B';
+                    } else {
+                        $thisallowed.=$value;
+                    }
                 }
             }
         } else {
@@ -6809,11 +6855,15 @@ sub allowed {
                     $refuri=&declutter($refuri);
                     my ($match) = &is_on_map($refuri);
                     if ($match) {
-                        my @blockers = &has_comm_blocking($priv,$symb,$refuri);
-                        if (@blockers > 0) {
-                            $thisallowed = 'B';
-                        } else {
+                        if ($noblockcheck) {
                             $thisallowed='F';
+                        } else {
+                            my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                            if (@blockers > 0) {
+                                $thisallowed = 'B';
+                            } else {
+                                $thisallowed='F';
+                            }
                         }
                     }
                 }
@@ -6825,7 +6875,7 @@ sub allowed {
 	&& $thisallowed ne 'F' 
 	&& $thisallowed ne '2'
 	&& &is_portfolio_url($uri)) {
-	$thisallowed = &portfolio_access($uri);
+	$thisallowed = &portfolio_access($uri,$clientip);
     }
 
 # Full access at system, domain or course-wide level? Exit.
@@ -6868,11 +6918,15 @@ sub allowed {
                =~/\Q$priv\E\&([^\:]*)/) {
                my $value = $1;
                if ($priv eq 'bre') {
-                   my @blockers = &has_comm_blocking($priv,$symb,$uri);
-                   if (@blockers > 0) {
-                       $thisallowed = 'B';
-                   } else {
+                   if ($noblockcheck) {
                        $thisallowed.=$value;
+                   } else {
+                       my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                       if (@blockers > 0) {
+                           $thisallowed = 'B';
+                       } else {
+                           $thisallowed.=$value;
+                       }
                    }
                } else {
                    $thisallowed.=$value;
@@ -6906,11 +6960,15 @@ sub allowed {
                   =~/\Q$priv\E\&([^\:]*)/) {
                   my $value = $1;
                   if ($priv eq 'bre') {
-                      my @blockers = &has_comm_blocking($priv,$symb,$refuri);
-                      if (@blockers > 0) {
-                          $thisallowed = 'B';
-                      } else {
+                      if ($noblockcheck) {
                           $thisallowed.=$value;
+                      } else {
+                          my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                          if (@blockers > 0) {
+                              $thisallowed = 'B';
+                          } else {
+                              $thisallowed.=$value;
+                          }
                       }
                   } else {
                       $thisallowed.=$value;
@@ -7230,13 +7288,15 @@ sub has_comm_blocking {
                                 if ($mapsymb) {
                                     if (ref($navmap)) {
                                         my $mapres = $navmap->getBySymb($mapsymb);
-                                        @to_test = $mapres->retrieveResources($mapres,undef,0,1);
+                                        @to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);
                                         foreach my $res (@to_test) {
                                             my $symb = $res->symb();
                                             next if ($symb eq $mapsymb);
                                             if ($symb ne '') {
                                                 @interval=&EXT("resource.0.interval",$symb);
-                                                last;
+                                                if ($interval[1] eq 'map') {
+                                                    last;
+                                                }
                                             }
                                         }
                                     }
@@ -9140,6 +9200,90 @@ sub files_not_in_path {
     return (@return_files);
 }
 
+#------------------------------Submitted/Handedback Portfolio Files Versioning
+ 
+sub portfiles_versioning {
+    my ($symb,$domain,$stu_name,$portfiles,$versioned_portfiles) = @_;
+    my $portfolio_root = '/userfiles/portfolio';
+    return unless ((ref($portfiles) eq 'ARRAY') && (ref($versioned_portfiles) eq 'ARRAY'));
+    foreach my $file (@{$portfiles}) {
+        &unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
+        my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
+        my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file);
+        my $getpropath = 1;
+        my ($dir_list,$listerror) = &dirlist($portfolio_root.$directory,$domain,
+                                             $stu_name,$getpropath);
+        my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
+        my $new_answer = 
+            &version_selected_portfile($domain,$stu_name,$directory,$answer_file,$version);
+        if ($new_answer ne 'problem getting file') {
+            push(@{$versioned_portfiles}, $directory.$new_answer);
+            &mark_as_readonly($domain,$stu_name,[$directory.$new_answer],
+                              [$symb,$env{'request.course.id'},'graded']);
+        }
+    }
+}
+
+sub get_next_version {
+    my ($answer_name, $answer_ext, $dir_list) = @_;
+    my $version;
+    if (ref($dir_list) eq 'ARRAY') {
+        foreach my $row (@{$dir_list}) {
+            my ($file) = split(/\&/,$row,2);
+            my ($file_name,$file_version,$file_ext) =
+                &file_name_version_ext($file);
+            if (($file_name eq $answer_name) &&
+                ($file_ext eq $answer_ext)) {
+                     # gets here if filename and extension match,
+                     # regardless of version
+                if ($file_version ne '') {
+                    # a versioned file is found  so save it for later
+                    if ($file_version > $version) {
+                        $version = $file_version;
+                    }
+                }
+            }
+        }
+    }
+    $version ++;
+    return($version);
+}
+
+sub version_selected_portfile {
+    my ($domain,$stu_name,$directory,$file_name,$version) = @_;
+    my ($answer_name,$answer_ver,$answer_ext) =
+        &file_name_version_ext($file_name);
+    my $new_answer;
+    $env{'form.copy'} =
+        &getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name");
+    if($env{'form.copy'} eq '-1') {
+        $new_answer = 'problem getting file';
+    } else {
+        $new_answer = $answer_name.'.'.$version.'.'.$answer_ext;
+        my $copy_result = 
+            &finishuserfileupload($stu_name,$domain,'copy',
+                                  '/portfolio'.$directory.$new_answer);
+    }
+    undef($env{'form.copy'});
+    return ($new_answer);
+}
+
+sub file_name_version_ext {
+    my ($file)=@_;
+    my @file_parts = split(/\./, $file);
+    my ($name,$version,$ext);
+    if (@file_parts > 1) {
+        $ext=pop(@file_parts);
+        if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) {
+            $version=pop(@file_parts);
+        }
+        $name=join('.',@file_parts);
+    } else {
+        $name=join('.',@file_parts);
+    }
+    return($name,$version,$ext);
+}
+
 #----------------------------------------------Get portfolio file permissions
 
 sub get_portfile_permissions {
@@ -9284,49 +9428,132 @@ sub modify_access_controls {
 }
 
 sub make_public_indefinitely {
-    my ($requrl) = @_;
+    my (@requrl) = @_;
+    return &automated_portfile_access('public',\@requrl);
+}
+
+sub automated_portfile_access {
+    my ($accesstype,$addsref,$delsref,$info) = @_;
+    unless (($accesstype eq 'public') || ($accesstype eq 'ip')) {
+        return 'invalid';
+    }
+    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';
     }
 }
 
@@ -10510,7 +10737,7 @@ sub metadata {
 
 	$metaentry{':keys'} = join(',',keys(%metathesekeys));
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
-	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
+	$metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys));
 	&do_cache_new('meta',$uri,\%metaentry,$cachetime);
 # this is the end of "was not already recently cached
     }
@@ -12735,13 +12962,29 @@ escaped strings of the action recorded i
 
 =item *
 
-allowed($priv,$uri,$symb,$role) : check for a user privilege; returns codes for allowed actions
+allowed($priv,$uri,$symb,$role,$clientip,$noblockcheck) : check for a user privilege; 
+returns codes for allowed actions
+
+The first argument is required, all others are optional.
+
+$priv is the privilege being checked.
+$uri contains additional information about what is being checked for access (e.g.,
+URL, course ID etc.). 
+$symb is the unique resource instance identifier in a course; if needed,
+but not provided, it will be retrieved via a call to &symbread(). 
+$role is the role for which a priv is being checked (only used if priv is evb). 
+$clientip is the user's IP address (only used when checking for access to portfolio 
+files).
+$noblockcheck, if true, skips calls to &has_comm_blocking() for the bre priv. This 
+prevents recursive calls to &allowed.  
+
  F: full access
  U,I,K: authentication modes (cxx only)
  '': forbidden
  1: user needs to choose course
  2: browse allowed
  A: passphrase authentication needed
+ B: access temporarily blocked because of a blocking event in a course.
 
 =item *