--- loncom/lonnet/perl/lonnet.pm 2024/02/24 23:41:44 1.1523 +++ loncom/lonnet/perl/lonnet.pm 2024/12/25 06:07:01 1.1531 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1523 2024/02/24 23:41:44 raeburn Exp $ +# $Id: lonnet.pm,v 1.1531 2024/12/25 06:07:01 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -188,7 +188,11 @@ sub create_connection { Type => SOCK_STREAM, Timeout => 10); return 0 if (!$client); - print $client (join(':',$hostname,$lonid,&machine_ids($hostname),$loncaparevs{$lonid})."\n"); + if ($loncaparevs{$lonid} =~ /^(\d+\.\d+\.[\w.]+)-\d+$/) { + print $client (join(':',$hostname,$lonid,$1,&machine_ids($hostname))."\n"); + } else { + print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n"); + } my $result = <$client>; chomp($result); return 1 if ($result eq 'done'); @@ -224,7 +228,7 @@ sub get_server_distarch { } } my $rep = &reply('serverdistarch',$lonhost); - unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' || + unless ($rep eq 'unknown_cmd' || $rep eq 'no_such_host' || $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' || $rep eq '') { return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime); @@ -2802,7 +2806,7 @@ sub get_domain_defaults { $domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; } if (ref($domconfig{'authordefaults'}) eq 'HASH') { - foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors') { + foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors','archive') { if ($item eq 'editors') { if (ref($domconfig{'authordefaults'}{'editors'}) eq 'ARRAY') { $domdefaults{$item} = join(',',@{$domconfig{'authordefaults'}{'editors'}}); @@ -2825,6 +2829,9 @@ sub get_domain_defaults { if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') { $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'}; } + if (ref($domconfig{'coursedefaults'}{'crseditors'}) eq 'ARRAY') { + $domdefaults{'crseditors'}=join(',',@{$domconfig{'coursedefaults'}{'crseditors'}}); + } foreach my $type (@coursetypes) { if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { unless ($type eq 'community') { @@ -5620,6 +5627,39 @@ sub coauthorrolelog { return; } +sub authorarchivelog { + my ($hashref,$size,$filesdest,$action) = @_; + my $lonprtdir = $Apache::lonnet::perlvar{'lonPrtDir'}; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + $filesdest =~ s{^\Q$lonprtdir/\E}{}; + if ($filesdest =~ m{^($match_username)_($match_domain)_archive_(\d+_\d+_\d+(|[.\w]+))$}) { + my ($auname,$audom,$id) = ($1,$2,$3); + if (ref($hashref) eq 'HASH') { + my $namespace = 'archivelog'; + my $dir; + if ($hashref->{dir} =~ m{^\Q$londocroot/priv/$audom/$auname\E(.*)$}) { + $dir = $1; + } + my $delflag = 0; + my %storehash = ( + id => $id, + dir => $dir, + files => $hashref->{numfiles}, + subdirs => $hashref->{numdirs}, + bytes => $hashref->{bytes}, + size => $size, + action => $action, + ); + if ($action eq 'delete') { + $delflag = 1; + } + &write_log('author',$namespace,\%storehash,$delflag,$auname, + $audom,$auname,$audom); + } + } + return; +} + sub get_course_adv_roles { my ($cid,$codes) = @_; $cid=$env{'request.course.id'} unless (defined($cid)); @@ -6127,7 +6167,7 @@ sub courselastaccess { sub extract_lastaccess { my ($returnhash,$rep) = @_; if (ref($returnhash) eq 'HASH') { - unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' || + unless ($rep eq 'unknown_cmd' || $rep eq 'no_such_host' || $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' || $rep eq '') { my @pairs=split(/\&/,$rep); @@ -6709,18 +6749,22 @@ sub store { # -------------------------------------------------------------- Critical Store sub cstore { - my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname,$laststore,$ip,$nolog) = @_; my $home=''; if ($stuname) { $home=&homeserver($stuname,$domain); } - $symb=&symbclean($symb); + unless (($symb eq '_feedback') || ($symb eq '_discussion')) { + $symb=&symbclean($symb); + } if (!$symb) { unless ($symb=&symbread()) { return ''; } } if (!$domain) { $domain=$env{'user.domain'}; } if (!$stuname) { $stuname=$env{'user.name'}; } - &devalidate($symb,$stuname,$domain); + unless (($symb eq '_feedback') || ($symb eq '_discussion')) { + &devalidate($symb,$stuname,$domain); + } $symb=escape($symb); if (!$namespace) { @@ -6730,7 +6774,11 @@ sub cstore { } if (!$home) { $home=$env{'user.home'}; } - $$storehash{'ip'}=&get_requestor_ip(); + if ($ip ne '') { + $$storehash{'ip'} = $ip; + } else { + $$storehash{'ip'} = &get_requestor_ip(); + } $$storehash{'host'}=$perlvar{'lonHostID'}; my $namevalue=''; @@ -6738,7 +6786,9 @@ sub cstore { $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; } $namevalue=~s/\&$//; - &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); + unless ($nolog) { + &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); + } return critical ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home"); } @@ -7009,6 +7059,7 @@ sub rolesinit { my %allroles=(); my %allgroups=(); my %gotcoauconfig=(); + my %domdefaults=(); for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) { my $role = $rolesdump{$area}; @@ -7071,6 +7122,20 @@ sub rolesinit { my $name = $item; if ($item eq 'authoreditors') { $name = 'editors'; + unless ($info{'authoreditors'}) { + my %domdefs; + if (ref($domdefaults{$audom}) eq 'HASH') { + %domdefs = %{$domdefaults{$audom}}; + } else { + %domdefs = &get_domain_defaults($audom); + $domdefaults{$audom} = \%domdefs; + } + if ($domdefs{$name} ne '') { + $info{'authoreditors'} = $domdefs{$name}; + } else { + $info{'authoreditors'} = 'edit,xml'; + } + } } $coauthorenv{"environment.internal.$name.$area"} = $info{$item}; } @@ -8287,6 +8352,7 @@ sub usertools_access { %tools = ( aboutme => 1, blog => 1, + webdav => 1, portfolio => 1, portaccess => 1, timezone => 1, @@ -10349,7 +10415,7 @@ sub auto_instsec_reformat { my $info = &freeze_escape($instsecref); my $response=&reply('autoinstsecreformat:'.$cdom.':'. $action.':'.$info,$server); - next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/); + next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_cmd)/); my @items = split(/&/,$response); foreach my $item (@items) { my ($key,$value) = split(/=/,$item); @@ -10431,7 +10497,7 @@ sub auto_export_grades { my $grades = &freeze_escape($gradesref); my $response=&reply('encrypt:autoexportgrades:'.$cdom.':'.$cnum.':'. $info.':'.$grades,$homeserver); - unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/) { + unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_cmd)/) { my @items = split(/&/,$response); foreach my $item (@items) { my ($key,$value) = split('=',$item);