--- loncom/lonnet/perl/lonnet.pm 2014/10/13 15:47:14 1.1172.2.55 +++ loncom/lonnet/perl/lonnet.pm 2015/03/11 04:21:21 1.1172.2.60 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.55 2014/10/13 15:47:14 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.60 2015/03/11 04:21:21 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1647,6 +1647,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).'&'; @@ -1654,6 +1655,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 { @@ -2068,6 +2070,11 @@ sub get_domain_defaults { } } if (ref($domconfig{'coursedefaults'}) eq 'HASH') { + $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') { @@ -2077,6 +2084,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') { @@ -2715,7 +2728,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); } @@ -5175,7 +5193,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) @@ -5264,7 +5282,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$//; @@ -5891,7 +5909,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); @@ -5905,6 +5923,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, @@ -6063,10 +6092,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 ++; } @@ -6083,6 +6117,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 @@ -6091,10 +6126,21 @@ 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); } +sub sixnum_code { + my $code; + for (0..6) { + $code .= int( rand(9) ); + } + return $code; +} + # -------------------------------------------------- portfolio access checking sub portfolio_access { @@ -10557,7 +10603,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 } @@ -13313,10 +13359,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 *