--- loncom/lonnet/perl/lonnet.pm 2017/01/02 19:44:20 1.1332 +++ loncom/lonnet/perl/lonnet.pm 2017/08/08 15:33:13 1.1348 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1332 2017/01/02 19:44:20 raeburn Exp $ +# $Id: lonnet.pm,v 1.1348 2017/08/08 15:33:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -71,7 +71,6 @@ delayed. package Apache::lonnet; use strict; -use LWP::UserAgent(); use HTTP::Date; use Image::Magick; @@ -101,6 +100,7 @@ use LONCAPA qw(:DEFAULT :match); use LONCAPA::Configuration; use LONCAPA::lonmetadata; use LONCAPA::Lond; +use LONCAPA::LWPReq; use File::Copy; @@ -243,6 +243,10 @@ sub get_servercerts_info { if ($1 < 6) { $uselocal = 0; } + } elsif ($distro =~ /^(?:sles)(\d+)$/) { + if ($1 < 12) { + $uselocal = 0; + } } } if ($uselocal) { @@ -305,13 +309,11 @@ sub get_server_loncaparev { $answer = &reply('serverloncaparev',$lonhost); if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) { if ($caller eq 'loncron') { - my $ua=new LWP::UserAgent; - $ua->timeout(4); my $protocol = $protocol{$lonhost}; $protocol = 'http' if ($protocol ne 'https'); my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html'; my $request=new HTTP::Request('GET',$url); - my $response=$ua->request($request); + my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1); unless ($response->is_error()) { my $content = $response->content; if ($content =~ /

VERSION\:\s*([\w.\-]+)<\/p>/) { @@ -650,10 +652,23 @@ sub transfer_profile_to_env { sub check_for_valid_session { my ($r,$name,$userhashref) = @_; my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); + my ($linkname,$pubname); if ($name eq '') { $name = 'lonID'; + $linkname = 'lonLinkID'; + $pubname = 'lonPubID'; } my $lonid=$cookies{$name}; + if (!$lonid) { + if (($name eq 'lonID') && ($ENV{'SERVER_PORT'} != 443) && ($linkname)) { + $lonid=$cookies{$linkname}; + } + if (!$lonid) { + if (($name eq 'lonID') && ($pubname)) { + $lonid=$cookies{$pubname}; + } + } + } return undef if (!$lonid); my $handle=&LONCAPA::clean_handle($lonid->value); @@ -1583,6 +1598,100 @@ sub internet_dom_servers { return %uniqservers; } +sub trusted_domains { + my ($cmdtype,$calldom) = @_; + my (%trusted,%untrusted); + if (&domain($calldom) eq '') { + return (\%trusted,\%untrusted); + } + unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) { + return (\%trusted,\%untrusted); + } + my $callprimary = &domain($calldom,'primary'); + my $intcalldom = &Apache::lonnet::internet_dom($callprimary); + if ($intcalldom eq '') { + return (\%trusted,\%untrusted); + } + + my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom); + unless (defined($cached)) { + my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom); + &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600); + $trustconfig = $domconfig{'trust'}; + } + if (ref($trustconfig)) { + my (%possexc,%possinc,@allexc,@allinc); + if (ref($trustconfig->{$cmdtype}) eq 'HASH') { + if (ref($trustconfig->{$cmdtype}->{'exc'}) eq 'ARRAY') { + map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; + } + if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') { + map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}}; + } + } + if (keys(%possexc)) { + if (keys(%possinc)) { + foreach my $key (sort(keys(%possexc))) { + next if ($key eq $intcalldom); + unless ($possinc{$key}) { + push(@allexc,$key); + } + } + } else { + @allexc = sort(keys(%possexc)); + } + } + if (keys(%possinc)) { + $possinc{$intcalldom} = 1; + @allinc = sort(keys(%possinc)); + } + if ((@allexc > 0) || (@allinc > 0)) { + my %doms_by_intdom; + my %allintdoms = &all_host_intdom(); + my %alldoms = &all_host_domain(); + foreach my $key (%allintdoms) { + if (ref($doms_by_intdom{$allintdoms{$key}}) eq 'ARRAY') { + unless (grep(/^\Q$alldoms{$key}\E$/,@{$doms_by_intdom{$allintdoms{$key}}})) { + push(@{$doms_by_intdom{$allintdoms{$key}}},$alldoms{$key}); + } + } else { + $doms_by_intdom{$allintdoms{$key}} = [$alldoms{$key}]; + } + } + foreach my $exc (@allexc) { + if (ref($doms_by_intdom{$exc}) eq 'ARRAY') { + map { $untrusted{$_}; } @{$doms_by_intdom{$exc}}; + } + } + foreach my $inc (@allinc) { + if (ref($doms_by_intdom{$inc}) eq 'ARRAY') { + map { $trusted{$_}; } @{$doms_by_intdom{$inc}}; + } + } + } + } + return(\%trusted,\%untrusted); +} + +sub will_trust { + my ($cmdtype,$domain,$possdom) = @_; + return 1 if ($domain eq $possdom); + my ($trustedref,$untrustedref) = &trusted_domains($cmdtype,$possdom); + my $willtrust; + if ((ref($trustedref) eq 'ARRAY') && (@{$trustedref} > 0)) { + if (grep(/^\Q$domain\E$/,@{$trustedref})) { + $willtrust = 1; + } + } elsif ((ref($untrustedref) eq 'ARRAY') && (@{$untrustedref} > 0)) { + unless (grep(/^\Q$domain\E$/,@{$untrustedref})) { + $willtrust = 1; + } + } else { + $willtrust = 1; + } + return $willtrust; +} + # ---------------------- Find the homebase for a user from domain's lib servers my %homecache; @@ -1832,7 +1941,12 @@ sub get_dom { } } if ($udom && $uhome && ($uhome ne 'no_host')) { - my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + my $rep; + if ($namespace =~ /^enc/) { + $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); + } else { + $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + } my %returnhash; if ($rep eq '' || $rep =~ /^error: 2 /) { return %returnhash; @@ -1876,7 +1990,11 @@ sub put_dom { $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; } $items=~s/\&$//; - return &reply("putdom:$udom:$namespace:$items",$uhome); + if ($namespace =~ /^enc/) { + return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome); + } else { + return &reply("putdom:$udom:$namespace:$items",$uhome); + } } else { &logthis("put_dom failed - no homeserver and/or domain"); } @@ -1973,7 +2091,7 @@ sub inst_directory_query { &escape($srch->{'srchtype'}),$homeserver); my $host=&hostname($homeserver); if ($queryid !~/^\Q$host\E\_/) { - &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom); + &logthis('institutional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.' in domain '.$udom); return; } my $response = &get_query_reply($queryid); @@ -2256,6 +2374,9 @@ sub get_domain_defaults { $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'}; + $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'}; + $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'}; + $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'}; } else { $domdefaults{'lang_def'} = &domain($domain,'lang_def'); $domdefaults{'auth_def'} = &domain($domain,'auth_def'); @@ -2377,8 +2498,11 @@ sub get_domain_defaults { if (ref($domconfig{'ssl'}{'replication'}) eq 'HASH') { $domdefaults{'replication'} = $domconfig{'ssl'}{'replication'}; } - if (ref($domconfig{'ssl'}{'connect'}) eq 'HASH') { - $domdefaults{'connect'} = $domconfig{'ssl'}{'connect'}; + if (ref($domconfig{'ssl'}{'connto'}) eq 'HASH') { + $domdefaults{'connect'} = $domconfig{'ssl'}{'connto'}; + } + if (ref($domconfig{'ssl'}{'connfrom'}) eq 'HASH') { + $domdefaults{'connect'} = $domconfig{'ssl'}{'connfrom'}; } } if (ref($domconfig{'trust'}) eq 'HASH') { @@ -2925,9 +3049,13 @@ sub repcopy { mkdir($path,0777); } } - my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',"$remoteurl"); - my $response=$ua->request($request,$transname); + my $response; + if ($remoteurl =~ m{/raw/}) { + $response=&LONCAPA::LWPReq::makerequest($home,$request,$transname,\%perlvar,'',0,1); + } else { + $response=&LONCAPA::LWPReq::makerequest($home,$request,$transname,\%perlvar,'',1); + } if ($response->is_error()) { unlink($transname); my $message=$response->status_line; @@ -2937,7 +3065,12 @@ sub repcopy { } else { if ($remoteurl!~/\.meta$/) { my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta'); - my $mresponse=$ua->request($mrequest,$filename.'.meta'); + my $mresponse; + if ($remoteurl =~ m{/raw/}) { + $mresponse = &LONCAPA::LWPReq::makerequest($home,$mrequest,$filename.'.meta',\%perlvar,'',0,1); + } else { + $mresponse = &LONCAPA::LWPReq::makerequest($home,$mrequest,$filename.'.meta',\%perlvar,'',1); + } if ($mresponse->is_error()) { unlink($filename.'.meta'); &logthis( @@ -3000,7 +3133,6 @@ sub absolute_url { sub ssi { my ($fn,%form)=@_; - my $ua=new LWP::UserAgent; my $request; $form{'no_update_last_known'}=1; @@ -3018,22 +3150,20 @@ sub ssi { } $request->header(Cookie => $ENV{'HTTP_COOKIE'}); - my $response= $ua->request($request); - my $content = $response->content; - + my $lonhost = $perlvar{'lonHostID'}; + my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar); if (wantarray) { - return ($content, $response); + return ($response->content, $response); } else { - return $content; + return $response->content; } } sub externalssi { my ($url)=@_; - my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',$url); - my $response=$ua->request($request); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar); if (wantarray) { return ($response->content, $response); } else { @@ -3179,7 +3309,7 @@ sub can_edit_resource { $forceedit = 1; } $cfile = $resurl; - } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) { + } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) { $incourse = 1; if ($env{'form.forceedit'}) { $forceview = 1; @@ -3211,7 +3341,7 @@ sub can_edit_resource { $forceedit = 1; } $cfile = $resurl; - } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) && ($env{'form.folderpath'} =~ /^supplemental/)) { + } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) { $incourse = 1; if ($env{'form.forceedit'}) { $forceview = 1; @@ -3229,7 +3359,7 @@ sub can_edit_resource { } else { $cfile = $env{'form.suppurl'}; my $escfile = &unescape($cfile); - if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/exttools?$}) { + if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { $cfile = '/adm/wrapper'.$escfile; } else { $escfile =~ s{^http://}{}; @@ -4116,7 +4246,7 @@ sub flushcourselogs { } } # -# Reverse lookup of domain roles (dc, ad, li, sc, dh, au) +# Reverse lookup of domain roles (dc, ad, li, sc, dh, da, au) # my %domrolebuffer = (); foreach my $entry (keys(%domainrolehash)) { @@ -4263,7 +4393,7 @@ sub userrolelog { {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} =$tend.':'.$tstart; } - if ($trole =~ /^(dc|ad|li|au|dg|sc|dh)/ ) { + if ($trole =~ /^(dc|ad|li|au|dg|sc|dh|da)/ ) { my (undef,$rudom,$runame,$rsec)=split(/\//,$area); $domainrolehash {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} @@ -4490,53 +4620,91 @@ sub get_my_roles { return %returnhash; } +sub get_all_adhocroles { + my ($dom) = @_; + my @roles_by_num = (); + my %domdefaults = &get_domain_defaults($dom); + my (%description,%access_in_dom,%access_info); + if (ref($domdefaults{'adhocroles'}) eq 'HASH') { + my $count = 0; + my %domcurrent = %{$domdefaults{'adhocroles'}}; + my %ordered; + foreach my $role (sort(keys(%domcurrent))) { + my ($order,$desc,$access_in_dom); + if (ref($domcurrent{$role}) eq 'HASH') { + $order = $domcurrent{$role}{'order'}; + $desc = $domcurrent{$role}{'desc'}; + $access_in_dom{$role} = $domcurrent{$role}{'access'}; + $access_info{$role} = $domcurrent{$role}{$access_in_dom{$role}}; + } + if ($order eq '') { + $order = $count; + } + $ordered{$order} = $role; + if ($desc ne '') { + $description{$role} = $desc; + } else { + $description{$role}= $role; + } + $count++; + } + foreach my $item (sort {$a <=> $b } (keys(%ordered))) { + push(@roles_by_num,$ordered{$item}); + } + } + return (\@roles_by_num,\%description,\%access_in_dom,\%access_info); +} + sub get_my_adhocroles { - my ($cid) = @_; - my (@possroles,%description); - if ($cid =~ /^($match_domain)_($match_courseid)$/) { - my $cdom = $1; - my $cnum = $2; - if ($env{"user.role.dh./$cdom/"}) { + my ($cid,$checkreg) = @_; + my ($cdom,$cnum,%info,@possroles,$description,$roles_by_num); + if ($env{'request.course.id'} eq $cid) { + $cdom = $env{'course.'.$cid.'.domain'}; + $cnum = $env{'course.'.$cid.'.num'}; + $info{'internal.coursecode'} = $env{'course.'.$cid.'.internal.coursecode'}; + } elsif ($cid =~ /^($match_domain)_($match_courseid)$/) { + $cdom = $1; + $cnum = $2; + %info = &Apache::lonnet::get('environment',['internal.coursecode'], + $cdom,$cnum); + } + if (($info{'internal.coursecode'} ne '') && ($checkreg)) { + my $user = $env{'user.name'}.':'.$env{'user.domain'}; + my %rosterhash = &get('classlist',[$user],$cdom,$cnum); + if ($rosterhash{$user} ne '') { + my $type = (split(/:/,$rosterhash{$user}))[5]; + return ([],{}) if ($type eq 'auto'); + } + } + if (($cdom ne '') && ($cnum ne '')) { + if (($env{"user.role.dh./$cdom/"}) || ($env{"user.role.da./$cdom/"})) { my $then=$env{'user.login.time'}; my $update=$env{'user.update.time'}; - my $liverole = 1; - my ($tstart,$tend)=split(/\./,$env{'user.role.dh./'.$cdom}); - my $limit = $update; - if ($env{'request.role'} eq 'dh./'.$cdom.'/') { - $limit = $then; - } - if ($tstart && $tstart>$limit) { $liverole = 0; } - if ($tend && $tend <$limit) { $liverole = 0; } - if ($liverole) { + if (!$update) { + $update = $then; + } + my @liveroles; + foreach my $role ('dh','da') { + if ($env{"user.role.$role./$cdom/"}) { + my ($tstart,$tend)=split(/\./,$env{"user.role.$role./$cdom/"}); + my $limit = $update; + if ($env{'request.role'} eq "$role./$cdom/") { + $limit = $then; + } + my $activerole = 1; + if ($tstart && $tstart>$limit) { $activerole = 0; } + if ($tend && $tend <$limit) { $activerole = 0; } + if ($activerole) { + push(@liveroles,$role); + } + } + } + if (@liveroles) { if (&homeserver($cnum,$cdom) ne 'no_host') { - my %domdefaults = &get_domain_defaults($cdom); - if (ref($domdefaults{'adhocroles'}) eq 'HASH') { - my $count = 0; - my %domcurrent = %{$domdefaults{'adhocroles'}}; - my (%ordered,%access_in_dom); - foreach my $role (sort(keys(%domcurrent))) { - my ($order,$desc,$access_in_dom); - if (ref($domcurrent{$role}) eq 'HASH') { - $order = $domcurrent{$role}{'order'}; - $desc = $domcurrent{$role}{'desc'}; - $access_in_dom{$role} = $domcurrent{$role}{'access'}; - } - if ($order eq '') { - $order = $count; - } - $ordered{$order} = $role; - if ($desc ne '') { - $description{$role} = $desc; - } else { - $description{$role}= $role; - } - $count++; - } - my @roles_by_num = (); - foreach my $item (sort {$a <=> $b } (keys(%ordered))) { - push(@roles_by_num,$ordered{$item}); - } - if (@roles_by_num) { + my ($accessref,$accessinfo,%access_in_dom); + ($roles_by_num,$description,$accessref,$accessinfo) = &get_all_adhocroles($cdom); + if (ref($roles_by_num) eq 'ARRAY') { + if (@{$roles_by_num}) { my %settings; if ($env{'request.course.id'} eq $cid) { foreach my $envkey (keys(%env)) { @@ -4556,7 +4724,10 @@ sub get_my_adhocroles { @statuses = split(/,/,$env{'environment.inststatus'}); } my $user = $env{'user.name'}.':'.$env{'user.domain'}; - foreach my $role (@roles_by_num) { + if (ref($accessref) eq 'HASH') { + %access_in_dom = %{$accessref}; + } + foreach my $role (@{$roles_by_num}) { my ($curraccess,@okstatus,@personnel); if ($setincrs{$role}) { ($curraccess,my $rest) = split(/=/,$settings{'internal.adhoc.'.$role}); @@ -4567,13 +4738,15 @@ sub get_my_adhocroles { } } else { $curraccess = $access_in_dom{$role}; - if ($curraccess eq 'status') { - if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') { - @okstatus = @{$domcurrent{$role}{$curraccess}}; - } - } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) { - if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') { - @personnel = @{$domcurrent{$role}{$curraccess}}; + if (ref($accessinfo) eq 'HASH') { + if ($curraccess eq 'status') { + if (ref($accessinfo->{$role}) eq 'ARRAY') { + @okstatus = @{$accessinfo->{$role}}; + } + } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) { + if (ref($accessinfo->{$role}) eq 'ARRAY') { + @personnel = @{$accessinfo->{$role}}; + } } } } @@ -4581,6 +4754,18 @@ sub get_my_adhocroles { next; } elsif ($curraccess eq 'all') { push(@possroles,$role); + } elsif ($curraccess eq 'dh') { + if (grep(/^dh$/,@liveroles)) { + push(@possroles,$role); + } else { + next; + } + } elsif ($curraccess eq 'da') { + if (grep(/^da$/,@liveroles)) { + push(@possroles,$role); + } else { + next; + } } elsif ($curraccess eq 'status') { if (@okstatus) { if (!@statuses) { @@ -4612,7 +4797,16 @@ sub get_my_adhocroles { } } } - return (\@possroles,\%description); + unless (ref($description) eq 'HASH') { + if (ref($roles_by_num) eq 'ARRAY') { + my %desc; + map { $desc{$_} = $_; } (@{$roles_by_num}); + $description = \%desc; + } else { + $description = {}; + } + } + return (\@possroles,$description); } # ----------------------------------------------------- Frontpage Announcements @@ -5724,9 +5918,10 @@ sub rolesinit { } } - @userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles, - \%allroles, \%allgroups); + @userroles{'user.author','user.adv','user.rar'} = &set_userprivs(\%userroles, + \%allroles, \%allgroups); $env{'user.adv'} = $userroles{'user.adv'}; + $env{'user.rar'} = $userroles{'user.rar'}; return (\%userroles,\%firstaccenv,\%timerintenv); } @@ -5850,6 +6045,7 @@ sub set_userprivs { my ($userroles,$allroles,$allgroups,$groups_roles) = @_; my $author=0; my $adv=0; + my $rar=0; my %grouproles = (); if (keys(%{$allgroups}) > 0) { my @groupkeys; @@ -5897,6 +6093,7 @@ sub set_userprivs { $thesepriv{$privilege}.=$restrictions; } if ($thesepriv{'adv'} eq 'F') { $adv=1; } + if ($thesepriv{'rar'} eq 'F') { $rar=1; } } } my $thesestr=''; @@ -5905,7 +6102,7 @@ sub set_userprivs { } $userroles->{'user.priv.'.$role} = $thesestr; } - return ($author,$adv); + return ($author,$adv,$rar); } sub role_status { @@ -5950,9 +6147,10 @@ sub role_status { push(@rolecodes,$$role); &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where); } - my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles); + my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%allroles,\%allgroups, + \%groups_roles); &appenv(\%userroles,\@rolecodes); - &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); + &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec); } } $$tstatus = 'is'; @@ -6071,9 +6269,9 @@ sub set_adhoc_privileges { } else { &standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area); } - my ($author,$adv)= &set_userprivs(\%userroles,\%rolehash); + my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash); &appenv(\%userroles,[$role,'cm']); - &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); + &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec); unless ($caller eq 'constructaccess' && $env{'request.course.id'}) { &appenv( {'request.role' => $spec, 'request.role.domain' => $dcdom, @@ -6227,7 +6425,7 @@ sub currentdump { # my %returnhash=(); # - if ($rep eq "unknown_cmd") { + if ($rep eq 'unknown_cmd') { # an old lond will not know currentdump # Do a dump and make it look like a currentdump my @tmp = &dumpstore($courseid,$sdom,$sname,'.'); @@ -7161,7 +7359,7 @@ sub allowed { if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } # Free bre access to adm and meta resources - if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) + if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$})) || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) && ($priv eq 'bre')) { return 'F'; @@ -9086,7 +9284,8 @@ sub assignrole { &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, $selfenroll,$context); } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') || - ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh')) { + ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh') || + ($role eq 'da')) { &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, $context); } elsif (($role eq 'ca') || ($role eq 'aa')) { @@ -10868,6 +11067,16 @@ sub get_domain_ltitools { my %domconfig = &get_dom('configuration',['ltitools'],$cdom); if (ref($domconfig{'ltitools'}) eq 'HASH') { %ltitools = %{$domconfig{'ltitools'}}; + my %encdomconfig = &get_dom('encconfig',['ltitools'],$cdom); + if (ref($encdomconfig{'ltitools'}) eq 'HASH') { + foreach my $id (keys(%ltitools)) { + if (ref($encdomconfig{'ltitools'}{$id}) eq 'HASH') { + foreach my $item ('key','secret') { + $ltitools{$id}{$item} = $encdomconfig{'ltitools'}{$id}{$item}; + } + } + } + } } my $cachetime = 24*60*60; &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime); @@ -11377,7 +11586,7 @@ sub metadata { # if it is a non metadata possible uri return quickly if (($uri eq '') || (($uri =~ m|^/*adm/|) && - ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|exttools?)$})) || + ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) || ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { return undef; } @@ -12653,7 +12862,6 @@ sub repcopy_userfile { } # now the path exists for sure # get a user agent - my $ua=new LWP::UserAgent; my $transferfile=$file.'.in.transfer'; # FIXME: this should flock if (-e $transferfile) { return 'ok'; } @@ -12663,7 +12871,7 @@ sub repcopy_userfile { my $protocol = $protocol{$homeserver}; $protocol = 'http' if ($protocol ne 'https'); $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri); - my $response=$ua->request($request,$transferfile); + my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,$transferfile,\%perlvar,'',0,1); # did it work? if ($response->is_error()) { unlink($transferfile); @@ -12707,9 +12915,8 @@ sub getuploaded { my $protocol = $protocol{$homeserver}; $protocol = 'http' if ($protocol ne 'https'); $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri; - my $ua=new LWP::UserAgent; my $request=new HTTP::Request($reqtype,$uri); - my $response=$ua->request($request); + my $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1); $$rtncode = $response->code; if (! $response->is_success()) { return 'failed'; @@ -12910,7 +13117,7 @@ sub clutter { # &logthis("Got a blank emb style"); } } - } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/exttools?$}) { + } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) { $thisfn='/adm/wrapper'.$thisfn; } return $thisfn; @@ -12997,10 +13204,8 @@ sub get_dns { } while (%alldns) { my ($dns) = sort { $b cmp $a } keys(%alldns); - my $ua=new LWP::UserAgent; - $ua->timeout(30); my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); - my $response=$ua->request($request); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0); delete($alldns{$dns}); next if ($response->is_error()); my @content = split("\n",$response->content); @@ -13182,6 +13387,7 @@ sub fetch_dns_checksums { &purge_remembered(); &reset_domain_info(); &reset_hosts_ip_info(); + undef(%internetdom); undef(%name_to_host); undef(%hostname); undef(%hostdom); @@ -13224,6 +13430,11 @@ sub fetch_dns_checksums { return %hostdom; } + sub all_host_intdom { + &load_hosts_tab() if (!$loaded); + return %internetdom; + } + sub is_library { &load_hosts_tab() if (!$loaded);