[system] / trunk / webwork / system / cgi / cgi-scripts / login.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/cgi/cgi-scripts/login.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (download) (as text) (annotate)
Fri Jun 15 14:29:57 2001 UTC (11 years, 11 months ago) by gage
File size: 11480 byte(s)
development version dev-1-7-01 from /ww/webwork/development 15-June-2001

    1 #!/usr/local/bin/perl
    2 
    3 ## $Id$
    4 
    5 ####################################################################
    6 # Copyright @ 1995-1998 University of Rochester
    7 # All Rights Reserved
    8 ####################################################################
    9 
   10 
   11 use lib '/ww/webwork/gage_system/webwork/system/lib/'; # mainWeBWorKDirectory
   12 
   13 ## login.pl
   14 ## password authorization script for the WeBWorK project
   15 ##
   16 ## To Do:
   17 ##  * make sure submitted class value is in list of valid classes?
   18 ##  * add -T for taint checks, eventually...
   19 
   20 
   21 require 5.001;
   22 use strict;
   23 
   24 use Global;
   25 use Auth;
   26 use CGI qw(:standard);
   27 
   28 # begin Timing code
   29 use Benchmark;
   30 my $beginTime = new Benchmark;
   31 # end Timing code
   32 
   33 my $Course  = param('course');
   34 my $User  = param('user');
   35 my $Passwd  = param('passwd');
   36 my $Key   = param('key');
   37 my $scriptURL = param('SCRIPTING_FILE');   # script to execute after fast relogin
   38 
   39 # We may not have course info yet, so only get course environment if we
   40 # know what course we're getting info for!
   41 
   42 &Global::getCourseEnvironment(param('course')) if param('course');
   43 
   44 my $scriptDirectory = $Global::scriptDirectory;
   45 require "${scriptDirectory}$Global::HTMLglue_pl";
   46 
   47 my $Passwd_file     = &getCoursePasswordFile($Course);
   48 my $Key_file        = &getCourseKeyFile($Course);
   49 my $permissionsFile = &getCoursePermissionsFile($Course);
   50 my $practiceUser = $Global::practiceUser;
   51 
   52 # If a valid key is specified, we've just changed password
   53 # so no need to re-authorize
   54 
   55 if ($Key && $User && $Course)  {
   56     &verify_key($User, $Key, $Key_file, $Course);
   57 #   &record_login;
   58     &success_form($Key);
   59     exit;
   60 }
   61 
   62 ## No course specified?  You lose.
   63 unless($Course ) {
   64     my $error_msg = remote_host().'   '.user_agent().'   '.query_string();
   65     &wwerror("$0, missing course data. Refered by:" . referer(),
   66         "The script did not receive the proper input data. No WeBWorK course was defined",'','',$error_msg
   67   );
   68 }
   69 
   70 
   71 ## 'course' specified, but we also need 'user' and 'passwd' fields
   72 unless ($User && $Passwd) {
   73     &Global::error('', "Can't read $Passwd_file") unless (-r $Passwd_file);
   74     &login_form;
   75     exit;
   76 }
   77 
   78 ## If the user is a practice user, check that no one else is currently using
   79 ## that practice account
   80 
   81 if ($User =~ /^$practiceUser/) {
   82     my @currentUsers = get_current_users_from_passwordDB($Passwd_file);
   83     my $user;
   84 
   85     my $is_valid = 0;
   86     foreach $user (@currentUsers) {    ##check to see if $User is in password file
   87         if ($user eq $User) {
   88            $is_valid = 1;
   89            last;
   90         }
   91     }
   92     unless ($is_valid) {
   93         &failure_form;
   94         exit;
   95     }
   96 
   97     if (-e $Key_file) {  ## if the keys files does not exist, they can be no conflict
   98         my @activeUsers = get_active_users_from_keysDB($Key_file);
   99         my $is_active = 0;
  100         foreach $user (@activeUsers) {     ##check to see if $User is currently active
  101             if ($user eq $User) {
  102                 $is_active = 1;
  103                 $is_active = 0 if $User eq "practice666"; #code for inspections
  104                 last;
  105             }
  106         }
  107         if ($is_active) {
  108             &practice_failure_form;
  109             exit;
  110         }
  111     }
  112 }
  113 
  114 
  115 ## we've got all the info we need, now do the authorization
  116 if (&verify_password($User, $Passwd, $Passwd_file)) {
  117     my $key = &new_key($User, $Key_file);
  118     if (defined $scriptURL ) {  # we are doing a fast relogin
  119       &fast_login_form($key);
  120 
  121       }
  122     else {
  123       &record_login;   #Mike Gage 8/31/96
  124       &success_form($key);
  125       }
  126 }
  127 else {
  128     &failure_form;
  129 }
  130 
  131 # begin Timing code
  132 my $endTime = new Benchmark;
  133 &Global::logTimingInfo($beginTime,$endTime,"login.pl",$Course,$User,remote_host(),user_agent());
  134 # end Timing code
  135 
  136 exit;
  137 
  138 ####################
  139 
  140 sub login_form {
  141     my $course = shift;
  142     my $loginURL = getLoginURL();
  143 
  144     print &htmlTOP('WeBWorK Login Page', '', 'Pragma: no-cache'),
  145     hr,
  146     h1('WeBWorK Login Page'),
  147     "Please enter your username and password for ",
  148     b($Course), " below: ",
  149     p,
  150     start_form('POST', "$loginURL"),
  151     hidden('course'),
  152     textfield('user', '', 18), " Username", br,
  153     password_field('passwd', '', 18), " Password",
  154     i(" (will not be echoed)"), br,
  155     p,
  156     submit('Continue'),
  157     end_form, end_html;
  158 }
  159 
  160 
  161 sub success_form {
  162     my $key = shift;
  163     my $user_title = "user ";
  164 
  165     param('key', $key);  # avoid CGI.pm's sticky hidden field values
  166 
  167     my $permissions = &get_permissions($User,$permissionsFile);
  168     if ($permissions == $Global::instructor_permissions) {
  169   $user_title  = "instructor ";
  170     }
  171   if ($permissions == $Global::TA_permissions) {
  172   $user_title  = "TA ";
  173     }
  174     print &htmlTOP('Login Valid');
  175 
  176     # create outer table: left column is status message + buttons,
  177     # right-column contains info (message of the day, tips, etc.)
  178     print qq{<table cellspacing="10"><tr>};
  179 
  180     # begin left column
  181     print qq{<td valign="top" width="70%">},
  182         h1('Login Valid'),
  183   "Welcome, $user_title ", b($User), ". ",
  184         "You may begin working on problem sets for ",
  185   b($Course), " or do other tasks.\n";
  186 
  187     if ($permissions == $Global::instructor_permissions) {
  188   print start_form('POST', "${Global::cgiWebworkURL}profLogin.pl"),
  189       p,"\n",
  190       hidden('course'), "\n",
  191       hidden('user'),   "\n",
  192       hidden('key'),    "\n",
  193       submit("Enter Professor's Page"),
  194       end_form;
  195     }
  196 
  197     if ($permissions == $Global::TA_permissions) {
  198   print start_form('POST', "${Global::cgiWebworkURL}TALogin.pl"),
  199       p,"\n",
  200       hidden('course'), "\n",
  201       hidden('user'),   "\n",
  202       hidden('key'),    "\n",
  203       submit("Enter TA's Page"),
  204       end_form;
  205     }
  206 
  207     print start_form('POST', "$Global::welcome_CGI"),
  208   p,"\n",
  209   hidden('course'), "\n",
  210   hidden('user'),   "\n",
  211   hidden('key'),    "\n",
  212   submit('Begin Problem Sets'),
  213   end_form,
  214   p;
  215 
  216     print start_form('POST', "${Global::cgiWebworkURL}change-password.pl"),
  217   hidden('course'), "\n",
  218   hidden('user'),   "\n",
  219   hidden('key'),    "\n",
  220   submit('Change Password'),
  221   end_form;
  222 
  223     if ($Global::allowStudentToChangeEMAddress) {
  224         print start_form('POST', "${Global::cgiWebworkURL}change-email.pl"),
  225       hidden('course'), "\n",
  226       hidden('user'),   "\n",
  227       hidden('key'),    "\n",
  228       hidden('firstTime','firstTime'),    "\n",
  229       submit('Change Email Address'),
  230       end_form;
  231     }
  232     print qq{</td><td rowspan="2" bgcolor="black"></td>};
  233 
  234 
  235     # get "system message of the day"
  236     my $system_motd = '';
  237     my $system_motd_file = &Global::getSystemMOTDFile();
  238     if (-r $system_motd_file) {
  239   open(MOTD, $system_motd_file);
  240   while (<MOTD>) {
  241       $system_motd .= $_;
  242   }
  243   close(MOTD);
  244     }
  245     $system_motd = $system_motd || 'None.';
  246 
  247     # get "course message of the day"
  248     my $course_motd = '';
  249     my $course_motd_file = &Global::getCourseMOTDFile($Course);
  250     if (-r $course_motd_file) {
  251   open(MOTD, $course_motd_file);
  252   while (<MOTD>) {
  253       $course_motd .= $_;
  254   }
  255   close(MOTD);
  256     }
  257     $course_motd = $course_motd || 'None.';
  258 
  259     # now create separate "info" table in right-column
  260     print qq{<td valign="top"><table border cellspacing="5" cellpadding="5">},
  261 
  262   # motd row
  263   qq{<tr><td valign="top"><font face="helvetica,arial">},
  264   h4('WeBWorK System Message of the day:'),
  265   $system_motd,
  266   qq{</font></td></tr><tr>},
  267 
  268   # motd row
  269   qq{<tr><td valign="top"><font face="helvetica,arial">},
  270   h4("$Course Message of the day:"),
  271   $course_motd,
  272   qq{</font></td></tr><tr>},
  273 
  274   # tips row
  275   qq{<td valign="top"><font face="helvetica,arial">},
  276   h4('Tip for this login:'),
  277   &Global::tip,
  278 # start_form('POST', "${Global::cgiWebworkURL}tips.pl"),
  279 # hidden('course'), "\n",
  280 # hidden('user'),   "\n",
  281 # hidden('key'),    "\n",
  282 # '<SMALL>',submit('See all tips'),'</SMALL>',
  283 #       end_form,
  284   qq{</font></td></tr></table>},  # close inner "tips" table
  285   qq{</td></tr></table>},  # close outer table
  286         end_html;
  287 }
  288 
  289 
  290 sub failure_form {
  291     print &htmlTOP('Login Invalid', $Global::background_warn_url),
  292   h1('Login Invalid'),
  293   "Sorry ", b($User), ", you entered an invalid user/password pair.",
  294   start_form('POST', url),
  295   hidden('course'),
  296   submit('Try again'),
  297   end_form, end_html;
  298 }
  299 
  300 sub practice_failure_form {
  301     ## first get some information on practice users
  302     my @activeUsers = get_active_users_from_keysDB($Key_file);
  303     my @currentUsers = get_current_users_from_passwordDB($Passwd_file);
  304     my @activePracticeUsers = grep /^$practiceUser/, @activeUsers;
  305     my @currentPracticeUsers = grep /^$practiceUser/, @currentUsers;
  306     ## get a list of all non active practice users.
  307     my (%mark,$user);
  308     grep($mark{$_}++,@activePracticeUsers);
  309     my @currentAvailablePracticeUsers = grep(!$mark{$_},@currentPracticeUsers);
  310     my $numberOfAvailablePracticeUsers = @currentAvailablePracticeUsers;
  311     my $numberOfCurrentPracticeUsers = @currentPracticeUsers;
  312     ## get a short list of non active practice users
  313     @currentAvailablePracticeUsers = @currentAvailablePracticeUsers[0..4] if
  314       $numberOfAvailablePracticeUsers > 5;
  315 
  316     ## now print form
  317     print &htmlTOP('Login Failed', $Global::background_warn_url),
  318     h1('Login Failed'),
  319     'Sorry, the ', b($User),' account is currently being used by another user. ',
  320     'You can try another ',  b($practiceUser), ' account or you can try to login to the ',
  321     b($User),' account at a later time. <p>',
  322     "Currently, $numberOfAvailablePracticeUsers out of a total of $numberOfCurrentPracticeUsers ",
  323     b($practiceUser), ' accounts are not in use and are available.  For example<p>';
  324   foreach $user (@currentAvailablePracticeUsers) {
  325       print "$user<br>";
  326   }
  327   print '<p>are available',
  328     start_form('POST', url),
  329     hidden('course'),
  330     submit('Try again'),
  331     end_form, end_html;
  332 }
  333 
  334 
  335 
  336 sub fast_login_form {
  337     my $key = shift;
  338     my $user_title = "user ";
  339 
  340     param('key', $key);  # avoid CGI.pm's sticky hidden field values
  341 
  342     my $permissions = &get_permissions($User,$permissionsFile);
  343     if ($permissions == $Global::instructor_permissions) {
  344   $user_title  = "instructor ";
  345     }
  346     if ($permissions == $Global::TA_permissions) {
  347   $user_title  = "TA ";
  348     }
  349 
  350     print &htmlTOP('Login Valid', $Global::background_okay_url),
  351         h1('Login Valid'),
  352   "Fast login for $user_title ", b($User), ". ",
  353       start_form('POST', $scriptURL),
  354       hidden('key'),    "\n";
  355 
  356      &CGI::ReadParse;  #get the input parameters which need to be passed.
  357      my $tmp_key;
  358      foreach $tmp_key (keys %main::in) {           # pass all of the variables from the original calling script except those below:
  359       next if $tmp_key eq 'key';             # we have replaced the old key
  360       next if $tmp_key eq 'passwd';          # we DO NOT want to pass this.
  361       next if $tmp_key eq 'GO';              # the submit button, we don't need this
  362       next if $tmp_key eq 'SCRIPTING_FILE';  # contained the URL of the original target script now in $scriptURL
  363       print hidden( $tmp_key , $main::in{$tmp_key} ),"\n";
  364      }
  365 
  366      print "Press Tab and Return -- or click GO button<BR>",
  367      textfield('dummy','',0,0), submit('GO'), end_form, end_html;
  368 }
  369 
  370 
  371 sub record_login {
  372 
  373     &Global::getCourseEnvironment($Course);
  374   my $logsDirectory = getCourseLogsDirectory();
  375     my $logfile = "${logsDirectory}login.log";
  376     my $timestamp = scalar localtime;
  377 
  378     $timestamp =~ /^\w+\s(.*)\s/;
  379     $timestamp = $1;
  380 
  381     open(LOG, ">>$logfile") || warn "$0: can't write to $logfile!\n";
  382     print LOG "$timestamp $User on ", remote_host(),
  383          " (", user_agent(), ")\n";
  384     close(LOG);
  385     chmod 0660, "$logfile";
  386 }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9