[LON-CAPA-cvs] cvs: loncom / LONCAPA.pm /auth lonroles.pm /interface loncommon.pm loncreateuser.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 01 Dec 2006 21:52:33 -0000
This is a MIME encoded message
--albertel1165009953
Content-Type: text/plain
albertel Fri Dec 1 16:52:33 2006 EDT
Modified files:
/loncom LONCAPA.pm
/loncom/auth lonroles.pm
/loncom/interface loncommon.pm loncreateuser.pm
/loncom/lonnet/perl lonnet.pm
Log:
- course ids and usernames are slightly different (courseids must start \d\w\d usernames can not start with a digit) add re for both course ids and any kind of internal name
--albertel1165009953
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20061201165233.txt"
Index: loncom/LONCAPA.pm
diff -u loncom/LONCAPA.pm:1.15 loncom/LONCAPA.pm:1.16
--- loncom/LONCAPA.pm:1.15 Mon Nov 27 11:34:38 2006
+++ loncom/LONCAPA.pm Fri Dec 1 16:52:28 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Base routines
#
-# $Id: LONCAPA.pm,v 1.15 2006/11/27 16:34:38 albertel Exp $
+# $Id: LONCAPA.pm,v 1.16 2006/12/01 21:52:28 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,6 +41,8 @@
use vars qw($match_domain $match_not_domain
$match_username $match_not_username
+ $match_courseid $match_not_courseid
+ $match_name
$match_handle $match_not_handle);
require Exporter;
@@ -50,9 +52,13 @@
&untie_user_hash &propath);
our @EXPORT_OK = qw($match_domain $match_not_domain
$match_username $match_not_username
+ $match_courseid $match_not_courseid
+ $match_name
$match_handle $match_not_handle);
our %EXPORT_TAGS = ( 'match' =>[qw($match_domain $match_not_domain
$match_username $match_not_username
+ $match_courseid $match_not_courseid
+ $match_name
$match_handle $match_not_handle)],);
my %perlvar;
@@ -104,21 +110,37 @@
return $domain;
}
-sub split_courseid {
- my ($courseid) = @_;
- my ($domain,$coursenum) =
- ($courseid=~m{^/($match_domain)/($match_username)});
- return ($domain,$coursenum);
-}
-
-$match_username = $LONCAPA::username_re = qr{[\w\-.]+};
+$match_username = $LONCAPA::username_re = qr{[^a-zA-Z\_][\w\-.]+};
$match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.]+};
sub clean_username {
my ($username) = @_;
+ $username =~ s/^\d+//;
$username =~ s/$match_not_username//g;
return $username;
}
+
+$match_courseid = $LONCAPA::courseid_re = qr{\d[\w\-.]+};
+$match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+};
+sub is_courseid {
+ my ($courseid) = @_;
+ return ($courseid =~ m/^$match_courseid$/);
+}
+
+$match_name = qr{$match_username|$match_courseid};
+sub clean_name {
+ my ($name) = @_;
+ $name =~ s/$match_not_username//g;
+ return $name;
+}
+
+sub split_courseid {
+ my ($courseid) = @_;
+ my ($domain,$coursenum) =
+ ($courseid=~m{^/($match_domain)/($match_courseid)});
+ return ($domain,$coursenum);
+}
+
$match_handle = $LONCAPA::handle_re = qr{[\w\-.]+};
$match_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.]+};
sub clean_handle {
@@ -132,7 +154,7 @@
sub propath {
my ($udom,$uname)=@_;
$udom = &clean_domain($udom);
- $uname= &clean_username($uname);
+ $uname= &clean_name($uname);
my $subdir=$uname.'__';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.170 loncom/auth/lonroles.pm:1.171
--- loncom/auth/lonroles.pm:1.170 Wed Nov 22 20:49:41 2006
+++ loncom/auth/lonroles.pm Fri Dec 1 16:52:29 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.170 2006/11/23 01:49:41 albertel Exp $
+# $Id: lonroles.pm,v 1.171 2006/12/01 21:52:29 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -126,7 +126,7 @@
if ($numdc > 0) {
foreach my $envkey (keys %env) {
if (my ($domain,$coursenum) =
- ($envkey =~ m-^form\.cc\./($match_domain)/($match_username)$-)) {
+ ($envkey =~ m-^form\.cc\./($match_domain)/($match_courseid)$-)) {
if ($dcroles{$domain}) {
&check_privs($domain,$coursenum,$then,$now);
}
@@ -988,7 +988,7 @@
my $advanced = $env{'user.adv'};
my $tryagain = $env{'form.tryagain'};
unless ($rolekey =~/^error\:/) {
- if ($rolekey =~ m-^user\.role.cc\./($match_domain)/($match_username)$-) {
+ if ($rolekey =~ m-^user\.role.cc\./($match_domain)/($match_courseid)$-) {
my $tcourseid = $1.'_'.$2;
my $trolecode = 'cc./'.$1.'/'.$2;
my $twhere;
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.482 loncom/interface/loncommon.pm:1.483
--- loncom/interface/loncommon.pm:1.482 Fri Dec 1 15:17:47 2006
+++ loncom/interface/loncommon.pm Fri Dec 1 16:52:29 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.482 2006/12/01 20:17:47 raeburn Exp $
+# $Id: loncommon.pm,v 1.483 2006/12/01 21:52:29 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2855,8 +2855,8 @@
}
} else {
foreach my $key (keys(%env)) {
- if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_username)/?(\w*)$} ||
- $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$}) {
+ if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
+ $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
next if ($role eq 'ca' || $role eq 'aa');
next if (%roles && !exists($roles{$role}));
Index: loncom/interface/loncreateuser.pm
diff -u loncom/interface/loncreateuser.pm:1.140 loncom/interface/loncreateuser.pm:1.141
--- loncom/interface/loncreateuser.pm:1.140 Fri Dec 1 16:00:35 2006
+++ loncom/interface/loncreateuser.pm Fri Dec 1 16:52:29 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Create a user
#
-# $Id: loncreateuser.pm,v 1.140 2006/12/01 21:00:35 raeburn Exp $
+# $Id: loncreateuser.pm,v 1.141 2006/12/01 21:52:29 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -624,7 +624,7 @@
my $delallowed=0;
my $sortkey=$role_code;
my $class='Unknown';
- if ($area =~ m{^/($match_domain)/($match_username)} ) {
+ if ($area =~ m{^/($match_domain)/($match_courseid)} ) {
$class='Course';
my ($coursedom,$coursedir) = ($1,$2);
$sortkey.="\0$coursedom";
@@ -660,7 +660,7 @@
}
}
# Compute the background color based on $area
- if ($area=~m{^/($match_domain)/($match_username)/(\w+)}) {
+ if ($area=~m{^/($match_domain)/($match_courseid)/(\w+)}) {
$carea.='<br />Section: '.$3;
$sortkey.="\0$3";
}
@@ -1274,7 +1274,7 @@
&Apache::lonnet::revokerole($env{'form.ccdomain'},
$env{'form.ccuname'},$1,$2).'</b><br />');
if ($2 eq 'st') {
- $1=~m{^/($match_domain)/($match_username)};
+ $1=~m{^/($match_domain)/($match_courseid)};
my $cid=$1.'_'.$2;
$r->print(&mt('Drop from classlist').': <b>'.
&Apache::lonnet::critical('put:'.
@@ -1301,7 +1301,7 @@
&Apache::lonnet::assignrole($env{'form.ccdomain'},
$env{'form.ccuname'},$1,$2,$now,0,1).'<br />');
if ($2 eq 'st') {
- $1=~m{^/($match_domain)/($match_username)};
+ $1=~m{^/($match_domain)/($match_courseid)};
my $cid=$1.'_'.$2;
$r->print(&mt('Drop from classlist').': <b>'.
&Apache::lonnet::critical('put:'.
@@ -1332,7 +1332,7 @@
my $logmsg;
my $output;
if ($role eq 'st') {
- if ($url =~ m-^/($match_domain)/($match_username)/?(\w*)$-) {
+ if ($url =~ m-^/($match_domain)/($match_courseid)/?(\w*)$-) {
my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3);
if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
$output = "Error: $result\n";
@@ -1363,7 +1363,7 @@
} elsif ($key=~/^form\.act/) {
my $udom = $env{'form.ccdomain'};
my $uname = $env{'form.ccuname'};
- if ($key=~/^form\.act\_($match_domain)\_($match_username)\_cr_cr_($match_domain)_($match_username)_([^\_]+)$/) {
+ if ($key=~/^form\.act\_($match_domain)\_($match_courseid)\_cr_cr_($match_domain)_($match_username)_([^\_]+)$/) {
# Activate a custom role
my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);
my $url='/'.$one.'/'.$two;
@@ -1394,7 +1394,7 @@
$r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end));
}
}
- } elsif ($key=~/^form\.act\_($match_domain)\_($match_username)\_([^\_]+)$/) {
+ } elsif ($key=~/^form\.act\_($match_domain)\_($match_courseid)\_([^\_]+)$/) {
# Activate roles for sections with 3 id numbers
# set start, end times, and the url for the class
my ($one,$two,$three)=($1,$2,$3);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.810 loncom/lonnet/perl/lonnet.pm:1.811
--- loncom/lonnet/perl/lonnet.pm:1.810 Wed Nov 29 02:46:40 2006
+++ loncom/lonnet/perl/lonnet.pm Fri Dec 1 16:52:30 2006
@@ -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 @@
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 @@
}
}
} 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 @@
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 @@
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 @@
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 @@
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 @@
}
$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 @@
$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_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 @@
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 @@
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 @@
$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 @@
$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 @@
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 @@
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 @@
$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 @@
} 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;
--albertel1165009953--