--- loncom/lonnet/perl/lonnet.pm	2008/04/04 16:56:11	1.954
+++ loncom/lonnet/perl/lonnet.pm	2008/12/18 16:58:31	1.978
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.954 2008/04/04 16:56:11 raeburn Exp $
+# $Id: lonnet.pm,v 1.978 2008/12/18 16:58:31 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -27,19 +27,62 @@
 #
 ###
 
+=pod
+
+=head1 NAME
+
+Apache::lonnet.pm
+
+=head1 SYNOPSIS
+
+This file is an interface to the lonc processes of
+the LON-CAPA network as well as set of elaborated functions for handling information
+necessary for navigating through a given cluster of LON-CAPA machines within a
+domain. There are over 40 specialized functions in this module which handle the
+reading and transmission of metadata, user information (ids, names, environments, roles,
+logs), file information (storage, reading, directories, extensions, replication, embedded
+styles and descriptors), educational resources (course descriptions, section names and
+numbers), url hashing (to assign roles on a url basis), and translating abbreviated symbols to
+and from more descriptive phrases or explanations.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 Package Variables
+
+These are largely undocumented, so if you decipher one please note it here.
+
+=over 4
+
+=item $processmarker
+
+Contains the time this process was started and this servers host id.
+
+=item $dumpcount
+
+Counts the number of times a message log flush has been attempted (regardless
+of success) by this process.  Used as part of the filename when messages are
+delayed.
+
+=back
+
+=cut
+
 package Apache::lonnet;
 
 use strict;
 use LWP::UserAgent();
 use HTTP::Date;
+use Image::Magick;
+
 # use Date::Parse;
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
-            $_64bit %env);
+            $_64bit %env %protocol);
 
 my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
     %userrolehash, $processmarker, $dumpcount, %coursedombuf,
     %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
-    %courseownerbuf, %coursetypebuf);
+    %courseownerbuf, %coursetypebuf,$locknum);
 
 use IO::Socket;
 use GDBM_File;
@@ -56,56 +99,38 @@ use LONCAPA::Configuration;
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
+my $upload_photo_form = 0; #Variable to check  when user upload a photo 0=not 1=true
+
 require Exporter;
 
 our @ISA = qw (Exporter);
 our @EXPORT = qw(%env);
 
-=pod
-
-=head1 Package Variables
-
-These are largely undocumented, so if you decipher one please note it here.
-
-=over 4
-
-=item $processmarker
-
-Contains the time this process was started and this servers host id.
-
-=item $dumpcount
-
-Counts the number of times a message log flush has been attempted (regardless
-of success) by this process.  Used as part of the filename when messages are
-delayed.
-
-=back
-
-=cut
-
 
 # --------------------------------------------------------------------- Logging
 {
     my $logid;
     sub instructor_log {
-	my ($hash_name,$storehash,$delflag,$uname,$udom)=@_;
+	my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
+        if (($cnum eq '') || ($cdom eq '')) {
+            $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+        }
 	$logid++;
-	my $id=time().'00000'.$$.'00000'.$logid;
+        my $now = time();
+	my $id=$now.'00000'.$$.'00000'.$logid;
 	return &Apache::lonnet::put('nohist_'.$hash_name,
 				    { $id => {
 					'exe_uname' => $env{'user.name'},
 					'exe_udom'  => $env{'user.domain'},
-					'exe_time'  => time(),
+					'exe_time'  => $now,
 					'exe_ip'    => $ENV{'REMOTE_ADDR'},
 					'delflag'   => $delflag,
 					'logentry'  => $storehash,
 					'uname'     => $uname,
 					'udom'      => $udom,
 				    }
-				  },
-				    $env{'course.'.$env{'request.course.id'}.'.domain'},
-				    $env{'course.'.$env{'request.course.id'}.'.num'}
-				    );
+				  },$cdom,$cnum);
     }
 }
 
@@ -524,6 +549,51 @@ sub get_env_multiple {
     return(@values);
 }
 
+# ------------------------------------------------------------------- Locking
+
+sub set_lock {
+    my ($text)=@_;
+    $locknum++;
+    my $id=$$.'-'.$locknum;
+    &appenv({'session.locks' => $env{'session.locks'}.','.$id,
+             'session.lock.'.$id => $text});
+    return $id;
+}
+
+sub get_locks {
+    my $num=0;
+    my %texts=();
+    foreach my $lock (split(/\,/,$env{'session.locks'})) {
+       if ($lock=~/\w/) {
+          $num++;
+          $texts{$lock}=$env{'session.lock.'.$lock};
+       }
+   }
+   return ($num,%texts);
+}
+
+sub remove_lock {
+    my ($id)=@_;
+    my $newlocks='';
+    foreach my $lock (split(/\,/,$env{'session.locks'})) {
+       if (($lock=~/\w/) && ($lock ne $id)) {
+          $newlocks.=','.$lock;
+       }
+    }
+    &appenv({'session.locks' => $newlocks});
+    &delenv('session.lock.'.$id);
+}
+
+sub remove_all_locks {
+    my $activelocks=$env{'session.locks'};
+    foreach my $lock (split(/\,/,$env{'session.locks'})) {
+       if ($lock=~/\w/) {
+          &remove_lock($lock);
+       }
+    }
+}
+
+
 # ------------------------------------------ Find out current server userload
 sub userload {
     my $numusers=0;
@@ -596,7 +666,11 @@ sub spareserver {
     }
 
     if (!$want_server_name) {
-	$spare_server="http://".&hostname($spare_server);
+        my $protocol = 'http';
+        if ($protocol{$spare_server} eq 'https') {
+            $protocol = $protocol{$spare_server};
+        }
+	$spare_server = $protocol.'://'.&hostname($spare_server);
     }
     return $spare_server;
 }
@@ -911,6 +985,10 @@ sub retrieve_inst_usertypes {
     if (defined(&domain($udom,'primary'))) {
         my $uhome=&domain($udom,'primary');
         my $rep=&reply("inst_usertypes:$udom",$uhome);
+        if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
+            &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
+            return (\%returnhash,\@order);
+        }
         my ($hashitems,$orderitems) = split(/:/,$rep); 
         my @pairs=split(/\&/,$hashitems);
         foreach my $item (@pairs) {
@@ -1148,12 +1226,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') {
@@ -1162,7 +1240,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'};
@@ -1172,6 +1250,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;
@@ -1496,9 +1587,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++) {
@@ -1839,7 +1935,7 @@ sub process_coursefile {
             print $fh $env{'form.'.$source};
             close($fh);
             if ($parser eq 'parse') {
-                my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
+                my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
                 unless ($parse_result eq 'ok') {
                     &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
                 }
@@ -1919,6 +2015,14 @@ sub clean_filename {
     return $fname;
 }
 
+#Wrapper function for userphotoupload
+sub userphotoupload
+{
+	my($formname,$subdir) = @_;
+	$upload_photo_form = 1;
+	return &userfileupload($formname,undef,$subdir);
+}
+
 # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}
 #                    the desired filenam is in $env{"form.$formname.filename"}
@@ -2045,9 +2149,28 @@ sub finishuserfileupload {
 	    return '/adm/notfound.html';
 	}
 	close(FH);
+	if($upload_photo_form==1)
+	{
+		my $ima = Image::Magick->new;                       
+            	$ima->Read($filepath.'/'.$file);
+		if($ima->Get('width') > 300)
+		{
+			my $factor = $ima->Get('width')/300;
+             		$ima->Scale( width=>300, height=>$ima->Get('height')/$factor );
+		}
+		if($ima->Get('height') > 400)
+                {
+                        my $factor = $ima->Get('height')/400;
+                        $ima->Scale( width=>$ima->Get('width')/$factor, height=>400);
+                }
+ 
+		
+		$ima->Write($filepath.'/'.$file);
+		$upload_photo_form = 0;
+	}
     }
     if ($parser eq 'parse') {
-        my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,
+        my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles,
 						   $codebase);
         unless ($parse_result eq 'ok') {
             &logthis('Failed to parse '.$filepath.$file.
@@ -2087,7 +2210,7 @@ sub finishuserfileupload {
 }
 
 sub extract_embedded_items {
-    my ($filepath,$file,$allfiles,$codebase,$content) = @_;
+    my ($fullpath,$allfiles,$codebase,$content) = @_;
     my @state = ();
     my %javafiles = (
                       codebase => '',
@@ -2102,7 +2225,7 @@ sub extract_embedded_items {
     if ($content) {
         $p = HTML::LCParser->new($content);
     } else {
-        $p = HTML::LCParser->new($filepath.'/'.$file);
+        $p = HTML::LCParser->new($fullpath);
     }
     while (my $t=$p->get_token()) {
 	if ($t->[0] eq 'S') {
@@ -2415,7 +2538,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:) {
@@ -2480,6 +2608,36 @@ sub userrolelog {
     }
 }
 
+sub courserolelog {
+    my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;
+    if (($trole eq 'cc') || ($trole eq 'in') ||
+        ($trole eq 'ep') || ($trole eq 'ad') ||
+        ($trole eq 'ta') || ($trole eq 'st') ||
+        ($trole=~/^cr/) || ($trole eq 'gr')) {
+        if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
+            my $cdom = $1;
+            my $cnum = $2;
+            my $sec = $3;
+            my $namespace = 'rolelog';
+            my %storehash = (
+                               role    => $trole,
+                               start   => $tstart,
+                               end     => $tend,
+                               selfenroll => $selfenroll,
+                               context    => $context,
+                            );
+            if ($trole eq 'gr') {
+                $namespace = 'groupslog';
+                $storehash{'group'} = $sec;
+            } else {
+                $storehash{'section'} = $sec;
+            }
+            &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
+        }
+    }
+    return;
+}
+
 sub get_course_adv_roles {
     my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));
@@ -2515,7 +2673,7 @@ sub get_course_adv_roles {
             }
         } else {
             my $key=&plaintext($role);
-            if ($section) { $key.=' (Section '.$section.')'; }
+            if ($section) { $key.=' ('.&Apache::lonlocal::mt('Section [_1]',$section).')'; }
             if ($returnhash{$key}) {
 	        $returnhash{$key}.=','.$username.':'.$domain;
             } else {
@@ -2685,7 +2843,7 @@ sub courseidput {
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
         $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
-        $selfenrollonly)=@_;
+        $selfenrollonly,$catfilter,$showhidden,$caller)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -2703,7 +2861,8 @@ sub courseiddump {
                          &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).
                          ':'.&escape($regexp_ok).':'.$as_hash.':'.
-                         &escape($selfenrollonly),$tryserver);
+                         &escape($selfenrollonly).':'.&escape($catfilter).':'.
+                         $showhidden.':'.$caller,$tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -3479,12 +3638,13 @@ sub privileged {
 
 sub rolesinit {
     my ($domain,$username,$authhost)=@_;
+    my %userroles;
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return \%userroles; }
     my %allroles=();
     my %allgroups=();   
     my $now=time;
-    my %userroles = ('user.login.time' => $now);
+    %userroles = ('user.login.time' => $now);
     my $group_privs;
 
     if ($rolesdump ne '') {
@@ -4245,6 +4405,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
 
@@ -4457,7 +4740,6 @@ sub allowed {
     }
     
 # Full access at system, domain or course-wide level? Exit.
-
     if ($thisallowed=~/F/) {
 	return 'F';
     }
@@ -4810,6 +5092,9 @@ sub log_query {
 
 sub update_portfolio_table {
     my ($uname,$udom,$file_name,$query,$group,$action) = @_;
+    if ($group ne '') {
+        $file_name =~s /^\Q$group\E//;
+    }
     my $homeserver = &homeserver($uname,$udom);
     my $queryid=
         &reply("querysend:".$query.':'.&escape($uname.':'.$udom.':'.$group).
@@ -5236,11 +5521,11 @@ sub toggle_coursegroup_status {
 }
 
 sub modify_group_roles {
-    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_;
+    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context) = @_;
     my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
     my $role = 'gr/'.&escape($userprivs);
     my ($uname,$udom) = split(/:/,$user);
-    my $result = &assignrole($udom,$uname,$url,$role,$end,$start);
+    my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context);
     if ($result eq 'ok') {
         &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
     }
@@ -5356,7 +5641,8 @@ sub plaintext {
 # ----------------------------------------------------------------- Assign Role
 
 sub assignrole {
-    my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll)=@_;
+    my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
+        $context)=@_;
     my $mrole;
     if ($role =~ /^cr\//) {
         my $cwosec=$url;
@@ -5415,6 +5701,7 @@ sub assignrole {
     }
     my $origstart = $start;
     my $origend = $end;
+    my $delflag;
 # actually delete
     if ($deleteflag) {
 	if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {
@@ -5425,6 +5712,7 @@ sub assignrole {
 # set start and finish to negative values for userrolelog
            $start=-1;
            $end=-1;
+           $delflag = 1;
         }
     }
 # send command
@@ -5433,9 +5721,10 @@ sub assignrole {
     if ($answer eq 'ok') {
 	&userrolelog($role,$uname,$udom,$url,$start,$end);
 # for course roles, perform group memberships changes triggered by role change.
+        &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context);
         unless ($role =~ /^gr/) {
             &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
-                                             $origstart);
+                                             $origstart,$selfenroll,$context);
         }
     }
     return $answer;
@@ -5473,7 +5762,7 @@ sub modifyuser {
     my ($udom,    $uname, $uid,
         $umode,   $upass, $first,
         $middle,  $last,  $gene,
-        $forceid, $desiredhome, $email)=@_;
+        $forceid, $desiredhome, $email, $inststatus)=@_;
     $udom= &LONCAPA::clean_domain($udom);
     $uname=&LONCAPA::clean_username($uname);
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
@@ -5534,7 +5823,7 @@ sub modifyuser {
 # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',
 		   ['firstname','middlename','lastname','generation','id',
-                    'permanentemail'],
+                    'permanentemail','inststatus'],
 		   $udom,$uname);
     my %names;
     if ($tmp[0] =~ m/^error:.*/) { 
@@ -5552,19 +5841,23 @@ sub modifyuser {
     if (defined($gene))   { $names{'generation'} = $gene; }
     if ($email) {
        $email=~s/[^\w\@\.\-\,]//gs;
-       if ($email=~/\@/) { $names{'notification'} = $email;
-			   $names{'critnotification'} = $email;
-			   $names{'permanentemail'} = $email; }
+       if ($email=~/\@/) { $names{'permanentemail'} = $email; }
     }
     if ($uid) { $names{'id'}  = $uid; }
+    if (defined($inststatus)) { $names{'inststatus'} = $inststatus; } 
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);
     &devalidate_cache_new('namescache',$uname.':'.$udom);
-    &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
-             $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.' by '.
-             $env{'user.name'}.' at '.$env{'user.domain'});
+    my $logmsg = 'Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
+                 $umode.', '.$first.', '.$middle.', '.
+	         $last.', '.$gene.', '.$email.', '.$inststatus;
+    if ($env{'user.name'} ne '' && $env{'user.domain'}) {
+        $logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'};
+    } else {
+        $logmsg .= ' during self creation';
+    }
+    &logthis($logmsg);
     return 'ok';
 }
 
@@ -5572,7 +5865,8 @@ sub modifyuser {
 
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-        $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid)=@_;
+        $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
+        $selfenroll,$context)=@_;
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
 	    return 'not_in_class';
@@ -5587,12 +5881,12 @@ sub modifystudent {
     # students environment
     $uid = undef if (!$forceid);
     $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
-					$gene,$usec,$end,$start,$type,$locktype,$cid);
+					$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context);
     return $reply;
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll) = @_;
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context) = @_;
     my ($cdom,$cnum,$chome);
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
@@ -5650,7 +5944,7 @@ sub modify_student_enrollment {
     if ($usec) {
 	$uurl.='/'.$usec;
     }
-    return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll);
+    return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll,$context);
 }
 
 sub format_name {
@@ -5779,33 +6073,41 @@ sub is_course {
 # ---------------------------------------------------------- Assign Custom Role
 
 sub assigncustomrole {
-    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag)=@_;
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,$selfenroll,$context)=@_;
     return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
-                       $end,$start,$deleteflag);
+                       $end,$start,$deleteflag,$selfenroll,$context);
 }
 
 # ----------------------------------------------------------------- Revoke Role
 
 sub revokerole {
-    my ($udom,$uname,$url,$role,$deleteflag)=@_;
+    my ($udom,$uname,$url,$role,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;
-    return &assignrole($udom,$uname,$url,$role,$now,$deleteflag);
+    return &assignrole($udom,$uname,$url,$role,$now,undef,$deleteflag,$selfenroll,$context);
 }
 
 # ---------------------------------------------------------- Revoke Custom Role
 
 sub revokecustomrole {
-    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag)=@_;
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;
     return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now,
-           $deleteflag);
+           $deleteflag,$selfenroll,$context);
 }
 
 # ------------------------------------------------------------ Disk usage
 sub diskusage {
-    my ($udom,$uname,$directoryRoot)=@_;
-    $directoryRoot =~ s/\/$//;
-    my $listing=&reply('du:'.$directoryRoot,homeserver($uname,$udom));
+    my ($udom,$uname,$directorypath,$getpropath)=@_;
+    $directorypath =~ s/\/$//;
+    my $listing=&reply('du2:'.&escape($directorypath).':'
+                       .&escape($getpropath).':'.&escape($uname).':'
+                       .&escape($udom),homeserver($uname,$udom));
+    if ($listing eq 'unknown_cmd') {
+        if ($getpropath) {
+            $directorypath = &propath($udom,$uname).'/'.$directorypath; 
+        }
+        $listing = &reply('du:'.$directorypath,homeserver($uname,$udom));
+    }
     return $listing;
 }
 
@@ -6046,20 +6348,18 @@ sub modify_access_controls {
                 }
             }
         }
+        my ($group);
+        if (&is_course($domain,$user)) {
+            ($group,my $file) = split(/\//,$file_name,2);
+        }
         $deloutcome = &del('file_permissions',\@deletions,$domain,$user);
         $new_values{$file_name."\0".'accesscontrol'} = \%new_control;
         $outcome = &put('file_permissions',\%new_values,$domain,$user);
         #  remove lock
         my @del_lock = ($file_name."\0".'locked_access_records');
         my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user);
-        my ($file,$group);
-        if (&is_course($domain,$user)) {
-            ($group,$file) = split(/\//,$file_name,2);
-        } else {
-            $file = $file_name;
-        }
         my $sqlresult =
-            &update_portfolio_table($user,$domain,$file,'portfolio_access',
+            &update_portfolio_table($user,$domain,$file_name,'portfolio_access',
                                     $group);
     } else {
         $outcome = "error: could not obtain lockfile\n";  
@@ -6222,30 +6522,49 @@ sub unmark_as_readonly {
 # ------------------------------------------------------------ Directory lister
 
 sub dirlist {
-    my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;
-
+    my ($uri,$userdomain,$username,$getpropath,$getuserdir,$alternateRoot)=@_;
     $uri=~s/^\///;
     $uri=~s/\/$//;
     my ($udom, $uname);
-    (undef,$udom,$uname)=split(/\//,$uri);
-    if(defined($userdomain)) {
+    if ($getuserdir) {
         $udom = $userdomain;
-    }
-    if(defined($username)) {
         $uname = $username;
+    } else {
+        (undef,$udom,$uname)=split(/\//,$uri);
+        if(defined($userdomain)) {
+            $udom = $userdomain;
+        }
+        if(defined($username)) {
+            $uname = $username;
+        }
     }
+    my ($dirRoot,$listing,@listing_results);
 
-    my $dirRoot = $perlvar{'lonDocRoot'};
-    if(defined($alternateDirectoryRoot)) {
-        $dirRoot = $alternateDirectoryRoot;
+    $dirRoot = $perlvar{'lonDocRoot'};
+    if (defined($getpropath)) {
+        $dirRoot = &propath($udom,$uname);
         $dirRoot =~ s/\/$//;
+    } elsif (defined($getuserdir)) {
+        my $subdir=$uname.'__';
+        $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+        $dirRoot = $Apache::lonnet::perlvar{'lonUsersDir'}
+                   ."/$udom/$subdir/$uname";
+    } elsif (defined($alternateRoot)) {
+        $dirRoot = $alternateRoot;
     }
 
     if($udom) {
         if($uname) {
-            my $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
-				 &homeserver($uname,$udom));
-            my @listing_results;
+            $listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':'
+                              .$getuserdir.':'.&escape($dirRoot)
+                              .':'.&escape($uname).':'.&escape($udom),
+                              &homeserver($uname,$udom));
+            if ($listing eq 'unknown_cmd') {
+                $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
+                                  &homeserver($uname,$udom));
+            } else {
+                @listing_results = map { &unescape($_); } split(/:/,$listing);
+            }
             if ($listing eq 'unknown_cmd') {
                 $listing = &reply('ls:'.$dirRoot.'/'.$uri,
 				  &homeserver($uname,$udom));
@@ -6254,13 +6573,18 @@ sub dirlist {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);
             }
             return @listing_results;
-        } elsif(!defined($alternateDirectoryRoot)) {
+        } elsif(!$alternateRoot) {
             my %allusers;
 	    my %servers = &get_servers($udom,'library');
-	    foreach my $tryserver (keys(%servers)) {
-		my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
-				     $udom, $tryserver);
-		my @listing_results;
+ 	    foreach my $tryserver (keys(%servers)) {
+                $listing = &reply('ls3:'.&escape("/res/$udom").':::::'.
+                                  &escape($udom),$tryserver);
+                if ($listing eq 'unknown_cmd') {
+		    $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
+				      $udom, $tryserver);
+                } else {
+                    @listing_results = map { &unescape($_); } split(/:/,$listing);
+                }
 		if ($listing eq 'unknown_cmd') {
 		    $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
 				      $udom, $tryserver);
@@ -6287,13 +6611,13 @@ sub dirlist {
         } else {
             return ('missing user name');
         }
-    } elsif(!defined($alternateDirectoryRoot)) {
+    } elsif(!defined($getpropath)) {
         my @all_domains = sort(&all_domains());
-         foreach my $domain (@all_domains) {
-             $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
-         }
-         return @all_domains;
-     } else {
+        foreach my $domain (@all_domains) {
+            $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
+        }
+        return @all_domains;
+    } else {
         return ('missing domain');
     }
 }
@@ -6303,23 +6627,13 @@ sub dirlist {
 # when it was last modified.  It will also return an error of -1
 # if an error occurs
 
-##
-## FIXME: This subroutine assumes its caller knows something about the
-## directory structure of the home server for the student ($root).
-## Not a good assumption to make.  Since this is for looking up files
-## in user directories, the full path should be constructed by lond, not
-## whatever machine we request data from.
-##
 sub GetFileTimestamp {
-    my ($studentDomain,$studentName,$filename,$root)=@_;
+    my ($studentDomain,$studentName,$filename,$getuserdir)=@_;
     $studentDomain = &LONCAPA::clean_domain($studentDomain);
     $studentName   = &LONCAPA::clean_username($studentName);
-    my $subdir=$studentName.'__';
-    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
-    my $proname="$studentDomain/$subdir/$studentName";
-    $proname .= '/'.$filename;
-    my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain, 
-                                              $studentName, $root);
+    my ($fileStat) = 
+        &Apache::lonnet::dirlist($filename,$studentDomain,$studentName, 
+                                 undef,$getuserdir);
     my @stats = split('&', $fileStat);
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
         # @stats contains first the filename, then the stat output
@@ -6333,12 +6647,11 @@ sub stat_file {
     my ($uri) = @_;
     $uri = &clutter_with_no_wrapper($uri);
 
-    my ($udom,$uname,$file,$dir);
+    my ($udom,$uname,$file);
     if ($uri =~ m-^/(uploaded|editupload)/-) {
 	($udom,$uname,$file) =
 	    ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-);
 	$file = 'userfiles/'.$file;
-	$dir = &propath($udom,$uname);
     }
     if ($uri =~ m-^/res/-) {
 	($udom,$uname) = 
@@ -6350,8 +6663,11 @@ sub stat_file {
 	# unable to handle the uri
 	return ();
     }
-
-    my ($result) = &dirlist($file,$udom,$uname,$dir);
+    my $getpropath;
+    if ($file =~ /^userfiles\//) {
+        $getpropath = 1;
+    }
+    my ($result) = &dirlist($file,$udom,$uname,$getpropath);
     my @stats = split('&', $result);
     
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
@@ -8096,6 +8412,8 @@ sub filelocation {
     } elsif ($file=~m{^/home/$match_username/public_html/}) {
 	# is a correct contruction space reference
         $location = $file;
+    } elsif ($file =~ m-^\Q$Apache::lonnet::perlvar{'lonTabDir'}\E/-) {
+        $location = $file;
     } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=
   	    ($file=~m -^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$-);
@@ -8104,8 +8422,7 @@ sub filelocation {
         my @ids=&current_machine_ids();
         foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
         if ($is_me) {
-  	    $location=&propath($udom,$uname).
-  	      '/userfiles/'.$filename;
+  	    $location=&propath($udom,$uname).'/userfiles/'.$filename;
         } else {
   	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
   	      $udom.'/'.$uname.'/'.$filename;
@@ -8403,6 +8720,12 @@ sub get_dns {
 	}
 	return $domain{$name}{$what};
     }
+
+    sub domain_info {
+        &load_domain_tab() if (!$loaded);
+        return %domain;
+    }
+
 }
 
 
@@ -8420,13 +8743,22 @@ sub get_dns {
 	    next if ($configline =~ /^(\#|\s*$ )/x);
 	    next if ($configline =~ /^\^/);
 	    chomp($configline);
-	    my ($id,$domain,$role,$name)=split(/:/,$configline);
+	    my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {
 		$hostname{$id}=$name;
 		push(@{$name_to_host{$name}}, $id);
 		$hostdom{$id}=$domain;
 		if ($role eq 'library') { $libserv{$id}=$name; }
+                if (defined($protocol)) {
+                    if ($protocol eq 'https') {
+                        $protocol{$id} = $protocol;
+                    } else {
+                        $protocol{$id} = 'http'; 
+                    }
+                } else {
+                    $protocol{$id} = 'http';
+                }
 	    }
 	}
     }
@@ -8471,6 +8803,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);
 
@@ -8701,6 +9038,7 @@ $memcache=new Cache::Memcached({'servers
 
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;
+$locknum=0;
 
 &logtouch();
 &logthis('<font color="yellow">INFO: Read configuration</font>');
@@ -8868,7 +9206,7 @@ when the connection is brought back up
 =item * B<con_failed>: unable to contact remote host and unable to save message
 for later delivery
 
-=item * B<error:>: an error a occured, a description of the error follows the :
+=item * B<error:>: an error a occurred, a description of the error follows the :
 
 =item * B<no_such_host>: unable to fund a host associated with the user/domain
 that was requested
@@ -9018,7 +9356,7 @@ provided for types, will default to retu
 
 =item *
 
-assignrole($udom,$uname,$url,$role,$end,$start) : assign role; give a role to a
+assignrole($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,$context) : assign role; give a role to a
 user for the level given by URL.  Optional start and end dates (leave empty
 string or zero for "no date")
 
@@ -9035,14 +9373,15 @@ modifyuserauth($udom,$uname,$umode,$upas
 
 =item *
 
-modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) : 
+modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,
+           $forceid,$desiredhome,$email,$inststatus) : 
 modify user
 
 =item *
 
 modifystudent
 
-modify a students enrollment and identification information.
+modify a student's enrollment and identification information.
 The course id is resolved based on the current users environment.  
 This means the envoking user must be a course coordinator or otherwise
 associated with a course.
@@ -9054,25 +9393,25 @@ Inputs:
 
 =over 4
 
-=item B<$udom> Students loncapa domain
+=item B<$udom> Student's loncapa domain
 
-=item B<$uname> Students loncapa login name
+=item B<$uname> Student's loncapa login name
 
-=item B<$uid> Students id/student number
+=item B<$uid> Student/Employee ID
 
-=item B<$umode> Students authentication mode
+=item B<$umode> Student's authentication mode
 
-=item B<$upass> Students password
+=item B<$upass> Student's password
 
-=item B<$first> Students first name
+=item B<$first> Student's first name
 
-=item B<$middle> Students middle name
+=item B<$middle> Student's middle name
 
-=item B<$last> Students last name
+=item B<$last> Student's last name
 
-=item B<$gene> Students generation
+=item B<$gene> Student's generation
 
-=item B<$usec> Students section in course
+=item B<$usec> Student's section in course
 
 =item B<$end> Unix time of the roles expiration
 
@@ -9082,6 +9421,20 @@ Inputs:
 
 =item B<$desiredhome> server to use as home server for student
 
+=item B<$email> Student's permanent e-mail address
+
+=item B<$type> Type of enrollment (auto or manual)
+
+=item B<$locktype> boolean - enrollment type locked to prevent Autoenroll.pl changing manual to auto    
+
+=item B<$cid> courseID - needed if a course role is assigned by a user whose current role is DC
+
+=item B<$selfenroll> boolean - 1 if user role change occurred via self-enrollment
+
+=item B<$context> role change context (shown in User Management Logs display in a course)
+
+=item B<$inststatus> institutional status of user - : separated string of escaped status types  
+
 =back
 
 =item *
@@ -9115,6 +9468,16 @@ Inputs:
 
 =item $start
 
+=item $type
+
+=item $locktype
+
+=item $cid
+
+=item $selfenroll
+
+=item $context
+
 =back
 
 
@@ -9423,7 +9786,7 @@ Returns:
  'key_exists: <key>' -> failed to anything out of $storehash, as at
                         least <key> already existed in the db (other
                         requested keys may also already exist)
- 'error: <msg>' -> unable to tie the DB or other erorr occured
+ 'error: <msg>' -> unable to tie the DB or other error occurred
  'con_lost' -> unable to contact request server
  'refused' -> action was not allowed by remote machine