--- loncom/lonnet/perl/lonnet.pm	2008/11/28 12:09:16	1.973
+++ loncom/lonnet/perl/lonnet.pm	2008/12/21 15:26:50	1.976.2.3
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.973 2008/11/28 12:09:16 bisitz Exp $
+# $Id: lonnet.pm,v 1.976.2.3 2008/12/21 15:26:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1222,12 +1222,12 @@ sub inst_userrules {
     return (\%ruleshash,\@ruleorder);
 }
 
-# ------------------------- Get Authentication and Language Defaults for Domain
+# ------------- Get Authentication, Language and User Tools Defaults for Domain
 
 sub get_domain_defaults {
     my ($domain) = @_;
     my $cachetime = 60*60*24;
-    my ($defauthtype,$defautharg,$deflang);
+    my ($defauthtype,$defautharg,$deflang,%deftools);
     my ($result,$cached)=&is_cached_new('domdefaults',$domain);
     if (defined($cached)) {
         if (ref($result) eq 'HASH') {
@@ -1236,7 +1236,7 @@ sub get_domain_defaults {
     }
     my %domdefaults;
     my %domconfig =
-         &Apache::lonnet::get_dom('configuration',['defaults'],$domain);
+         &Apache::lonnet::get_dom('configuration',['defaults','quotas'],$domain);
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1246,6 +1246,19 @@ sub get_domain_defaults {
         $domdefaults{'auth_def'} = &domain($domain,'auth_def');
         $domdefaults{'auth_arg_def'} = &domain($domain,'auth_arg_def');
     }
+    if (ref($domconfig{'quotas'}) eq 'HASH') {
+        if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') {
+            $domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'};
+        } else {
+            $domdefaults{'defaultquota'} = $domconfig{'quotas'};
+        } 
+        my @usertools = ('aboutme','blog','portfolio');
+        foreach my $item (@usertools) {
+            if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
+                $domdefaults{$item} = $domconfig{'quotas'}{$item};
+            }
+        }
+    }
     &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
                                   $cachetime);
     return %domdefaults;
@@ -1570,9 +1583,14 @@ sub purge_remembered {
 
 sub userenvironment {
     my ($udom,$unam,@what)=@_;
+    my $items;
+    foreach my $item (@what) {
+        $items.=&escape($item).'&';
+    }
+    $items=~s/\&$//;
     my %returnhash=();
     my @answer=split(/\&/,
-                &reply('get:'.$udom.':'.$unam.':environment:'.join('&',@what),
+                &reply('get:'.$udom.':'.$unam.':environment:'.$items,
                       &homeserver($unam,$udom)));
     my $i;
     for ($i=0;$i<=$#what;$i++) {
@@ -1769,7 +1787,7 @@ sub ssi_body {
     }
     my $output='';
     my $response;
-    if ($filelink=~/^http\:/) {
+    if ($filelink=~/^https?\:/) {
        ($output,$response)=&externalssi($filelink);
     } else {
        ($output,$response)=&ssi($filelink,%form);
@@ -2489,7 +2507,12 @@ sub courseacclog {
         # FIXME: Probably ought to escape things....
 	foreach my $key (keys(%env)) {
             if ($key=~/^form\.(.*)/) {
-		$what.=':'.$1.'='.$env{$key};
+                my $formitem = $1;
+                if ($formitem =~ /^HWFILE(?:SIZE|TOOBIG)/) {
+                    $what.=':'.$formitem.'='.$env{$key};
+                } elsif ($formitem !~ /^HWFILE(?:[^.]+)$/) {
+                    $what.=':'.$formitem.'='.$env{$key};
+                }
             }
         }
     } elsif ($fnsymb =~ m:^/adm/searchcat:) {
@@ -4351,6 +4374,129 @@ sub is_portfolio_file {
     return;
 }
 
+sub usertools_access {
+    my ($uname,$udom,$tool,$action) = @_;
+    my $access;
+    my %tools = (
+                  aboutme   => 1,
+                  blog      => 1,
+                  portfolio => 1,
+                );
+    return if (!defined($tools{$tool}));
+
+    if ((!defined($udom)) || (!defined($uname))) {
+        $udom = $env{'user.domain'};
+        $uname = $env{'user.name'};
+    }
+
+    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+        if ($action ne 'reload') {
+            return $env{'environment.availabletools.'.$tool};
+        }
+    }
+
+    my ($toolstatus,$inststatus);
+
+    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+        $toolstatus = $env{'environment.tools.'.$tool};
+        $inststatus = $env{'environment.inststatus'};
+    } else {
+        my %userenv = &userenvironment($udom,$uname,'tools.'.$tool);
+        $toolstatus = $userenv{'tools.'.$tool};
+        $inststatus = $userenv{'inststatus'};
+    }
+
+    if ($toolstatus ne '') {
+        if ($toolstatus) {
+            $access = 1;
+        } else {
+            $access = 0;
+        }
+        return $access;
+    }
+
+    my $is_adv = &is_advanced_user($udom,$uname);
+    my %domdef = &get_domain_defaults($udom);
+    if (ref($domdef{$tool}) eq 'HASH') {
+        if ($is_adv) {
+            if ($domdef{$tool}{'_LC_adv'} ne '') {
+                if ($domdef{$tool}{'_LC_adv'}) { 
+                    $access = 1;
+                } else {
+                    $access = 0;
+                }
+                return $access;
+            }
+        }
+        if ($inststatus ne '') {
+            my ($hasaccess,$hasnoaccess);
+            foreach my $affiliation (split(/:/,$inststatus)) {
+                if ($domdef{$tool}{$affiliation} ne '') { 
+                    if ($domdef{$tool}{$affiliation}) {
+                        $hasaccess = 1;
+                    } else {
+                        $hasnoaccess = 1;
+                    }
+                }
+            }
+            if ($hasaccess || $hasnoaccess) {
+                if ($hasaccess) {
+                    $access = 1;
+                } elsif ($hasnoaccess) {
+                    $access = 0; 
+                }
+                return $access;
+            }
+        } else {
+            if ($domdef{$tool}{'default'} ne '') {
+                if ($domdef{$tool}{'default'}) {
+                    $access = 1;
+                } elsif ($domdef{$tool}{'default'} == 0) {
+                    $access = 0;
+                }
+                return $access;
+            }
+        }
+    } else {
+        $access = 1;
+        return $access;
+    }
+}
+
+sub is_advanced_user {
+    my ($udom,$uname) = @_;
+    my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
+    my %allroles;
+    my $is_adv;
+    foreach my $role (keys(%roleshash)) {
+        my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
+        my $area = '/'.$tdomain.'/'.$trest;
+        if ($sec ne '') {
+            $area .= '/'.$sec;
+        }
+        if (($area ne '') && ($trole ne '')) {
+            my $spec=$trole.'.'.$area;
+            if ($trole =~ /^cr\//) {
+                &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+            } elsif ($trole ne 'gr') {
+                &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
+            }
+        }
+    }
+    foreach my $role (keys(%allroles)) {
+        last if ($is_adv);
+        foreach my $item (split(/:/,$allroles{$role})) {
+            if ($item ne '') {
+                my ($privilege,$restrictions)=split(/&/,$item);
+                if ($privilege eq 'adv') {
+                    $is_adv = 1;
+                    last;
+                }
+            }
+        }
+    }
+    return $is_adv;
+}
 
 # ---------------------------------------------- Custom access rule evaluation
 
@@ -8155,7 +8301,10 @@ sub repcopy_userfile {
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
-    $request=new HTTP::Request('GET','http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri);
+    my $homeserver = &homeserver($cnum,$cdom);
+    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);
 # did it work?
     if ($response->is_error()) {
@@ -8170,7 +8319,7 @@ sub repcopy_userfile {
 
 sub tokenwrapper {
     my $uri=shift;
-    $uri=~s|^http\://([^/]+)||;
+    $uri=~s|^https?\://([^/]+)||;
     $uri=~s|^/||;
     $env{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;
@@ -8178,7 +8327,10 @@ sub tokenwrapper {
     if ($udom && $uname && $file) {
 	$file=~s|(\?\.*)*$||;
         &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});
-        return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri.
+        my $homeserver = &homeserver($uname,$udom);
+        my $protocol = $protocol{$homeserver};
+        $protocol = 'http' if ($protocol ne 'https');
+        return $protocol.'://'.&hostname($homeserver).'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};
     } else {
@@ -8193,7 +8345,10 @@ sub tokenwrapper {
 sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;
-    $uri = 'http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri;
+    my $homeserver = &homeserver($cnum,$cdom);
+    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);
@@ -8275,7 +8430,7 @@ sub filelocation {
 
 sub hreflocation {
     my ($dir,$file)=@_;
-    unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
+    unless (($file=~m-^https?\://-i) || ($file=~m-^/-)) {
 	$file=filelocation($dir,$file);
     } elsif ($file=~m-^/adm/-) {
 	$file=~s-^/adm/wrapper/-/-;
@@ -8471,14 +8626,19 @@ sub get_dns {
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
     foreach my $dns (<$config>) {
 	next if ($dns !~ /^\^(\S*)/x);
-	$alldns{$1} = 1;
+        my $line = $1;
+        my ($host,$protocol) = split(/:/,$line);
+        if ($protocol ne 'https') {
+            $protocol = 'http';
+        }
+	$alldns{$host} = $protocol;
     }
     while (%alldns) {
 	my ($dns) = keys(%alldns);
-	delete($alldns{$dns});
 	my $ua=new LWP::UserAgent;
-	my $request=new HTTP::Request('GET',"http://$dns$url");
+	my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
 	my $response=$ua->request($request);
+        delete($alldns{$dns});
 	next if ($response->is_error());
 	my @content = split("\n",$response->content);
 	&Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
@@ -8543,6 +8703,12 @@ sub get_dns {
 	}
 	return $domain{$name}{$what};
     }
+
+    sub domain_info {
+        &load_domain_tab() if (!$loaded);
+        return %domain;
+    }
+
 }
 
 
@@ -8620,6 +8786,11 @@ sub get_dns {
 	return %name_to_host;
     }
 
+    sub all_host_domain {
+        &load_hosts_tab() if (!$loaded);
+        return %hostdom;
+    }
+
     sub is_library {
 	&load_hosts_tab() if (!$loaded);