--- loncom/lonnet/perl/lonnet.pm 2010/01/15 00:14:01 1.1048.2.1 +++ loncom/lonnet/perl/lonnet.pm 2010/12/08 04:51:26 1.1048.2.5 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1048.2.1 2010/01/15 00:14:01 raeburn Exp $ +# $Id: lonnet.pm,v 1.1048.2.5 2010/12/08 04:51:26 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4038,13 +4038,6 @@ sub role_status { ); my $spec=$$role.'.'.$$where; my ($tdummy,$tdomain,$trest)=split(/\//,$$where); - if ($$role eq 'gr') { - my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'}, - $env{'user.name'})=@_; - my ($trole) = split('_',$role,1); - (undef,my $group_privs) = split(/\//,$trole); - $group_privs = &unescape($group_privs); - } if ($$role =~ /^cr\//) { &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where); } elsif ($$role eq 'gr') { @@ -4076,6 +4069,41 @@ sub role_status { } } +sub curr_role_status { + my ($start,$end,$refresh,$then) = @_; + if (($start) && ($start<0)) { return 'deleted' }; + my $status = 'active'; + if (($end) && ($end<=$then)) { + $status = 'previous'; + } + if (($start) && ($refresh<$start)) { + $status = 'future'; + } + return $status; +} + +sub gather_roleprivs { + my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend) = @_; + return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH')); + if (($area ne '') && ($role ne '')) { + my $spec = $role.'.'.$area; + my ($tdummy,$tdomain,$trest)=split(/\//,$area); + if ($role =~ /^cr\//) { + &custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area); + } elsif ($role eq 'gr') { + my %rolehash = &get('roles',[$area.'_'.$role],$env{'user.domain'}, + $env{'user.name'}); + my $trole = split('_',$rolehash{$area.'_'.$role},1); + (undef,my $group_privs) = split(/\//,$trole); + $group_privs = &unescape($group_privs); + &group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart); + } else { + &standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area); + } + } + return; +} + sub check_adhoc_privs { my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; @@ -4820,6 +4848,27 @@ sub usertools_access { } } +sub is_course_owner { + my ($cdom,$cnum,$udom,$uname) = @_; + if (($udom eq '') || ($uname eq '')) { + $udom = $env{'user.domain'}; + $uname = $env{'user.name'}; + } + unless (($udom eq '') || ($uname eq '')) { + if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'})) { + if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) { + return 1; + } else { + my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum); + if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) { + return 1; + } + } + } + } + return; +} + sub is_advanced_user { my ($udom,$uname) = @_; my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1); @@ -6263,7 +6312,7 @@ sub assignrole { } } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { $refused = ''; - } elsif (($selfenroll == 1) && ($role eq 'st') && ($cdom eq 'gci') && ($cnum eq '1H96711d710194bfegcil1')) { + } elsif (($selfenroll == 1) && ($role eq 'st') && ($cdom eq 'gci') && (($cnum eq '1H96711d710194bfegcil1') || ($cnum eq '5422913620b814c90gcil1'))) { if ($env{'request.role'} eq 'cc./gci/9615072b469884921gcil1') { $refused = ''; } @@ -9485,6 +9534,7 @@ sub get_dns { my %libserv; my $loaded; my %name_to_host; + my %internetdom; sub parse_hosts_tab { my ($file) = @_; @@ -9492,7 +9542,7 @@ sub get_dns { next if ($configline =~ /^(\#|\s*$ )/x); next if ($configline =~ /^\^/); chomp($configline); - my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline); + my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); $name=~s/\s//g; if ($id && $domain && $role && $name) { $hostname{$id}=$name; @@ -9508,6 +9558,9 @@ sub get_dns { } else { $protocol{$id} = 'http'; } + if (defined($intdom)) { + $internetdom{$id} = $intdom; + } } } } @@ -9606,6 +9659,13 @@ sub get_dns { my @uniq = grep(!$seen{$_}++, values(%hostdom)); return @uniq; } + + sub internet_dom { + &load_hosts_tab() if (!$loaded); + + my ($lonid) = @_; + return $internetdom{$lonid}; + } } {