[LON-CAPA-cvs] cvs: loncom / lond /auth lonroles.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Mon, 26 Jul 2010 21:52:20 -0000
This is a MIME encoded message
--raeburn1280181140
Content-Type: text/plain
raeburn Mon Jul 26 21:52:20 2010 EDT
Modified files:
/loncom lond
/loncom/auth lonroles.pm
/loncom/lonnet/perl lonnet.pm
Log:
- For Course/Community roles requiring a specific minimum LON-CAPA version,
where server hosting session is not running a recent enough version:
(a) If server hosting session is running 2.10 or later, switch server
link shown for role on roles/courses screen.
- switch is to a server in user's domain (if any have required version)
or to a server in course's domain (if any have required version).
(b) For servers hosting sessions running 2.9 or earlier, lond on the
user's home machine will only supply information for roles which
can be run on the version on the server hosting the session.
--raeburn1280181140
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20100726215220.txt"
Index: loncom/lond
diff -u loncom/lond:1.449 loncom/lond:1.450
--- loncom/lond:1.449 Thu Jul 22 22:08:06 2010
+++ loncom/lond Mon Jul 26 21:52:10 2010
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.449 2010/07/22 22:08:06 raeburn Exp $
+# $Id: lond,v 1.450 2010/07/26 21:52:10 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.449 $'; #' stupid emacs
+my $VERSION='$Revision: 1.450 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3144,7 +3144,7 @@
my $userinput = "$cmd:$tail";
- my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
+ my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
if (defined($regexp)) {
$regexp=&unescape($regexp);
} else {
@@ -3162,21 +3162,49 @@
}
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());
+ my $clientcheckrole;
if ($hashref) {
my $qresult='';
my $count=0;
+ if ($extra ne '') {
+ $extra = &Apache::lonnet::thaw_unescape($extra);
+ $clientcheckrole = $extra->{'clientcheckrole'};
+ }
+ my @ids = &Apache::lonnet::current_machine_ids();
while (my ($key,$value) = each(%$hashref)) {
if ($namespace eq 'roles') {
- if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)}) {
+ if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)_(cc|co|in|ta|ep|ad|st|cr)}) {
my $cdom = $1;
my $cnum = $2;
- if ($clientversion =~ /^\'?(\d+)\.(\d+)/) {
- my $major = $1;
- my $minor = $2;
- next if (($major < 2) || (($major == 2) && ($minor < 9)));
- } else {
- my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom);
- next unless ($currenthostid eq $homeserver);
+ unless ($clientcheckrole) {
+ my $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ my $loncaparev = $clientversion;
+ if ($loncaparev eq '') {
+ $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
+ }
+ my ($major,$minor);
+ if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\d.\-]+\'?/) {
+ $major = $1;
+ $minor = $2;
+ }
+ if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(co|in|ta|ep|ad|st|cr)}) {
+ if ($major eq '' && $minor eq '') {
+ next unless (($home ne 'no_host') && grep(/^\Q$home\E$/,@ids));
+ }
+ }
+ unless ($home eq 'no_host') {
+ my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
+ if (ref($courseinfo) eq 'HASH') {
+ if (exists($courseinfo->{'releaserequired'})) {
+ my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
+ if ($reqdmajor ne '' && $reqdminor ne '') {
+ next if (($major eq '' && $minor eq '') ||
+ ($major < $reqdmajor) ||
+ (($major == $reqdmajor) && ($minor < $reqdminor)));
+ }
+ }
+ }
+ }
}
}
}
@@ -7270,6 +7298,21 @@
return;
}
+sub get_courseinfo_hash {
+ my ($cnum,$cdom,$home) = @_;
+ my $hashid = $cdom.':'.$cnum;
+ my ($courseinfo,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
+ if (defined($cached)) {
+ return $courseinfo;
+ } else {
+ my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
+ if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
+ return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
+ }
+ }
+ return;
+}
+
# ----------------------------------- POD (plain old documentation, CPAN style)
=head1 NAME
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.253 loncom/auth/lonroles.pm:1.254
--- loncom/auth/lonroles.pm:1.253 Fri Jun 18 08:41:37 2010
+++ loncom/auth/lonroles.pm Mon Jul 26 21:52:15 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.253 2010/06/18 08:41:37 bisitz Exp $
+# $Id: lonroles.pm,v 1.254 2010/07/26 21:52:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -210,6 +210,7 @@
my %dcroles = ();
my $numdc = &check_fordc(\%dcroles,$then);
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
+ my $loncaparev = $Apache::lonnet::perlvar{'lonVersion'};
# ================================================================== Roles Init
if ($env{'form.selectrole'}) {
@@ -691,7 +692,7 @@
my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);
my ($countactive,$countfuture,$inrole,$possiblerole) =
&gather_roles($then,$refresh,$now,$reinit,$nochoose,\%roletext,\%sortrole,\%roleclass,
- \%futureroles,\%timezones);
+ \%futureroles,\%timezones,$loncaparev);
$refresh = $now;
&Apache::lonnet::appenv({'user.refresh.time' => $refresh});
@@ -873,13 +874,15 @@
}
sub gather_roles {
- my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones) = @_;
+ my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones,$loncaparev) = @_;
my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
my $advanced = $env{'user.adv'};
my $tryagain = $env{'form.tryagain'};
+ my @ids = &Apache::lonnet::current_machine_ids();
foreach my $envkey (sort(keys(%env))) {
my $button = 1;
my $switchserver='';
+ my $switchwarning;
my ($role_text,$role_text_end,$sortkey);
if ($envkey=~/^user\.role\./) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
@@ -940,7 +943,6 @@
if (($role eq 'ca') || ($role eq 'aa')) {
my $home = &Apache::lonnet::homeserver($trest,$tdom);
my $allowed=0;
- my @ids=&Apache::lonnet::current_machine_ids();
foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if (!$allowed) {
$button=0;
@@ -960,7 +962,6 @@
my $home = &Apache::lonnet::homeserver
($env{'user.name'},$env{'user.domain'});
my $allowed=0;
- my @ids=&Apache::lonnet::current_machine_ids();
foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if (!$allowed) {
$button=0;
@@ -979,6 +980,7 @@
$ttype = &Apache::loncommon::course_type($tcourseid);
$trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
if ($env{'course.'.$tcourseid.'.description'}) {
+ my $home=$env{'course.'.$tcourseid.'.home'};
$twhere=$env{'course.'.$tcourseid.'.description'};
$sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
$twhere = &HTML::Entities::encode($twhere,'"<>&');
@@ -986,6 +988,13 @@
$twhere.=' <span class="LC_fontsize_small">'.
&Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
'</span>';
+ unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
+ ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$tcourseid,$trolecode);
+ if ($switchserver || $switchwarning) {
+ $button = 0;
+ }
+ }
}
} else {
my %newhash=&Apache::lonnet::coursedescription($tcourseid);
@@ -998,6 +1007,14 @@
'</span>';
$ttype = $newhash{'type'};
$trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
+ my $home = $newhash{'home'};
+ unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
+ ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$tcourseid,$trolecode);
+ if ($switchserver || $switchwarning) {
+ $button = 0;
+ }
+ }
} else {
$twhere=&mt('Currently not available');
$env{'course.'.$tcourseid.'.description'}=$twhere;
@@ -1021,7 +1038,7 @@
($role_text,$role_text_end) =
&build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
- $tpend,$nochoose,$button,$switchserver,$reinit);
+ $tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning);
$roletext->{$envkey}=[$role_text,$role_text_end];
if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
$sortrole->{$sortkey}=$envkey;
@@ -1293,7 +1310,7 @@
}
sub build_roletext {
- my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit) = @_;
+ my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning) = @_;
my ($roletext,$roletext_end);
my $is_dc=($trolecode =~ m/^dc\./);
my $rowspan=($is_dc) ? ''
@@ -1311,6 +1328,7 @@
} else {
$roletext.=('<td'.$rowspan.' class="'.$tbg.'"> </td>');
}
+ $tremark .= $switchwarning;
} elsif ($tstatus eq 'is') {
$roletext.='<td'.$rowspan.' class="'.$tbg.'">'.
'<input name="'.$buttonname.'" type="button" value="'.
@@ -1491,6 +1509,58 @@
return $is_cc;
}
+sub check_release_required {
+ my ($loncaparev,$tcourseid,$trolecode) = @_;
+ my ($switchserver,$warning);
+ if ($env{'course.'.$tcourseid.'.internal.releaserequired'} ne '') {
+ my ($reqdmajor,$reqdminor) = ($env{'course.'.$tcourseid.'.internal.releaserequired'} =~ /^(\d+)\.(\d+)$/);
+ my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\d.\-]+\'?$/);
+ if ($reqdmajor ne '' && $reqdminor ne '') {
+ my $otherserver;
+ if (($major eq '' && $minor eq '') ||
+ (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
+ my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'});
+ my $switchlcrev =
+ &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
+ $userdomserver);
+ my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\d.\-]+\'?$/);
+ if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
+ (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
+ my $cdom = $env{'course.'.$tcourseid.'.domain'};
+ if ($cdom ne $env{'user.domain'}) {
+ my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom);
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
+ my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+ my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
+ my $canhost =
+ &Apache::lonnet::can_host_session($env{'user.domain'},
+ $coursedomserver,
+ $remoterev,
+ $udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
+
+ if ($canhost) {
+ $otherserver = $coursedomserver;
+ } else {
+ $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
+ }
+ } else {
+ $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
+ }
+ } else {
+ $otherserver = $userdomserver;
+ }
+ }
+ if ($otherserver ne '') {
+ $switchserver = 'otherserver='.$otherserver.'&role='.$trolecode;
+ }
+ }
+ }
+ return ($switchserver,$warning);
+}
+
sub courselink {
my ($dcdom,$rowtype) = @_;
my $courseform=&Apache::loncommon::selectcourse_link
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1077 loncom/lonnet/perl/lonnet.pm:1.1078
--- loncom/lonnet/perl/lonnet.pm:1.1077 Sun Jul 25 02:58:05 2010
+++ loncom/lonnet/perl/lonnet.pm Mon Jul 26 21:52:19 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1077 2010/07/25 02:58:05 raeburn Exp $
+# $Id: lonnet.pm,v 1.1078 2010/07/26 21:52:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3943,9 +3943,10 @@
my ($domain,$username,$authhost)=@_;
my $now=time;
my %userroles = ('user.login.time' => $now);
- my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
+ my $extra = &freeze_escape({'clientcheckrole' => 1});
+ my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost);
if (($rolesdump eq 'con_lost') || ($rolesdump eq '') ||
- ($rolesdump =~ /^error:/)) {
+ ($rolesdump =~ /^error:/)) {
return \%userroles;
}
my %allroles=();
--raeburn1280181140--