version 1.996, 2009/05/06 12:13:26
|
version 1.1005, 2009/07/20 23:33:11
|
Line 718 sub spareserver {
|
Line 718 sub spareserver {
|
if ($protocol{$spare_server} eq 'https') { |
if ($protocol{$spare_server} eq 'https') { |
$protocol = $protocol{$spare_server}; |
$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; |
return $spare_server; |
} |
} |
Line 1861 sub ssi_body {
|
Line 1866 sub ssi_body {
|
if ($filelink=~/^https?\:/) { |
if ($filelink=~/^https?\:/) { |
($output,$response)=&externalssi($filelink); |
($output,$response)=&externalssi($filelink); |
} else { |
} else { |
|
$filelink .= $filelink=~/\?/ ? '&' : '?'; |
|
$filelink .= 'inhibitmenu=yes'; |
($output,$response)=&ssi($filelink,%form); |
($output,$response)=&ssi($filelink,%form); |
} |
} |
$output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs; |
$output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs; |
Line 1904 sub ssi {
|
Line 1911 sub ssi {
|
&Apache::lonenc::check_encrypt(\$fn); |
&Apache::lonenc::check_encrypt(\$fn); |
if (%form) { |
if (%form) { |
$request=new HTTP::Request('POST',&absolute_url().$fn); |
$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 { |
} else { |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
} |
} |
Line 2554 sub flushcourselogs {
|
Line 2561 sub flushcourselogs {
|
# Reverse lookup of domain roles (dc, ad, li, sc, au) |
# Reverse lookup of domain roles (dc, ad, li, sc, au) |
# |
# |
my %domrolebuffer = (); |
my %domrolebuffer = (); |
foreach my $entry (keys %domainrolehash) { |
foreach my $entry (keys(%domainrolehash)) { |
my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry); |
my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry); |
if ($domrolebuffer{$rudom}) { |
if ($domrolebuffer{$rudom}) { |
$domrolebuffer{$rudom}.='&'.&escape($entry). |
$domrolebuffer{$rudom}.='&'.&escape($entry). |
Line 2734 sub get_course_adv_roles {
|
Line 2741 sub get_course_adv_roles {
|
my %dumphash= |
my %dumphash= |
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); |
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); |
my $now=time; |
my $now=time; |
foreach my $entry (keys %dumphash) { |
my %privileged; |
|
foreach my $entry (keys(%dumphash)) { |
my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); |
my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); |
if (($tstart) && ($tstart<0)) { next; } |
if (($tstart) && ($tstart<0)) { next; } |
if (($tend) && ($tend<$now)) { next; } |
if (($tend) && ($tend<$now)) { next; } |
if (($tstart) && ($now<$tstart)) { next; } |
if (($tstart) && ($now<$tstart)) { next; } |
my ($role,$username,$domain,$section)=split(/\:/,$entry); |
my ($role,$username,$domain,$section)=split(/\:/,$entry); |
if ($username eq '' || $domain eq '') { next; } |
if ($username eq '' || $domain eq '') { next; } |
if ((&privileged($username,$domain)) && |
unless (ref($privileged{$domain}) eq 'HASH') { |
(!$nothide{$username.':'.$domain})) { next; } |
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 ($role eq 'cr') { next; } |
if ($codes) { |
if ($codes) { |
if ($section) { $role .= ':'.$section; } |
if ($section) { $role .= ':'.$section; } |
Line 2787 sub get_my_roles {
|
Line 2808 sub get_my_roles {
|
} |
} |
my %returnhash=(); |
my %returnhash=(); |
my $now=time; |
my $now=time; |
|
my %privileged; |
foreach my $entry (keys(%dumphash)) { |
foreach my $entry (keys(%dumphash)) { |
my ($role,$tend,$tstart); |
my ($role,$tend,$tstart); |
if ($context eq 'userroles') { |
if ($context eq 'userroles') { |
Line 2835 sub get_my_roles {
|
Line 2857 sub get_my_roles {
|
} |
} |
} |
} |
if ($hidepriv) { |
if ($hidepriv) { |
if ((&privileged($username,$domain)) && |
if ($context eq 'userroles') { |
(!$nothide{$username.':'.$domain})) { |
if ((&privileged($username,$domain)) && |
next; |
(!$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) { |
if ($withsec) { |
Line 3407 sub tmpreset {
|
Line 3452 sub tmpreset {
|
if (tie(%hash,'GDBM_File', |
if (tie(%hash,'GDBM_File', |
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', |
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', |
&GDBM_WRCREAT(),0640)) { |
&GDBM_WRCREAT(),0640)) { |
foreach my $key (keys %hash) { |
foreach my $key (keys(%hash)) { |
if ($key=~ /:$symb/) { |
if ($key=~ /:$symb/) { |
delete($hash{$key}); |
delete($hash{$key}); |
} |
} |
Line 3843 sub set_userprivs {
|
Line 3888 sub set_userprivs {
|
my $adv=0; |
my $adv=0; |
my %grouproles = (); |
my %grouproles = (); |
if (keys(%{$allgroups}) > 0) { |
if (keys(%{$allgroups}) > 0) { |
foreach my $role (keys %{$allroles}) { |
foreach my $role (keys(%{$allroles})) { |
my ($trole,$area,$sec,$extendedarea); |
my ($trole,$area,$sec,$extendedarea); |
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { |
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { |
$trole = $1; |
$trole = $1; |
Line 3887 sub set_userprivs {
|
Line 3932 sub set_userprivs {
|
} |
} |
|
|
sub role_status { |
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 = (); |
my @pwhere = (); |
if (exists($env{$rolekey}) && $env{$rolekey} ne '') { |
if (exists($env{$rolekey}) && $env{$rolekey} ne '') { |
(undef,undef,$$role,@pwhere)=split(/\./,$rolekey); |
(undef,undef,$$role,@pwhere)=split(/\./,$rolekey); |
Line 3898 sub role_status {
|
Line 3943 sub role_status {
|
$$tstatus='is'; |
$$tstatus='is'; |
if ($$tstart && $$tstart>$then) { |
if ($$tstart && $$tstart>$then) { |
$$tstatus='future'; |
$$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) { |
if ($$tend<$then) { |
if ($$tend<$then) { |
Line 3912 sub role_status {
|
Line 3991 sub role_status {
|
} |
} |
|
|
sub check_adhoc_privs { |
sub check_adhoc_privs { |
my ($cdom,$cnum,$then,$now,$checkrole) = @_; |
my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_; |
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; |
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; |
if ($env{$cckey}) { |
if ($env{$cckey}) { |
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); |
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')) { |
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { |
&set_adhoc_privileges($cdom,$cnum,$checkrole); |
&set_adhoc_privileges($cdom,$cnum,$checkrole); |
} |
} |
Line 5003 sub allowed {
|
Line 5082 sub allowed {
|
|
|
my $envkey; |
my $envkey; |
if ($thisallowed=~/L/) { |
if ($thisallowed=~/L/) { |
foreach $envkey (keys %env) { |
foreach $envkey (keys(%env)) { |
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { |
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { |
my $courseid=$2; |
my $courseid=$2; |
my $roleid=$1.'.'.$2; |
my $roleid=$1.'.'.$2; |
Line 5294 sub fetch_enrollment_query {
|
Line 5373 sub fetch_enrollment_query {
|
} |
} |
my $host=&hostname($homeserver); |
my $host=&hostname($homeserver); |
my $cmd = ''; |
my $cmd = ''; |
foreach my $affiliate (keys %{$affiliatesref}) { |
foreach my $affiliate (keys(%{$affiliatesref})) { |
$cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%'; |
$cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%'; |
} |
} |
$cmd =~ s/%%$//; |
$cmd =~ s/%%$//; |
Line 5621 sub auto_instcode_defaults {
|
Line 5700 sub auto_instcode_defaults {
|
} |
} |
|
|
return $response; |
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 { |
sub auto_validate_class_sec { |
my ($cdom,$cnum,$owners,$inst_class) = @_; |
my ($cdom,$cnum,$owners,$inst_class) = @_; |
Line 7802 sub symblist {
|
Line 7914 sub symblist {
|
if (($env{'request.course.fn'}) && (%newhash)) { |
if (($env{'request.course.fn'}) && (%newhash)) { |
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', |
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', |
&GDBM_WRCREAT(),0640)) { |
&GDBM_WRCREAT(),0640)) { |
foreach my $url (keys %newhash) { |
foreach my $url (keys(%newhash)) { |
next if ($url eq 'last_known' |
next if ($url eq 'last_known' |
&& $env{'form.no_update_last_known'}); |
&& $env{'form.no_update_last_known'}); |
$hash{declutter($url)}=&encode_symb($mapname, |
$hash{declutter($url)}=&encode_symb($mapname, |