--- loncom/lonnet/perl/lonnet.pm	2014/07/03 14:11:43	1.1264
+++ loncom/lonnet/perl/lonnet.pm	2014/12/01 22:53:00	1.1270
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1264 2014/07/03 14:11:43 raeburn Exp $
+# $Id: lonnet.pm,v 1.1270 2014/12/01 22:53:00 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1652,6 +1652,7 @@ sub dump_dom {
 
 sub get_dom {
     my ($namespace,$storearr,$udom,$uhome)=@_;
+    return if ($udom eq 'public');
     my $items='';
     foreach my $item (@$storearr) {
         $items.=&escape($item).'&';
@@ -1659,6 +1660,7 @@ sub get_dom {
     $items=~s/\&$//;
     if (!$udom) {
         $udom=$env{'user.domain'};
+        return if ($udom eq 'public');
         if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');
         } else {
@@ -4851,7 +4853,7 @@ sub tmprestore {
 # ----------------------------------------------------------------------- Store
 
 sub store {
-    my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
+    my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
     my $home='';
 
     if ($stuname) { $home=&homeserver($stuname,$domain); }
@@ -4881,13 +4883,13 @@ sub store {
     }
     $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
-    return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
+    return reply("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
 }
 
 # -------------------------------------------------------------- Critical Store
 
 sub cstore {
-    my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
+    my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
     my $home='';
 
     if ($stuname) { $home=&homeserver($stuname,$domain); }
@@ -4918,7 +4920,7 @@ sub cstore {
     $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
     return critical
-                ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
+                ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
 }
 
 # --------------------------------------------------------------------- Restore
@@ -5628,18 +5630,17 @@ sub dump {
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
 
-    my $reply;
+    if ($regexp) {
+        $regexp=&escape($regexp);
+    } else {
+        $regexp='.';
+    }
     if (grep { $_ eq $uhome } current_machine_ids()) {
         # user is hosted on this machine
-        $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
+        my $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
                     $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
         return %{unserialize($reply, $escapedkeys)};
     }
-    if ($regexp) {
-	$regexp=&escape($regexp);
-    } else {
-	$regexp='.';
-    }
     my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
@@ -5817,7 +5818,7 @@ sub newput {
 # ---------------------------------------------------------  putstore interface
 
 sub putstore {
-   my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
+   my ($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
@@ -5831,6 +5832,17 @@ sub putstore {
    my $reply =
        &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",
 	      $uhome);
+   if (($tolog) && ($reply eq 'ok')) {
+       my $namevalue='';
+       foreach my $key (keys(%{$storehash})) {
+           $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
+       }
+       $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).
+                     '&host='.&escape($perlvar{'lonHostID'}).
+                     '&version='.$esc_v.
+                     '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
+       &Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
+   }
    if ($reply eq 'unknown_cmd') {
        # gfall back to way things use to be done
        return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
@@ -5989,10 +6001,15 @@ sub get_timebased_id {
         my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
         my $id = time;
         $newid = $id;
+        if ($idtype eq 'addcode') {
+            $newid .= &sixnum_code();
+        }
         my $idtries = 0;
         while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) {
             if ($idtype eq 'concat') {
                 $newid = $id.$idtries;
+            } elsif ($idtype eq 'addcode') {
+                $newid = $newid.&sixnum_code();
             } else {
                 $newid ++;
             }
@@ -6009,6 +6026,7 @@ sub get_timebased_id {
                 $error = 'error saving new item: '.$putresult;
             }
         } else {
+             undef($newid);
              $error = ('error: no unique suffix available for the new item ');
         }
 #  remove lock
@@ -6021,12 +6039,20 @@ sub get_timebased_id {
     return ($newid,$dellock,$error);
 }
 
+sub sixnum_code {
+    my $code;
+    for (0..6) {
+        $code .= int( rand(9) );
+    }
+    return $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') {
@@ -6052,7 +6078,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);
@@ -6061,7 +6087,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})) {
@@ -6085,10 +6111,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) {
@@ -6572,7 +6613,7 @@ sub customaccess {
 # ------------------------------------------------- Check for a user privilege
 
 sub allowed {
-    my ($priv,$uri,$symb,$role)=@_;
+    my ($priv,$uri,$symb,$role,$clientip)=@_;
     my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
@@ -6799,7 +6840,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.
@@ -10856,14 +10897,10 @@ sub deversion {
 
 sub symbread {
     my ($thisfn,$donotrecurse)=@_;
-    my $cache_str;
-    if ($thisfn ne '') {
-        $cache_str='request.symbread.cached.'.$thisfn;
-        if ($env{$cache_str} ne '') {
-            return $env{$cache_str};
-        }
-    } else {
+    my $cache_str='request.symbread.cached.'.$thisfn;
+    if (defined($env{$cache_str})) { return $env{$cache_str}; }
 # no filename provided? try from environment
+    unless ($thisfn) {
         if ($env{'request.symb'}) {
 	    return $env{$cache_str}=&symbclean($env{'request.symb'});
 	}
@@ -12577,7 +12614,7 @@ were new keys. I.E. 1:foo will become 1:
 Calling convention:
 
  my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname);
- &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname);
+ &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$laststore);
 
 For more detailed information, see lonnet specific documentation.
 
@@ -13214,15 +13251,21 @@ homeserver.
 
 =item *
 
-store($storehash,$symb,$namespace,$udom,$uname) : stores hash permanently
-for this url; hashref needs to be given and should be a \%hashname; the
-remaining args aren't required and if they aren't passed or are '' they will
-be derived from the env
+store($storehash,$symb,$namespace,$udom,$uname,$laststore) : stores hash
+permanently for this url; hashref needs to be given and should be a \%hashname;
+the remaining args aren't required and if they aren't passed or are '' they will
+be derived from the env (with the exception of $laststore, which is an 
+optional arg used when a user's submission is stored in grading).
+$laststore is $version=$timestamp, where $version is the most recent version
+number retrieved for the corresponding $symb in the $namespace db file, and
+$timestamp is the timestamp for that transaction (UNIX time).
+$laststore is currently only passed when cstore() is called by 
+structuretags::finalize_storage().
 
 =item *
 
-cstore($storehash,$symb,$namespace,$udom,$uname) : same as store but
-uses critical subroutine
+cstore($storehash,$symb,$namespace,$udom,$uname,$laststore) : same as store
+but uses critical subroutine
 
 =item *
 
@@ -13245,10 +13288,11 @@ $range should be either an integer '100'
 
 =item *
 
-putstore($namespace,$symb,$version,$storehash,$udomain,$uname) :
+putstore($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog) :
 replaces a &store() version of data with a replacement set of data
 for a particular resource in a namespace passed in the $storehash hash 
-reference
+reference. If $tolog is true, the transaction is logged in the courselog
+with an action=PUTSTORE.
 
 =item *