--- loncom/lonnet/perl/lonnet.pm 2009/04/11 21:43:02 1.994 +++ loncom/lonnet/perl/lonnet.pm 2009/06/11 19:19:57 1.1003 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.994 2009/04/11 21:43:02 raeburn Exp $ +# $Id: lonnet.pm,v 1.1003 2009/06/11 19:19:57 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; } @@ -1904,7 +1909,7 @@ sub ssi { &Apache::lonenc::check_encrypt(\$fn); if (%form) { $request=new HTTP::Request('POST',&absolute_url().$fn); - $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form)); + $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form))); } else { $request=new HTTP::Request('GET',&absolute_url().$fn); } @@ -2166,9 +2171,12 @@ sub userfileupload { close($fh); return $fullpath.'/'.$fname; } - + if ($subdir eq 'scantron') { + $fname = 'scantron_orig_'.$fname; + } else { # Create the directory if not present - $fname="$subdir/$fname"; + $fname="$subdir/$fname"; + } if ($coursedoc) { my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -2551,7 +2559,7 @@ sub flushcourselogs { # Reverse lookup of domain roles (dc, ad, li, sc, au) # my %domrolebuffer = (); - foreach my $entry (keys %domainrolehash) { + foreach my $entry (keys(%domainrolehash)) { my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry); if ($domrolebuffer{$rudom}) { $domrolebuffer{$rudom}.='&'.&escape($entry). @@ -2706,6 +2714,9 @@ sub courserolelog { $storehash{'section'} = $sec; } &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); + if (($trole ne 'st') || ($sec ne '')) { + &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); + } } } return; @@ -2728,15 +2739,29 @@ sub get_course_adv_roles { my %dumphash= &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); my $now=time; - foreach my $entry (keys %dumphash) { + my %privileged; + foreach my $entry (keys(%dumphash)) { my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); if (($tstart) && ($tstart<0)) { next; } if (($tend) && ($tend<$now)) { next; } if (($tstart) && ($now<$tstart)) { next; } my ($role,$username,$domain,$section)=split(/\:/,$entry); if ($username eq '' || $domain eq '') { next; } - if ((&privileged($username,$domain)) && - (!$nothide{$username.':'.$domain})) { next; } + unless (ref($privileged{$domain}) eq 'HASH') { + my %dompersonnel = + &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now); + $privileged{$domain} = {}; + foreach my $server (keys(%dompersonnel)) { + if (ref($dompersonnel{$server}) eq 'HASH') { + foreach my $user (keys(%{$dompersonnel{$server}})) { + my ($trole,$uname,$udom) = split(/:/,$user); + $privileged{$udom}{$uname} = 1; + } + } + } + } + if ((exists($privileged{$domain}{$username})) && + (!$nothide{$username.':'.$domain})) { next; } if ($role eq 'cr') { next; } if ($codes) { if ($section) { $role .= ':'.$section; } @@ -2781,6 +2806,7 @@ sub get_my_roles { } my %returnhash=(); my $now=time; + my %privileged; foreach my $entry (keys(%dumphash)) { my ($role,$tend,$tstart); if ($context eq 'userroles') { @@ -2829,9 +2855,32 @@ sub get_my_roles { } } if ($hidepriv) { - if ((&privileged($username,$domain)) && - (!$nothide{$username.':'.$domain})) { - next; + if ($context eq 'userroles') { + if ((&privileged($username,$domain)) && + (!$nothide{$username.':'.$domain})) { + next; + } + } else { + unless (ref($privileged{$domain}) eq 'HASH') { + my %dompersonnel = + &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now); + $privileged{$domain} = {}; + if (keys(%dompersonnel)) { + foreach my $server (keys(%dompersonnel)) { + if (ref($dompersonnel{$server}) eq 'HASH') { + foreach my $user (keys(%{$dompersonnel{$server}})) { + my ($trole,$uname,$udom) = split(/:/,$user); + $privileged{$udom}{$uname} = $trole; + } + } + } + } + } + if (exists($privileged{$domain}{$username})) { + if (!$nothide{$username.':'.$domain}) { + next; + } + } } } if ($withsec) { @@ -3401,7 +3450,7 @@ sub tmpreset { if (tie(%hash,'GDBM_File', $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', &GDBM_WRCREAT(),0640)) { - foreach my $key (keys %hash) { + foreach my $key (keys(%hash)) { if ($key=~ /:$symb/) { delete($hash{$key}); } @@ -3837,7 +3886,7 @@ sub set_userprivs { my $adv=0; my %grouproles = (); if (keys(%{$allgroups}) > 0) { - foreach my $role (keys %{$allroles}) { + foreach my $role (keys(%{$allroles})) { my ($trole,$area,$sec,$extendedarea); if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { $trole = $1; @@ -3881,7 +3930,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); @@ -3892,7 +3941,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) { @@ -3906,11 +3989,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); } @@ -4997,7 +5080,7 @@ sub allowed { my $envkey; if ($thisallowed=~/L/) { - foreach $envkey (keys %env) { + foreach $envkey (keys(%env)) { if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { my $courseid=$2; my $roleid=$1.'.'.$2; @@ -5288,7 +5371,7 @@ sub fetch_enrollment_query { } my $host=&hostname($homeserver); my $cmd = ''; - foreach my $affiliate (keys %{$affiliatesref}) { + foreach my $affiliate (keys(%{$affiliatesref})) { $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%'; } $cmd =~ s/%%$//; @@ -5615,7 +5698,40 @@ sub auto_instcode_defaults { } return $response; -} +} + +sub auto_possible_instcodes { + my ($domain,$codetitles,$cat_titles,$cat_order) = @_; + 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)}=&unescape($value); + } + foreach my $item (split('&',$cat_order)) { + my ($name,$value)=split('&',$item); + $cat_order->{&unescape($name)}=&unescape($value); + } + return 'ok'; + } + return $response; +} sub auto_validate_class_sec { my ($cdom,$cnum,$owners,$inst_class) = @_; @@ -7796,7 +7912,7 @@ sub symblist { if (($env{'request.course.fn'}) && (%newhash)) { if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', &GDBM_WRCREAT(),0640)) { - foreach my $url (keys %newhash) { + foreach my $url (keys(%newhash)) { next if ($url eq 'last_known' && $env{'form.no_update_last_known'}); $hash{declutter($url)}=&encode_symb($mapname,