--- loncom/lonnet/perl/lonnet.pm 2009/05/13 01:30:49 1.1000 +++ loncom/lonnet/perl/lonnet.pm 2009/07/20 23:33:11 1.1005 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1000 2009/05/13 01:30:49 raeburn Exp $ +# $Id: lonnet.pm,v 1.1005 2009/07/20 23:33:11 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -718,7 +718,12 @@ sub spareserver { if ($protocol{$spare_server} eq 'https') { $protocol = $protocol{$spare_server}; } - $spare_server = $protocol.'://'.&hostname($spare_server); + if (defined($spare_server)) { + my $hostname = &hostname($spare_server); + if (defined($hostname)) { + $spare_server = $protocol.'://'.$hostname; + } + } } return $spare_server; } @@ -1861,6 +1866,8 @@ sub ssi_body { if ($filelink=~/^https?\:/) { ($output,$response)=&externalssi($filelink); } else { + $filelink .= $filelink=~/\?/ ? '&' : '?'; + $filelink .= 'inhibitmenu=yes'; ($output,$response)=&ssi($filelink,%form); } $output=~s|//(\s*)?\s||gs; @@ -3925,7 +3932,7 @@ sub set_userprivs { } sub role_status { - my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_; + my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_; my @pwhere = (); if (exists($env{$rolekey}) && $env{$rolekey} ne '') { (undef,undef,$$role,@pwhere)=split(/\./,$rolekey); @@ -3936,7 +3943,41 @@ sub role_status { $$tstatus='is'; if ($$tstart && $$tstart>$then) { $$tstatus='future'; - if ($$tstart<$now) { $$tstatus='will'; } + if ($$tstart && $$tstart>$refresh) { + if ($$tstart<$now) { + if (($$where ne '') && ($$role ne '')) { + my (%allroles,%allgroups,$group_privs); + my %userroles = ( + 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend + ); + 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') { + my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'}, + $env{'user.name'}); + my $trole = split('_',$rolehash{$$where.'_'.$$role},1); + (undef,my $group_privs) = split(/\//,$trole); + $group_privs = &unescape($group_privs); + &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart); + } else { + &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where); + } + my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups); + &appenv(\%userroles,[$$role,'cm']); + &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); + $$tstatus = 'is'; + } + } + } } if ($$tend) { if ($$tend<$then) { @@ -3950,11 +3991,11 @@ sub role_status { } sub check_adhoc_privs { - my ($cdom,$cnum,$then,$now,$checkrole) = @_; + my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; if ($env{$cckey}) { my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); - &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); + &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { &set_adhoc_privileges($cdom,$cnum,$checkrole); } @@ -5659,7 +5700,40 @@ sub auto_instcode_defaults { } return $response; -} +} + +sub auto_possible_instcodes { + my ($domain,$codetitles,$cat_titles,$cat_orders) = @_; + my (@homeservers,$uhome); + if (defined(&domain($domain,'primary'))) { + $uhome=&domain($domain,'primary'); + push(@homeservers,&domain($domain,'primary')); + } else { + my %servers = &get_servers($domain,'library'); + foreach my $tryserver (keys(%servers)) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { + push(@homeservers,$tryserver); + } + } + } + my $response; + foreach my $server (@homeservers) { + $response=&reply('autopossibleinstcodes:'.$domain,$server); + next if ($response =~ /(con_lost|error|no_such_host|refused)/); + my ($codetitlestr,$cat_title,$cat_order) = split(':',$response); + @{$codetitles} = map { &unescape($_); } (split('&',$codetitlestr)); + foreach my $item (split('&',$cat_title)) { + my ($name,$value)=split('=',$item); + $cat_titles->{&unescape($name)}=&thaw_unescape($value); + } + foreach my $item (split('&',$cat_order)) { + my ($name,$value)=split('=',$item); + $cat_orders->{&unescape($name)}=&thaw_unescape($value); + } + return 'ok'; + } + return $response; +} sub auto_validate_class_sec { my ($cdom,$cnum,$owners,$inst_class) = @_;