--- loncom/lonnet/perl/lonnet.pm 2014/06/25 18:44:10 1.1172.2.52 +++ loncom/lonnet/perl/lonnet.pm 2015/01/23 23:49:38 1.1172.2.59 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.52 2014/06/25 18:44:10 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.59 2015/01/23 23:49:38 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 { @@ -2715,7 +2717,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 +5182,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 +5271,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$//; @@ -5704,18 +5711,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 } ¤t_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=(); @@ -5892,7 +5898,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); @@ -5906,6 +5912,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, @@ -6064,10 +6081,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 ++; } @@ -6084,6 +6106,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 @@ -6092,10 +6115,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 { @@ -10558,7 +10592,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 } @@ -10930,14 +10964,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'}); } @@ -11905,8 +11935,22 @@ sub get_dns { # ------------------------------------------------------Get DNS checksums file sub parse_dns_checksums_tab { my ($lines,$hashref) = @_; - my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); + my $lonhost = $perlvar{'lonHostID'}; + my $machine_dom = &Apache::lonnet::host_domain($lonhost); my $loncaparev = &get_server_loncaparev($machine_dom); + my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0]; + my $webconfdir = '/etc/httpd/conf'; + if ($distro =~ /^(ubuntu|debian)(\d+)$/) { + $webconfdir = '/etc/apache2'; + } elsif ($distro =~ /^sles(\d+)$/) { + if ($1 >= 10) { + $webconfdir = '/etc/apache2'; + } + } elsif ($distro =~ /^suse(\d+\.\d+)$/) { + if ($1 >= 10.0) { + $webconfdir = '/etc/apache2'; + } + } my ($release,$timestamp) = split(/\-/,$loncaparev); my (%chksum,%revnum); if (ref($lines) eq 'ARRAY') { @@ -11915,6 +11959,11 @@ sub parse_dns_checksums_tab { if ($version eq $release) { foreach my $line (@{$lines}) { my ($file,$version,$shasum) = split(/,/,$line); + if ($file =~ m{^/etc/httpd/conf}) { + if ($webconfdir eq '/etc/apache2') { + $file =~ s{^\Q/etc/httpd/conf/\E}{$webconfdir/}; + } + } $chksum{$file} = $shasum; $revnum{$file} = $version; } @@ -13299,10 +13348,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 *