[LON-CAPA-cvs] cvs: modules /gerd signon.pl

[www]

www		Mon Jul 22 12:56:29 2002 EDT

  Modified files:              
    /modules/gerd	signon.pl 
  Log:
  Some more needed routines, but no functionality yet.
  
  
Index: modules/gerd/signon.pl
diff -u modules/gerd/signon.pl:1.1 modules/gerd/signon.pl:1.2
--- modules/gerd/signon.pl:1.1	Mon Jul 22 08:28:08 2002
+++ modules/gerd/signon.pl	Mon Jul 22 12:56:29 2002
@@ -45,6 +45,103 @@
     return $answer;
 }
 
+
+# ------------- Modified routines from lonnet to make a new student in a course
+
+
+# ----------------------------------------------------------------- Assign Role
+
+sub assignrole {
+    my ($uname,$url,$role,$end,$start)=@_;
+    my $mrole;
+
+    my $command="encrypt:rolesput:$demodomain:auto:".
+                "$demodomain:$uname:$url".'_'."$mrole=$role";
+    if ($end) { $command.='_'.$end; }
+    if ($start) {
+	if ($end) { 
+           $command.='_'.$start; 
+        } else {
+           $command.='_0_'.$start;
+        }
+    }
+    return &reply($command,$demohome);
+}
+
+# --------------------------------------------------------------- Modify a user
+
+sub modifyuser {
+    my ($uname, $upass, $first,  $last)=@_;
+    my $udom=$demodomain;
+    my $desiredhome=$demohome;
+    my $middle='';
+    my $gene='';
+    my $umode='internal';
+    $udom=~s/\W//g;
+    $uname=~s/\W//g;
+    &logthis('Call to modify user '.$udom.', '.$uname.', '.
+             $umode.', '.$first.', '.
+	     $last.', '.
+             (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
+                                     ' desiredhome not specified'). 
+             ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
+    my $uhome=$demohome;
+# ----------------------------------------------------------------- Create User
+    if (($uhome eq 'no_host') && ($umode) && ($upass)) {
+        my $unhome=$desiredhome;
+        if (($unhome eq '') || ($unhome eq 'no_host')) {
+	    return 'error: unable to find a home server for '.$uname.
+                   ' in domain '.$udom;
+        }
+        my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'.
+                         &escape($upass),$unhome);
+	unless ($reply eq 'ok') {
+            return 'error: '.$reply;
+        }   
+        $uhome=&homeserver($uname,$udom,'true');
+        if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
+	    return 'error: verify home';
+        }
+    }   # End of creation of new user
+
+# -------------------------------------------------------------- Add names, etc
+    my %names;
+    if ($first)  { $names{'firstname'}  = $first; }
+    if ($last)   { $names{'lastname'}   = $last; }
+    my $reply = &put('environment', \%names, $udom,$uname);
+    if ($reply ne 'ok') { return 'error: '.$reply; }
+    &logthis('Success modifying user '.$udom.', '.$uname.', '.
+             $umode.', '.$first.', '.
+	     $last);
+    return 'ok';
+}
+
+# -------------------------------------------------------------- Modify student
+
+sub modifystudent {
+    my ($uname,$upass,$first,$last,$cnum,$cdom,$chome)=@_;
+    my $udom=$demodomain;
+    my $start=time;
+    my $end=$start+60*60*24*100;
+# --------------------------------------------------------------- Make the user
+    my $reply=&modifyuser($uname,$upass,$first,$last);
+    unless ($reply eq 'ok') { return $reply; }
+# -------------------------------------------------- Add student to course list
+    $reply=critical('put:'.$cdom.':'.$cnum.':classlist:'.
+                      &escape($uname.':'.$udom).'='.
+                      &escape($end.':'.$start),
+	              $chome);
+    unless (($reply eq 'ok') || ($reply eq 'delayed')) {
+	return 'error: '.$reply;
+    }
+# ---------------------------------------------------- Add student role to user
+    my $uurl='/'.$cnum;
+    $uurl=~s/\_/\//g;
+    return &assignrole($uname,$uurl,'st',$end,$start);
+}
+
+
+
 # ------------------------------------------------------------- Make a password
 
 sub genpass {
@@ -73,7 +170,8 @@
 
 # ----------------------------------------- Check the user supplied information
 sub errorwrap {
-    return '<font color="red">'.shift.'</font>';
+    my $msg=shift;
+    return '<font color="red">'.$msg.'</font>';
 }
 
 sub checkform {