[BACK]Return to signon.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / nsdl / nsdlloncapaorg

Diff for /nsdl/nsdlloncapaorg/signon.pl between versions 1.1 and 1.2

version 1.1, 2003/07/28 14:27:05 version 1.2, 2003/07/28 15:03:29
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Generate Demo Users on Demo Server  # Generate Guest Users on NSDL Server
 #  #
 # Only works on a library server!!!  # Only works on a library server!!!
 # Has to be the only library server in the domain!!!  # Has to be the only library server in the domain!!!
Line 8 Line 8
   
 use strict;  use strict;
   
 my $demodomain='msudemo';  my $demodomain='nsdl';
 my $demohome='msudemol1';  my $demohome='nsdll1';
 my $admemail='lon-capa@lon-capa.org';  my $admemail='lon-capa@lon-capa.org';
 my $demoserver='demo.lon-capa.org';  my $demoserver='nsdl.lon-capa.org';
   
   
   
Line 195  sub modifyuser { Line 195  sub modifyuser {
   
 # -------------------------------------------------------------- Modify student  # -------------------------------------------------------------- Modify student
   
 sub modifystudent {  sub modifyrole {
     my ($uname,$upass,$first,$last,$cnum,$cdom,$chome)=@_;      my ($uname,$upass,$first,$last)=@_;
     my $udom=$demodomain;      my $udom=$demodomain;
     my $start=time;      my $start=time;
     my $end=$start+60*60*24*100;      my $end=$start+60*60*24*100;
 # --------------------------------------------------------------- Make the user  # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser($uname,$upass,$first,$last);      my $reply=&modifyuser($uname,$upass,$first,$last);
     unless ($reply eq 'ok') { return $reply; }      unless ($reply eq 'ok') { return $reply; }
 # -------------------------------------------------- Add student to course list  
     $reply=reply('put:'.$cdom.':'.$cnum.':classlist:'.  # ------------------------------------------------------ Add guest role to user
                       &escape($uname.':'.$udom).'='.      return &assignrole($uname,'nsdl','dg',$end,$start);
                       &escape($end.':'.$start),  
               $chome);  
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {  
  return "error course list ".$reply;  
     }  
 # ---------------------------------------------------- Add student role to user  
     my $uurl='/'.$cdom.'_'.$cnum;  
     $uurl=~s/\_/\//g;  
     return &assignrole($uname,$uurl,'st',$end,$start);  
 }  }
   
 sub enroll {  sub enroll {
     my ($uname,$upass,$first,$last)=@_;      my ($uname,$upass,$first,$last)=@_;
     &logthis("Going to enroll $uname for $courses");      &logthis("Going to enroll $uname as guest");
     my $returnval='';      my $returnval.=
     foreach (split(/\&/,$courses)) {           &modifyrole($uname,$upass,$first,$last)."<br>\n";
       my ($cdom,$chome,$cid)=split(/\:/,$democourses{$_});  
       if ($cid) {  
         $returnval.=  
          &modifystudent  
  ($uname,$upass,$first,$last,$cid,$cdom,$chome)."<br>\n";  
       }  
     }  
     return $returnval;      return $returnval;
 }  }
 # ------------------------------------------------------------- Make a password  # ------------------------------------------------------------- Make a password
Line 253  sub makeform { Line 237  sub makeform {
  &inputline($_,$formfields{$_});   &inputline($_,$formfields{$_});
     }      }
     print "</table>\n<input type='hidden' name='courses' value='$courses'>".      print "</table>\n<input type='hidden' name='courses' value='$courses'>".
           "<input name='submitted' value='Generate Demo User' type='submit'>".            "<input name='submitted' value='Generate Guest User' type='submit'>".
           "</form>\n";            "</form>\n";
 }  }
   
Line 265  sub errorwrap { Line 249  sub errorwrap {
   
 sub checkform {  sub checkform {
     unless ($form{'submitted'}) {      unless ($form{'submitted'}) {
  return 'Please fill out the form below to generate a demo user.';   return 'Please fill out the form below to generate a guest user.';
     }      }
 # --- Sloppy check of email address  # --- Sloppy check of email address
     unless ($form{'gemail'}=~/^[^\@]+\@[^\@]+\.\w+$/) {      unless ($form{'gemail'}=~/^[^\@]+\@[^\@]+\.\w+$/) {
Line 285  sub checkform { Line 269  sub checkform {
  return &errorwrap('Username '.$form{'huser'}.' already exists.');   return &errorwrap('Username '.$form{'huser'}.' already exists.');
     }      }
     unless ($reply eq 'not_found') {      unless ($reply eq 'not_found') {
         return &errorwrap('Sorry, demo logins currently not available.');          return &errorwrap('Sorry, guest logins currently not available.');
     }      }
     return 0;      return 0;
 }  }
Line 295  sub sendemail { Line 279  sub sendemail {
    open(MAILOUT,"|mail '$form{'gemail'}' -c '$admemail' -s 'Your LON-CAPA Demo Access Info'");     open(MAILOUT,"|mail '$form{'gemail'}' -c '$admemail' -s 'Your LON-CAPA Demo Access Info'");
    print MAILOUT "Welcome to LON-CAPA!\n\n";     print MAILOUT "Welcome to LON-CAPA!\n\n";
    print MAILOUT "Somebody at $ENV{'REMOTE_ADDR'}, probably you, signed up\n";     print MAILOUT "Somebody at $ENV{'REMOTE_ADDR'}, probably you, signed up\n";
    print MAILOUT "for a demo login to\n\n  http://$demoserver/\n\n";     print MAILOUT "for an NSDL guest login to\n\n  http://$demoserver/\n\n";
    print MAILOUT "  Username: $form{'huser'}\n  Password: $upass\n\n";     print MAILOUT "  Username: $form{'huser'}\n  Password: $upass\n\n";
    print MAILOUT "Additional information provided was:\n\n";     print MAILOUT "Additional information provided was:\n\n";
    foreach (sort keys %formfields) {     foreach (sort keys %formfields) {
       print MAILOUT '  '.$formfields{$_}.': '.$form{$_}."\n";        print MAILOUT '  '.$formfields{$_}.': '.$form{$_}."\n";
    }     }
    print MAILOUT "\nCourse(s): $courses\n\nThank you for your interest in LON-CAPA!\n".&footer;      print MAILOUT "\nNSDL Guest User\n\nThank you for your interest in LON-CAPA!\n".&footer; 
    close MAILOUT;     close MAILOUT;
 }  }
   
 sub readdemo {  
     open(IN,$perlvar{'lonTabDir'}.'/democourses.tab') ||   
         die "Could not open demo course file from ".$perlvar{'lonTabDir'};  
     while (my $line=<IN>) {  
  chomp($line);  
         my ($name,$descr)=split(/\&/,$line);  
         $democourses{$name}=$descr;  
     }  
     close(IN);  
 }  
   
 sub footer {  sub footer {
     return (<<'ENDFOOTER');      return (<<'ENDFOOTER');
 --  --
Line 329  ENDFOOTER Line 302  ENDFOOTER
 # ================================================================ Main Program  # ================================================================ Main Program
   
 print "Content-type: text/html\n\n".  print "Content-type: text/html\n\n".
       "<html><head><title>LON-CAPA Demo Signup</title></head>".        "<html><head><title>LON-CAPA NSDL Guest Signup</title></head>".
       "<body bgcolor='#FFFFFF'>\n".        "<body bgcolor='#BBBBAA'>\n".
 "<h1>Welcome to the Learning<i>Online</i> Network with CAPA Demo Server!</h1>";  "<h1>Welcome to the Learning<i>Online</i> Network with CAPA NSDL Gateway Server!</h1><img src='/adm/lonDomLogos/nsdl.gif' align='right' />";
   
 # ---------------------------------- Read loncapa_apache.conf and loncapa.conf  # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf',  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf',
Line 341  undef $perlvarref; Line 314  undef $perlvarref;
 delete $perlvar{'lonReceipt'};   # remove since sensitive and not needed  delete $perlvar{'lonReceipt'};   # remove since sensitive and not needed
 delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed  delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
   
 &readdemo();  
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
 {  {
Line 379  delete $perlvar{'lonSqlAccess'}; # remov Line 351  delete $perlvar{'lonSqlAccess'}; # remov
                $value =~ s/[\~\'\"]//g;                 $value =~ s/[\~\'\"]//g;
                $form{$name}=$value;                 $form{$name}=$value;
             }              }
 # ------------------------------------------------ Get courses from get, if any  
 $courses=$ENV{'QUERY_STRING'};  
 $courses =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
 $courses =~ s/[^a-z\&]//g;  
 unless ($courses) { $courses='default'; }  
 # ------------------------------------------------------------ Check Form Input  
   
 my $error=&checkform();  my $error=&checkform();
   
Line 396  if ($error) { Line 362  if ($error) {
     my $result=&enroll($form{'huser'},$upass,$form{'afirst'},$form{'blast'});      my $result=&enroll($form{'huser'},$upass,$form{'afirst'},$form{'blast'});
     if ($result=~/error/) {      if ($result=~/error/) {
  &logthis($result);   &logthis($result);
         print &errorwrap('Sorry, demo functionality currently not available');          print &errorwrap('Sorry, guest functionality currently not available');
     } else {      } else {
         print "Your access information will be emailed to ".$form{'gemail'};          print "Your access information will be emailed to ".$form{'gemail'};
         &sendemail($upass);          &sendemail($upass);
Line 404  if ($error) { Line 370  if ($error) {
 }  }
 # ------------------------------------------------------------------------- End  # ------------------------------------------------------------------------- End
   
     print('<p><pre>'.&footer()."</pre></body></html>\n");      print('<p><table bgcolor="#999999" width="100%" cellspacing="3"><tr><td bgcolor="#FFFFFF"><pre>'.&footer().'</pre></td><td bgcolor="#FFFFFF"><img src="/adm/lonIcons/SMETE_white.gif" align="right"></td></tr></table></body></html>');
 1;  1;
   
   
Removed from v.1.1  
changed lines
  Added in v.1.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>