--- loncom/lonnet/perl/lonnet.pm 2006/11/29 07:46:40 1.810 +++ loncom/lonnet/perl/lonnet.pm 2006/12/01 21:52:30 1.811 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.810 2006/11/29 07:46:40 raeburn Exp $ +# $Id: lonnet.pm,v 1.811 2006/12/01 21:52:30 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1772,7 +1772,7 @@ sub flushcourselogs { if ($entry =~ /___count$/) { my ($dom,$name); ($dom,$name,undef)= - ($entry=~m{___($match_domain)/($match_username)/(.*)___count$}); + ($entry=~m{___($match_domain)/($match_name)/(.*)___count$}); if (! defined($dom) || $dom eq '' || ! defined($name) || $name eq '') { my $cid = $env{'request.course.id'}; @@ -1793,7 +1793,7 @@ sub flushcourselogs { } } } else { - my ($dom,$name) = ($entry=~m{___($match_domain)/($match_username)/(.*)___(\w+)$}); + my ($dom,$name) = ($entry=~m{___($match_domain)/($match_name)/(.*)___(\w+)$}); my %temphash=($entry => $accesshash{$entry}); if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') { delete $accesshash{$entry}; @@ -2732,6 +2732,7 @@ sub coursedescription { if (!$args->{'one_time'}) { $envhash{'course.'.$normalid.'.last_cache'}=time; } + if ($chome ne 'no_host') { %returnhash=&dump('environment',$cdomain,$cnum); if (!exists($returnhash{'con_lost'})) { @@ -2887,7 +2888,7 @@ sub group_roleprivs { if (($tend!=0) && ($tend<$now)) { $access = 0; } if (($tstart!=0) && ($tstart>$now)) { $access=0; } if ($access) { - my ($course,$group) = ($area =~ m|(/$match_domain/$match_username)/([^/]+)$|); + my ($course,$group) = ($area =~ m|(/$match_domain/$match_courseid)/([^/]+)$|); $$allgroups{$course}{$group} .=':'.$group_privs; } } @@ -2918,7 +2919,7 @@ sub set_userprivs { if (keys(%{$allgroups}) > 0) { foreach my $role (keys %{$allroles}) { my ($trole,$area,$sec,$extendedarea); - if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_username)(/?\w*)-) { + if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)-) { $trole = $1; $area = $2; $sec = $3; @@ -3376,7 +3377,7 @@ sub get_portfolio_access { my (%allgroups,%allroles); my ($start,$end,$role,$sec,$group); foreach my $envkey (%env) { - if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_username)/?([^/]*)$-) { + if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { my $cid = $2.'_'.$3; if ($1 eq 'gr') { $group = $4; @@ -3389,7 +3390,7 @@ sub get_portfolio_access { } $allroles{$cid}{$1}{$sec} = $env{$envkey}; } - } elsif ($envkey =~ m-^user\.role\./cr/($match_domain/$match_username/\w*)./($match_domain)/($match_username)/?([^/]*)$-) { + } elsif ($envkey =~ m-^user\.role\./cr/($match_domain/$match_username/\w*)./($match_domain)/($match_courseid)/?([^/]*)$-) { my $cid = $2.'_'.$3; if ($4 eq '') { $sec = 'none'; @@ -3489,7 +3490,7 @@ sub parse_portfolio_url { $udom = $1; $unum = $2; $file_name = $3; - } elsif ($url =~ m-^/*uploaded/($match_domain)/($match_username)/groups/([^/]+)/portfolio/(.+)$-) { + } elsif ($url =~ m-^/*uploaded/($match_domain)/($match_courseid)/groups/([^/]+)/portfolio/(.+)$-) { $type = 2; $udom = $1; $unum = $2; @@ -3509,7 +3510,7 @@ sub is_portfolio_url { sub is_portfolio_file { my ($file) = @_; - if (($file =~ /^portfolio/) || ($file =~ /^groups\/$match_username\/portfolio/)) { + if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w\/portfolio/)) { return 1; } return; @@ -4437,7 +4438,7 @@ sub get_active_groups { my $now = time; my %groups = (); foreach my $key (keys(%env)) { - if ($key =~ m-user\.role\.gr\./($match_domain)/($match_username)/(\w+)$-) { + if ($key =~ m-user\.role\.gr\./($match_domain)/($match_courseid)/(\w+)$-) { my ($start,$end) = split(/\./,$env{$key}); if (($end!=0) && ($end<$now)) { next; } if (($start!=0) && ($start>$now)) { next; } @@ -4543,7 +4544,7 @@ sub assignrole { my $mrole; if ($role =~ /^cr\//) { my $cwosec=$url; - $cwosec=~s/^\/($match_domain)\/($match_username)\/.*/$1\/$2/; + $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; unless (&allowed('ccr',$cwosec)) { &logthis('Refused custom assignrole: '. $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. @@ -4553,8 +4554,7 @@ sub assignrole { $mrole='cr'; } elsif ($role =~ /^gr\//) { my $cwogrp=$url; - $cwogrp=~s{^/($match_domain)/($match_username)/.*} - {$1/$2}x; + $cwogrp=~s{^/($match_domain)/($match_courseid)/.*}{$1/$2}; unless (&allowed('mdg',$cwogrp)) { &logthis('Refused group assignrole: '. $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. @@ -4564,7 +4564,7 @@ sub assignrole { $mrole='gr'; } else { my $cwosec=$url; - $cwosec=~s/^\/($match_domain)\/($match_username)\/.*/$1\/$2/; + $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { &logthis('Refused assignrole: '. $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. @@ -5443,7 +5443,7 @@ sub stat_file { my ($udom,$uname,$file,$dir); if ($uri =~ m-^/(uploaded|editupload)/-) { ($udom,$uname,$file) = - ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_username)/?(.*)-); + ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-); $file = 'userfiles/'.$file; $dir = &propath($udom,$uname); } @@ -7008,7 +7008,7 @@ sub repcopy_userfile { if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); } if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; } my ($cdom,$cnum,$filename) = - ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_username)/+(.*)|); + ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|); my ($info,$rtncode); my $uri="/uploaded/$cdom/$cnum/$filename"; if (-e "$file") { @@ -7130,7 +7130,7 @@ sub filelocation { $location = $file; } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file my ($udom,$uname,$filename)= - ($file=~m -^/+(?:uploaded|editupload)/+($match_domain)/+($match_username)/+(.*)$-); + ($file=~m -^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$-); my $home=&homeserver($uname,$udom); my $is_me=0; my @ids=¤t_machine_ids(); @@ -7170,7 +7170,7 @@ sub hreflocation { } elsif ($file=~m-/home/($match_username)/public_html/-) { $file=~s-^/home/($match_username)/public_html/-/~$1/-; } elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { - $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_username)/userfiles/ + $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/ -/uploaded/$1/$2/-x; } return $file;