\E}{
}gs; if (wantarray) { return ($output, $response); } else { @@ -3918,6 +3959,29 @@ sub can_edit_resource { } } +# +# For /adm/viewcoauthors can only edit if author or co-author who is manager. +# + + if (($resurl eq '/adm/viewcoauthors') && ($cnum ne '') && ($cdom ne '')) { + if (((&allowed('cca',"$cdom/$cnum")) || + (&allowed('caa',"$cdom/$cnum"))) || + ((&allowed('vca',"$cdom/$cnum") || + &allowed('vaa',"$cdom/$cnum")) && + ($env{"environment.internal.manager./$cdom/$cnum"}))) { + $home = $env{'user.home'}; + $cfile = $resurl; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + return ($cfile,$home,$switchserver,$forceedit,$forceview); + } else { + return; + } + } + if ($env{'request.course.id'}) { my $crsedit = &allowed('mdc',$env{'request.course.id'}); if ($group ne '') { @@ -5468,6 +5532,36 @@ sub courserolelog { $storehash{'group'} = $sec; } else { $storehash{'section'} = $sec; + my ($curruserdomstr,$newuserdomstr); + if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'})) { + $curruserdomstr = $env{'course.'.$env{'request.course.id'}.'.internal.userdomains'}; + } else { + my %courseinfo = &coursedescription($cdom.'/'.$cnum); + $curruserdomstr = $courseinfo{'internal.userdomains'}; + } + if ($curruserdomstr ne '') { + my @udoms = split(/,/,$curruserdomstr); + unless (grep(/^\Q$domain\E/,@udoms)) { + push(@udoms,$domain); + $newuserdomstr = join(',',sort(@udoms)); + } + } else { + $newuserdomstr = $domain; + } + if ($newuserdomstr ne '') { + my $putresult = &put('environment',{ 'internal.userdomains' => $newuserdomstr }, + $cdom,$cnum); + if ($putresult eq 'ok') { + unless (($selfenroll) || ($context eq 'selfenroll')) { + if (($context eq 'createcourse') || ($context eq 'requestcourses') || + ($context eq 'automated') || ($context eq 'domain')) { + $env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'} = $newuserdomstr; + } elsif ($env{'request.course.id'} eq $cdom.'_'.$cnum) { + &appenv({'course.'.$cdom.'_'.$cnum.'.internal.userdomains' => $newuserdomstr}); + } + } + } + } } &write_log('course',$namespace,\%storehash,$delflag,$username, $domain,$cnum,$cdom); @@ -5537,6 +5631,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)); @@ -6044,7 +6171,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); @@ -6631,13 +6758,17 @@ sub cstore { 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) { @@ -6647,7 +6778,7 @@ sub cstore { } if (!$home) { $home=$env{'user.home'}; } - $$storehash{'ip'}=&get_requestor_ip(); + $$storehash{'ip'} = &get_requestor_ip(); $$storehash{'host'}=$perlvar{'lonHostID'}; my $namevalue=''; @@ -6911,7 +7042,7 @@ sub rolesinit { my %firstaccess = &dump('firstaccesstimes', $domain, $username); my %timerinterval = &dump('timerinterval', $domain, $username); my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals, - %timerintchk, %timerintenv); + %timerintchk, %timerintenv, %coauthorenv); foreach my $key (keys(%firstaccess)) { my ($cid, $rest) = split(/\0/, $key); @@ -6925,6 +7056,8 @@ sub rolesinit { my %allroles=(); my %allgroups=(); + my %gotcoauconfig=(); + my %domdefaults=(); for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) { my $role = $rolesdump{$area}; @@ -6976,6 +7109,37 @@ sub rolesinit { } else { # Normal role, defined in roles.tab &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); + if (($trole eq 'ca') || ($trole eq 'aa')) { + (undef,my ($audom,$auname)) = split(/\//,$area); + unless ($gotcoauconfig{$area}) { + my @ca_settings = ('authoreditors','coauthorlist','coauthoroptin'); + my %info = &userenvironment($audom,$auname,@ca_settings); + $gotcoauconfig{$area} = 1; + foreach my $item (@ca_settings) { + if (exists($info{$item})) { + 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}; + } + } + } + } } my $cid = $tdomain.'_'.$trest; @@ -7004,7 +7168,7 @@ sub rolesinit { $env{'user.adv'} = $userroles{'user.adv'}; $env{'user.rar'} = $userroles{'user.rar'}; - return (\%userroles,\%firstaccenv,\%timerintenv); + return (\%userroles,\%firstaccenv,\%timerintenv,\%coauthorenv); } sub set_arearole { @@ -7364,6 +7528,27 @@ sub set_adhoc_privileges { if (&allowed('adv') eq 'F') { $tadv=1; } &appenv({'request.role.adv' => $tadv}); } + if ($role eq 'ca') { + my @ca_settings = ('authoreditors','coauthorlist'); + my %info = &userenvironment($dcdom,$pickedcourse,@ca_settings); + foreach my $item (@ca_settings) { + if (exists($info{$item})) { + my $name = $item; + if ($item eq 'authoreditors') { + $name = 'editors'; + unless ($info{'authoreditors'}) { + my %domdefs = &get_domain_defaults($dcdom); + if ($domdefs{$name} ne '') { + $info{'authoreditors'} = $domdefs{$name}; + } else { + $info{'authoreditors'} = 'edit,xml'; + } + } + } + &appenv({"environment.internal.$name./$dcdom/$pickedcourse" => $info{$item}}); + } + } + } } # --------------------------------------------------------------- get interface @@ -7898,7 +8083,7 @@ sub portfolio_access { } sub get_portfolio_access { - my ($udom,$unum,$file_name,$group,$clientip,$access_hash) = @_; + my ($udom,$unum,$file_name,$group,$clientip,$access_hash,$portaccessref) = @_; if (!ref($access_hash)) { my $current_perms = &get_portfile_permissions($udom,$unum); @@ -7907,11 +8092,19 @@ sub get_portfolio_access { $access_hash = $access_controls{$file_name}; } - my ($public,$guest,@domains,@users,@courses,@groups,@ips); + my $portaccess; + if (ref($portaccess) eq 'SCALAR') { + $portaccess = $$portaccessref; + } else { + $portaccess = &usertools_access($unum,$udom,'portaccess',undef,'tools'); + } + + my ($public,$guest,@domains,@users,@courses,@groups,@ips,@userips); my $now = time; if (ref($access_hash) eq 'HASH') { foreach my $key (keys(%{$access_hash})) { my ($num,$scope,$end,$start) = ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/); + next if (($scope ne 'ip') && ($portaccess == 0)); if ($start > $now) { next; } @@ -7933,6 +8126,8 @@ sub get_portfolio_access { push(@groups,$key); } elsif ($scope eq 'ip') { push(@ips,$key); + } elsif ($scope eq 'userip') { + push(@userips,$key); } } if ($public) { @@ -7950,6 +8145,19 @@ sub get_portfolio_access { if ($allowed) { return 'ok'; } + } elsif (@userips > 0) { + my $allowed; + foreach my $useripkey (@userips) { + if (ref($access_hash->{$useripkey}{'ip'}) eq 'ARRAY') { + if (&Apache::loncommon::check_ip_acc(join(',',@{$access_hash->{$useripkey}{'ip'}}),$clientip)) { + $allowed = 1; + last; + } + } + } + if ($allowed) { + return 'ok'; + } } if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') { if ($guest) { @@ -8155,12 +8363,17 @@ sub usertools_access { %tools = ( requestauthor => 1, ); + } elsif ($context eq 'authordefaults') { + %tools = ( + webdav => 1, + ); } else { %tools = ( aboutme => 1, blog => 1, webdav => 1, portfolio => 1, + portaccess => 1, timezone => 1, ); } @@ -8177,6 +8390,10 @@ sub usertools_access { return $env{'environment.canrequest.'.$tool}; } elsif ($context eq 'requestauthor') { return $env{'environment.canrequest.author'}; + } elsif ($context eq 'authordefaults') { + if ($tool eq 'webdav') { + return $env{'environment.availabletools.'.$tool}; + } } else { return $env{'environment.availabletools.'.$tool}; } @@ -8185,7 +8402,11 @@ sub usertools_access { my ($toolstatus,$inststatus,$envkey); if ($context eq 'requestauthor') { - $envkey = $context; + $envkey = $context; + } elsif ($context eq 'authordefaults') { + if ($tool eq 'webdav') { + $envkey = 'tools.'.$tool; + } } else { $envkey = $context.'.'.$tool; } @@ -8759,7 +8980,7 @@ sub allowed { # If this is generating or modifying users, exit with special codes - if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) { + if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:vca:vaa:'=~/\:\Q$priv\E\:/) { if (($priv eq 'cca') || ($priv eq 'caa')) { my ($audom,$auname)=split('/',$uri); # no author name given, so this just checks on the general right to make a co-author in this domain @@ -8768,6 +8989,13 @@ sub allowed { if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) || (($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) && ($audom ne $env{'request.role.domain'}))) { return ''; } + } elsif (($priv eq 'vca') || ($priv eq 'vaa')) { + my ($audom,$auname)=split('/',$uri); + unless ($auname) { return $thisallowed; } + unless (($env{'request.role'} eq "dc./$audom") || + ($env{'request.role'} eq "ca./$uri")) { + return ''; + } } return $thisallowed; } @@ -9111,6 +9339,22 @@ sub constructaccess { if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) && ($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) { if (&allowed('mdc',$env{'request.course.id'})) { + return if ($env{'course.'.$env{'request.course.id'}.'.internal.crsauthor'} eq '0'); + unless ($env{'course.'.$env{'request.course.id'}.'.internal.crsauthor'}) { + my %domdefs = &get_domain_defaults($ownerdomain); + my $type = lc($env{'course.'.$env{'request.course.id'}.'.type'}); + unless (($type eq 'community') || ($type eq 'placement')) { + $type = 'unofficial'; + if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'} ne '') { + $type = 'official'; + } elsif ($env{'course.'.$env{'request.course.id'}.'internal.textbook'} ne '') { + $type = 'textbook'; + } else { + $type = 'unofficial'; + } + } + return if ($domdefs{$type.'crsauthor'} eq '0'); + } $ownerhome = $env{'course.'.$env{'request.course.id'}.'.home'}; return ($ownername,$ownerdomain,$ownerhome); } @@ -10190,7 +10434,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); @@ -10272,7 +10516,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); @@ -10537,7 +10781,7 @@ sub plaintext { sub assignrole { my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll, $context,$othdomby,$requester,$reqsec,$reqrole)=@_; - my $mrole; + my ($mrole,$rolelogcontext); if ($role =~ /^cr\//) { my $cwosec=$url; $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; @@ -10734,6 +10978,15 @@ sub assignrole { } } } + } elsif (($context eq 'author') && (($role eq 'ca' || $role eq 'aa'))) { + if ($url =~ m{^/($match_domain)/($match_username)$}) { + my ($audom,$auname) = ($1,$2); + if ((&Apache::lonnet::allowed('v'.$role,"$audom/$auname")) && + ($env{"environment.internal.manager.$url"})) { + $refused = ''; + $rolelogcontext = 'coauthor'; + } + } } if ($refused) { &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. @@ -10801,8 +11054,11 @@ sub assignrole { &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, $context,$othdomby,$requester); } elsif (($role eq 'ca') || ($role eq 'aa')) { + if ($rolelogcontext eq '') { + $rolelogcontext = $context; + } &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, - $context,$othdomby,$requester); + $rolelogcontext,$othdomby,$requester); } if ($role eq 'cc') { &autoupdate_coowners($url,$end,$start,$uname,$udom); @@ -11453,7 +11709,7 @@ sub is_course { } sub store_userdata { - my ($storehash,$datakey,$namespace,$udom,$uname) = @_; + my ($storehash,$datakey,$namespace,$udom,$uname,$ip) = @_; my $result; if ($datakey ne '') { if (ref($storehash) eq 'HASH') { @@ -11465,7 +11721,11 @@ sub store_userdata { if (($uhome eq '') || ($uhome eq 'no_host')) { $result = 'error: no_host'; } else { - $storehash->{'ip'} = &get_requestor_ip(); + if ($ip ne '') { + $storehash->{'ip'} = $ip; + } else { + $storehash->{'ip'} = &get_requestor_ip(); + } $storehash->{'host'} = $perlvar{'lonHostID'}; my $namevalue=''; @@ -12320,6 +12580,8 @@ sub stat_file { # $relpath - Current path (relative to top level). # $dirhashref - reference to hash to populate with URLs of directories (Required) # $filehashref - reference to hash to populate with URLs of files (Optional) +# $getlastmod - if true, will set value for each key in innerhash in $filehashref +# to last modification time of file; value set to 1 otherwise. # # Returns: nothing # @@ -12332,7 +12594,8 @@ sub stat_file { # sub recursedirs { - my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$relpath,$dirhashref,$filehashref) = @_; + my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath, + $relpath,$dirhashref,$filehashref,$getlastmod) = @_; return unless (ref($dirhashref) eq 'HASH'); my $docroot = $perlvar{'lonDocRoot'}; my $currpath = $docroot.$toppath; @@ -12340,7 +12603,7 @@ sub recursedirs { $currpath .= "/$relpath"; } my ($savefile,$checkinc,$checkexc); - if (ref($filehashref)) { + if (ref($filehashref) eq 'HASH') { $savefile = 1; } if (ref($include) eq 'HASH') { @@ -12363,7 +12626,8 @@ sub recursedirs { } $dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; if ($recurse) { - &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref); + &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir, + $toppath,$newpath,$dirhashref,$filehashref,$getlastmod); } } elsif (($savefile) || ($relpath eq '')) { next if ($nonemptydir && $filecount); @@ -12380,10 +12644,16 @@ sub recursedirs { $dirhashref->{'/'} = 1; } if ($savefile) { + my $value; + if ($getlastmod) { + ($value) = (stat("$currpath/$item"))[9]; + } else { + $value = 1; + } if ($relpath eq '') { - $filehashref->{'/'}{$item} = 1; + $filehashref->{'/'}{$item} = $value } else { - $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1; + $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = $value; } } $filecount ++; @@ -12392,8 +12662,11 @@ sub recursedirs { closedir($dirh); } } else { - my ($dirlistref,$listerror) = - &dirlist($toppath.$relpath); + my $url = $toppath; + if ($relpath ne '') { + $url = $toppath.'/'.$relpath; + } + my ($dirlistref,$listerror) = &dirlist($url); my @dir_lines; my $dirptr=16384; if (ref($dirlistref) eq 'ARRAY') { @@ -12417,12 +12690,13 @@ sub recursedirs { } $dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; if ($recurse) { - &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref); + &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir, + $toppath,$newpath,$dirhashref,$filehashref,$getlastmod); } } elsif (($savefile) || ($relpath eq '')) { next if ($nonemptydir && $filecount); if ($checkinc || $checkexc) { - my $extension; + my ($extension) = ($item =~ /\.(\w+)$/); if ($checkinc) { next unless ($extension && $include->{$extension}); } @@ -12434,10 +12708,16 @@ sub recursedirs { $dirhashref->{'/'} = 1; } if ($savefile) { + my $value; + if ($getlastmod) { + $value = $mtime; + } else { + $value = 1; + } if ($relpath eq '') { - $filehashref->{'/'}{$item} = 1; + $filehashref->{'/'}{$item} = $value; } else { - $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1; + $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = $value; } } $filecount ++; @@ -12464,6 +12744,14 @@ sub priv_exclude { }; } +sub res_exclude { + return { + meta => 1, + subscription => 1, + rights => 1, + }; +} + # -------------------------------------------------------- Value of a Condition # gets the value of a specific preevaluated condition @@ -12787,6 +13075,73 @@ sub domainlti_itemid { return $itemid; } +sub get_ltitools_id { + my ($context,$cdom,$cnum,$title) = @_; + my ($lockhash,$tries,$gotlock,$id,$error); + + # get lock on ltitools db + $lockhash = { + lock => $env{'user.name'}. + ':'.$env{'user.domain'}, + }; + $tries = 0; + if ($context eq 'domain') { + $gotlock = &newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); + } + while (($gotlock ne 'ok') && ($tries<10)) { + $tries ++; + sleep (0.1); + if ($context eq 'domain') { + $gotlock = &newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); + } + } + if ($gotlock eq 'ok') { + my %currids; + if ($context eq 'domain') { + %currids = &dump_dom('ltitools',$cdom); + } else { + %currids = &dump('ltitools',$cdom,$cnum); + } + if ($currids{'lock'}) { + delete($currids{'lock'}); + if (keys(%currids)) { + my @curr = sort { $a <=> $b } keys(%currids); + if ($curr[-1] =~ /^\d+$/) { + $id = 1 + $curr[-1]; + } + } else { + $id = 1; + } + if ($id) { + if ($context eq 'domain') { + unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') { + $error = 'nostore'; + } + } else { + unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') { + $error = 'nostore'; + } + } + } else { + $error = 'nonumber'; + } + } + my $dellockoutcome; + if ($context eq 'domain') { + $dellockoutcome = &del_dom('ltitools',['lock'],$cdom); + } else { + $dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum); + } + } else { + $error = 'nolock'; + } + return ($id,$error); +} + sub count_supptools { my ($cnum,$cdom,$ignorecache,$reload)=@_; my $hashid=$cnum.':'.$cdom; @@ -14762,6 +15117,9 @@ sub whichuser { $courseid=$tmp_courseid; ($domain)=&get_env_multiple('form.grade_domain'); ($name)=&get_env_multiple('form.grade_username'); + if ($name eq 'public' && $domain eq 'public') { + $publicuser = 1; + } return ($symb,$courseid,$domain,$name,$publicuser); } } @@ -14778,6 +15136,7 @@ sub whichuser { $env{'form.username'}.=time.rand(10000000); } $name.=$env{'form.username'}; + $publicuser = 1; } return ($symb,$courseid,$domain,$name,$publicuser); @@ -14866,6 +15225,49 @@ sub repcopy_userfile { return 'ok'; } +sub repcopy_crsprivfile { + my ($src,$dest) = @_; + my $result; + if ($src =~ m{^/priv/($match_domain)/($match_courseid)/(.+)$}) { + my ($cdom,$cnum,$filepath) = ($1,$2,$3); + $filepath =~ s/\.{2,}//g; + my $chome = &homeserver($cnum,$cdom); + unless ($chome eq 'no_host') { + my @ids=¤t_machine_ids(); + unless (grep(/^\Q$chome\E$/,@ids)) { + if (&is_course($cdom,$cnum)) { + my $londocroot = $perlvar{'lonDocRoot'}; + if ($dest =~ m{^\Q$londocroot/priv/\E$match_domain/$match_username/.*\Q$filepath\E$}) { + my $cmd = 'crsfilefrompriv:'.&escape($filepath).':'.&escape($cnum).':'.&escape($cdom); + $result = &reply($cmd,$chome); + unless (($result eq 'unknown_cmd') || ($result =~ /^error:/)) { + my $url = &unescape($result); + if ($url =~ m{^https?://[^/]+\Q/userfiles/$cdom/$cnum/priv/$filepath\E$}) { + my $request=new HTTP::Request('GET',$url); + my $response=&LONCAPA::LWPReq::makerequest($chome,$request,'',\%perlvar,1200,1); + if ($response->is_error()) { + $result = 'error: '.$response->status_line; + } else { + if (open(my $fh,'>',$dest)) { + print $fh $response->content; + close($fh); + $result = 'ok'; + } else { + $result = 'error: nowrite'; + } + } + } else { + $result = 'error: invalidurl'; + } + } + } + } + } + } + } + return $result; +} + sub tokenwrapper { my $uri=shift; $uri=~s|^https?\://([^/]+)||;