--- loncom/lonnet/perl/lonnet.pm	2009/10/09 12:42:36	1.976.2.10
+++ loncom/lonnet/perl/lonnet.pm	2009/04/11 21:43:02	1.994
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.976.2.10 2009/10/09 12:42:36 raeburn Exp $
+# $Id: lonnet.pm,v 1.994 2009/04/11 21:43:02 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -73,7 +73,8 @@ package Apache::lonnet;
 use strict;
 use LWP::UserAgent();
 use HTTP::Date;
-# use Date::Parse;
+use Image::Magick;
+
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol);
 
@@ -97,6 +98,8 @@ 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);
@@ -146,7 +149,8 @@ sub logthis {
     my $now=time;
     my $local=localtime($now);
     if (open(my $fh,">>$execdir/logs/lonnet.log")) {
-	print $fh "$local ($$): $message\n";
+	my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string.
+	print $fh $logstring;
 	close($fh);
     }
     return 1;
@@ -192,6 +196,33 @@ sub get_server_timezone {
     }
 }
 
+sub get_server_loncaparev {
+    my ($dom,$lonhost) = @_;
+    if (defined($lonhost)) {
+        if (!defined(&hostname($lonhost))) {
+            undef($lonhost);
+        }
+    }
+    if (!defined($lonhost)) {
+        if (defined(&domain($dom,'primary'))) {
+            $lonhost=&domain($dom,'primary');
+            if ($lonhost eq 'no_host') {
+                undef($lonhost);
+            }
+        }
+    }
+    if (defined($lonhost)) {
+        my $cachetime = 24*3600;
+        my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);
+        if (defined($cached)) {
+            return $loncaparev;
+        } else {
+            my $loncaparev = &reply('serverloncaparev',$lonhost);
+            return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);
+        }
+    }
+}
+
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
@@ -535,16 +566,16 @@ sub delenv {
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	foreach my $key (keys(%disk_env)) {
-            if ($regexp) {
+	    if ($regexp) {
                 if ($key=~/^$delthis/) {
                     delete($env{$key});
                     delete($disk_env{$key});
-                }
+                } 
             } else {
                 if ($key=~/^\Q$delthis\E/) {
-                    delete($env{$key});
-                    delete($disk_env{$key});
-                }
+		    delete($env{$key});
+		    delete($disk_env{$key});
+	        }
             }
 	}
 	untie(%disk_env);
@@ -748,8 +779,7 @@ sub changepass {
     my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
     $currentpass = &escape($currentpass);
     $newpass     = &escape($newpass);
-    my $lonhost = $perlvar{'lonHostID'};
-    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context:$lonhost",
+    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
 		       $server);
     if (! $answer) {
 	&logthis("No reply on password change request to $server ".
@@ -774,9 +804,6 @@ sub changepass {
     } elsif ($answer =~ "^refused") {
 	&logthis("$server refused to change $uname in $udom password because ".
 		 "it was sent an unencrypted request to change the password.");
-    } elsif ($answer =~ "invalid_client") {
-        &logthis("$server refused to change $uname in $udom password because ".
-                 "it was a reset by e-mail originating from an invalid server.");
     }
     return $answer;
 }
@@ -1003,27 +1030,34 @@ sub put_dom {
 sub retrieve_inst_usertypes {
     my ($udom) = @_;
     my (%returnhash,@order);
-    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) {
-            my ($key,$value)=split(/=/,$item,2);
-            $key = &unescape($key);
-            next if ($key =~ /^error: 2 /);
-            $returnhash{$key}=&thaw_unescape($value);
-        }
-        my @esc_order = split(/\&/,$orderitems);
-        foreach my $item (@esc_order) {
-            push(@order,&unescape($item));
-        }
+    my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+    if ((ref($domdefs{'inststatustypes'}) eq 'HASH') && 
+        (ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
+        %returnhash = %{$domdefs{'inststatustypes'}};
+        @order = @{$domdefs{'inststatusorder'}};
     } else {
-        &logthis("get_dom failed - no primary domain server for $udom");
+        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) {
+                my ($key,$value)=split(/=/,$item,2);
+                $key = &unescape($key);
+                next if ($key =~ /^error: 2 /);
+                $returnhash{$key}=&thaw_unescape($value);
+            }
+            my @esc_order = split(/\&/,$orderitems);
+            foreach my $item (@esc_order) {
+                push(@order,&unescape($item));
+            }
+        } else {
+            &logthis("get_dom failed - no primary domain server for $udom");
+        }
     }
     return (\%returnhash,\@order);
 }
@@ -1260,7 +1294,8 @@ sub get_domain_defaults {
     }
     my %domdefaults;
     my %domconfig =
-         &Apache::lonnet::get_dom('configuration',['defaults','quotas'],$domain);
+         &Apache::lonnet::get_dom('configuration',['defaults','quotas',
+                                  'requestcourses','inststatus'],$domain);
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1285,6 +1320,16 @@ sub get_domain_defaults {
             }
         }
     }
+    if (ref($domconfig{'requestcourses'}) eq 'HASH') {
+        foreach my $item ('official','unofficial') {
+            $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
+        }
+    }
+    if (ref($domconfig{'inststatus'}) eq 'HASH') {
+        foreach my $item ('inststatustypes','inststatusorder') {
+            $domdefaults{$item} = $domconfig{'inststatus'}{$item};
+        }
+    }
     &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
                                   $cachetime);
     return %domdefaults;
@@ -2036,6 +2081,32 @@ sub clean_filename {
     $fname=~s/\.(\d+)(?=\.)/_$1/g;
     return $fname;
 }
+#This Function check if a Image max 400px width and height 500px. If not then scale the image down
+sub resizeImage {
+	my($img_url) = @_;	
+	my $ima = Image::Magick->new;                       
+        $ima->Read($img_url);
+	if($ima->Get('width') > 400)
+	{
+		my $factor = $ima->Get('width')/400;
+             	$ima->Scale( width=>400, height=>$ima->Get('height')/$factor );
+	}
+	if($ima->Get('height') > 500)
+        {
+        	my $factor = $ima->Get('height')/500;
+                $ima->Scale( width=>$ima->Get('width')/$factor, height=>500);
+        } 
+		
+	$ima->Write($img_url);
+}
+
+#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"}
@@ -2136,6 +2207,7 @@ sub finishuserfileupload {
         $thumbwidth,$thumbheight) = @_;
     my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
+  
     my ($fnamepath,$file,$fetchthumb);
     $file=$fname;
     if ($fname=~m|/|) {
@@ -2150,6 +2222,7 @@ sub finishuserfileupload {
 	    mkdir($filepath,0777);
         }
     }
+
 # Save the file
     {
 	if (!open(FH,'>'.$filepath.'/'.$file)) {
@@ -2163,6 +2236,11 @@ sub finishuserfileupload {
 	    return '/adm/notfound.html';
 	}
 	close(FH);
+	if($upload_photo_form==1)
+	{
+		resizeImage($filepath.'/'.$file);		
+		$upload_photo_form = 0;
+	}
     }
     if ($parser eq 'parse') {
         my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles,
@@ -2184,7 +2262,7 @@ sub finishuserfileupload {
  
 # Notify homeserver to grep it
 #
-    my $docuhome=&homeserver($docuname,$docudom);
+    my $docuhome=&homeserver($docuname,$docudom);	
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
         if ($fetchthumb) {
@@ -2316,21 +2394,21 @@ sub add_filetype {
 }
 
 sub removeuploadedurl {
-    my ($url)=@_;
-    my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
+    my ($url)=@_;	
+    my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);    
     return &removeuserfile($uname,$udom,$fname);
 }
 
 sub removeuserfile {
     my ($docuname,$docudom,$fname)=@_;
-    my $home=&homeserver($docuname,$docudom);
+    my $home=&homeserver($docuname,$docudom);    
     my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home);
-    if ($result eq 'ok') {
+    if ($result eq 'ok') {	
         if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) {
             my $metafile = $fname.'.meta';
             my $metaresult = &removeuserfile($docuname,$docudom,$metafile); 
 	    my $url = "/uploaded/$docudom/$docuname/$fname";
-            my ($file,$group) = (&parse_portfolio_url($url))[3,4];
+            my ($file,$group) = (&parse_portfolio_url($url))[3,4];	   
             my $sqlresult = 
                 &update_portfolio_table($docuname,$docudom,$file,
                                         'portfolio_metadata',$group,
@@ -2628,9 +2706,6 @@ 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;
@@ -2640,6 +2715,7 @@ sub get_course_adv_roles {
     my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));
     my %coursehash=&coursedescription($cid);
+    my $crstype = &Apache::loncommon::course_type($cid);
     my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
         if ($user !~ /:/) {
@@ -2652,7 +2728,6 @@ sub get_course_adv_roles {
     my %dumphash=
             &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
     my $now=time;
-    my %privileged;
     foreach my $entry (keys %dumphash) {
 	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }
@@ -2660,21 +2735,8 @@ sub get_course_adv_roles {
         if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$entry);
 	if ($username eq '' || $domain eq '') { 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 ((&privileged($username,$domain)) && 
+	    (!$nothide{$username.':'.$domain})) { next; }
 	if ($role eq 'cr') { next; }
         if ($codes) {
             if ($section) { $role .= ':'.$section; }
@@ -2684,7 +2746,7 @@ sub get_course_adv_roles {
                 $returnhash{$role}=$username.':'.$domain;
             }
         } else {
-            my $key=&plaintext($role);
+            my $key=&plaintext($role,$crstype);
             if ($section) { $key.=' ('.&Apache::lonlocal::mt('Section [_1]',$section).')'; }
             if ($returnhash{$key}) {
 	        $returnhash{$key}.=','.$username.':'.$domain;
@@ -2719,7 +2781,6 @@ sub get_my_roles {
     }
     my %returnhash=();
     my $now=time;
-    my %privileged;
     foreach my $entry (keys(%dumphash)) {
         my ($role,$tend,$tstart);
         if ($context eq 'userroles') {
@@ -2768,32 +2829,9 @@ sub get_my_roles {
             }
         }
         if ($hidepriv) {
-            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 ((&privileged($username,$domain)) &&
+                (!$nothide{$username.':'.$domain})) { 
+                next;
             }
         }
         if ($withsec) {
@@ -3842,6 +3880,67 @@ sub set_userprivs {
     return ($author,$adv);
 }
 
+sub role_status {
+    my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+    my @pwhere = ();
+    if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
+        (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
+        unless (!defined($$role) || $$role eq '') {
+            $$where=join('.',@pwhere);
+            $$trolecode=$$role.'.'.$$where;
+            ($$tstart,$$tend)=split(/\./,$env{$rolekey});
+            $$tstatus='is';
+            if ($$tstart && $$tstart>$then) {
+                $$tstatus='future';
+                if ($$tstart<$now) { $$tstatus='will'; }
+            }
+            if ($$tend) {
+                if ($$tend<$then) {
+                    $$tstatus='expired';
+                } elsif ($$tend<$now) {
+                    $$tstatus='will_not';
+                }
+            }
+        }
+    }
+}
+
+sub check_adhoc_privs {
+    my ($cdom,$cnum,$then,$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);
+        unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
+            &set_adhoc_privileges($cdom,$cnum,$checkrole);
+        }
+    } else {
+        &set_adhoc_privileges($cdom,$cnum,$checkrole);
+    }
+}
+
+sub set_adhoc_privileges {
+# role can be cc or ca
+    my ($dcdom,$pickedcourse,$role) = @_;
+    my $area = '/'.$dcdom.'/'.$pickedcourse;
+    my $spec = $role.'.'.$area;
+    my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
+                                  $env{'user.name'});
+    my %ccrole = ();
+    &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
+    my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+    &appenv(\%userroles,[$role,'cm']);
+    &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+    &appenv( {'request.role'        => $spec,
+              'request.role.domain' => $dcdom,
+              'request.course.sec'  => ''
+             }
+           );
+    my $tadv=0;
+    if (&allowed('adv') eq 'F') { $tadv=1; }
+    &appenv({'request.role.adv'    => $tadv});
+}
+
 # --------------------------------------------------------------- get interface
 
 sub get {
@@ -3877,11 +3976,11 @@ sub del {
    foreach my $item (@$storearr) {
        $items.=&escape($item).'&';
    }
+
    $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
-
    return &reply("del:$udomain:$uname:$namespace:$items",$uhome);
 }
 
@@ -4442,13 +4541,23 @@ sub is_portfolio_file {
 }
 
 sub usertools_access {
-    my ($uname,$udom,$tool,$action) = @_;
-    my $access;
-    my %tools = (
-                  aboutme   => 1,
-                  blog      => 1,
-                  portfolio => 1,
-                );
+    my ($uname,$udom,$tool,$action,$context) = @_;
+    my ($access,%tools);
+    if ($context eq '') {
+        $context = 'tools';
+    }
+    if ($context eq 'requestcourses') {
+        %tools = (
+                      official   => 1,
+                      unofficial => 1,
+                 );
+    } else {
+        %tools = (
+                      aboutme   => 1,
+                      blog      => 1,
+                      portfolio => 1,
+                 );
+    }
     return if (!defined($tools{$tool}));
 
     if ((!defined($udom)) || (!defined($uname))) {
@@ -4458,18 +4567,23 @@ sub usertools_access {
 
     if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
         if ($action ne 'reload') {
-            return $env{'environment.availabletools.'.$tool};
+            if ($context eq 'requestcourses') {
+                return $env{'environment.canrequest.'.$tool};
+            } else {
+                return $env{'environment.availabletools.'.$tool};
+            }
         }
     }
 
     my ($toolstatus,$inststatus);
 
-    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
-        $toolstatus = $env{'environment.tools.'.$tool};
+    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
+         ($action ne 'reload')) {
+        $toolstatus = $env{'environment.'.$context.'.'.$tool};
         $inststatus = $env{'environment.inststatus'};
     } else {
-        my %userenv = &userenvironment($udom,$uname,'tools.'.$tool);
-        $toolstatus = $userenv{'tools.'.$tool};
+        my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool);
+        $toolstatus = $userenv{$context.'.'.$tool};
         $inststatus = $userenv{'inststatus'};
     }
 
@@ -4525,7 +4639,11 @@ sub usertools_access {
             }
         }
     } else {
-        $access = 1;
+        if ($context eq 'tools') {
+            $access = 1;
+        } else {
+            $access = 0;
+        }
         return $access;
     }
 }
@@ -5650,16 +5768,19 @@ sub devalidate_getgroups_cache {
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {
-    my ($short,$type,$cid) = @_;
+    my ($short,$type,$cid,$forcedefault) = @_;
     if ($short =~ /^cr/) {
 	return (split('/',$short))[-1];
     }
     if (!defined($cid)) {
         $cid = $env{'request.course.id'};
     }
-    if (defined($cid) && defined($env{'course.'.$cid.'.'.$short.'.plaintext'})) {
-        return &Apache::lonlocal::mt($env{'course.'.$cid.'.'.$short.
-                                          '.plaintext'});
+    if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) {
+        unless ($forcedefault) {
+            my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; 
+            &Apache::lonlocal::mt_escape(\$roletext);
+            return &Apache::lonlocal::mt($roletext);
+        }
     }
     my %rolenames = (
                       Course => 'std',
@@ -5880,7 +6001,21 @@ sub modifyuser {
        if ($email=~/\@/) { $names{'permanentemail'} = $email; }
     }
     if ($uid) { $names{'id'}  = $uid; }
-    if (defined($inststatus)) { $names{'inststatus'} = $inststatus; } 
+    if (defined($inststatus)) {
+        $names{'inststatus'} = '';
+        my ($usertypes,$typesorder) = &retrieve_inst_usertypes($udom);
+        if (ref($usertypes) eq 'HASH') {
+            my @okstatuses; 
+            foreach my $item (split(/:/,$inststatus)) {
+                if (defined($usertypes->{$item})) {
+                    push(@okstatuses,$item);  
+                }
+            }
+            if (@okstatuses) {
+                $names{'inststatus'} = join(':', map { &escape($_); } @okstatuses);
+            }
+        }
+    }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);
@@ -5902,7 +6037,7 @@ sub modifyuser {
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
         $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
-        $selfenroll,$context)=@_;
+        $selfenroll,$context,$inststatus)=@_;
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
 	    return 'not_in_class';
@@ -5911,7 +6046,7 @@ sub modifystudent {
 # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser
 	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
-         $desiredhome,$email);
+         $desiredhome,$email,$inststatus);
     unless ($reply eq 'ok') { return $reply; }
     # This will cause &modify_student_enrollment to get the uid from the
     # students environment
@@ -8999,6 +9134,31 @@ sub get_dns {
 
 	return %iphost;
     }
+
+    #
+    #  Given a DNS returns the loncapa host name for that DNS 
+    # 
+    sub host_from_dns {
+        my ($dns) = @_;
+        my @hosts;
+        my $ip;
+
+        if (exists($name_to_ip{$dns})) {
+            $ip = $name_to_ip{$dns};
+        }
+        if (!$ip) {
+            $ip = gethostbyname($dns); # Initial translation to IP is in net order.
+            if (length($ip) == 4) { 
+	        $ip   = &IO::Socket::inet_ntoa($ip);
+            }
+        }
+        if ($ip) {
+	    @hosts = get_hosts_from_ip($ip);
+	    return $hosts[0];
+        }
+        return undef;
+    }
+
 }
 
 BEGIN {
@@ -9281,9 +9441,9 @@ in the user's environment.db and in %env
 =item *
 X<delenv()>
 B<delenv($delthis,$regexp)>: removes all items from the session
-environment file that begin with $delthis. If the
-optional second arg - $regexp - is true, $delthis is treated as a
-regular expression, otherwise \Q$delthis\E is used.
+environment file that begin with $delthis. If the 
+optional second arg - $regexp - is true, $delthis is treated as a 
+regular expression, otherwise \Q$delthis\E is used. 
 The values are also deleted from the current processes %env.
 
 =item * get_env_multiple($name) 
@@ -9381,9 +9541,14 @@ and course level
 
 =item *
 
-plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
-explanation of a user role term
-
+plaintext($short,$type,$cid,$forcedefault) : return value in %prp hash 
+(rolesplain.tab); plain text explanation of a user role term.
+$type is Course (default) or Group.
+If $forcedefault evaluates to true, text returned will be default 
+text for $type. Otherwise, if this is a course, the text returned 
+will be a custom name for the role (if defined in the course's 
+environment).  If no custom name is defined the default is returned.
+   
 =item *
 
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :
@@ -9892,8 +10057,15 @@ dirlist($uri) : return directory list ba
 
 spareserver() : find server with least workload from spare.tab
 
+
+=item *
+
+host_from_dns($dns) : Returns the loncapa hostname corresponding to a DNS name or undef
+if there is no corresponding loncapa host.
+
 =back
 
+
 =head2 Apache Request
 
 =over 4