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

    1 #!/usr/bin/perl
    2 
    3 ## This file is profNewPassword.pl
    4 ## It allows a prof to give a user a newpassword
    5 ##
    6 
    7 require 5.001;
    8 use strict;
    9 use lib '/ww/webwork/development/'; # mainWeBWorKDirectory;
   10 
   11 use Global;
   12 use Auth;
   13 use GDBM_File;
   14 use CGI qw(:standard);
   15 
   16 my $User    = param('user')    || &error_form('No user', 'No user name specified.');
   17 my $Key     = param('key')     || &error_form('No key', 'No session key specified.');
   18 my $Course  = param('course')  || &error_form('No course', 'No course specified.');
   19 my $studentLogin  = param('studentLogin')|| &error_form('No student selected', 'No student specified.');
   20 
   21 my $Passwd  = param('passwd');
   22 my $Check   = param('check');
   23 
   24 # remove any leading/trailing spaces in input
   25 #$Passwd    =~ s|^\s*(.*?)\s*$|$1|;
   26 #$Oldpasswd =~ s|^\s*(.*?)\s*$|$1|;
   27 #$Check     =~ s|^\s*(.*?)\s*$|$1|;
   28 
   29 &Global::getCourseEnvironment($Course);
   30 
   31 my $scriptDirectory   = $Global::scriptDirectory;
   32 require "${scriptDirectory}$Global::HTMLglue_pl";
   33 require "${scriptDirectory}$Global::classlist_DBglue_pl";
   34 
   35 
   36 my $Passwd_file = &getCoursePasswordFile($Course);
   37 &Global::error("", "Can't read $Passwd_file") unless (-r $Passwd_file);
   38 
   39 my $Key_file    = &getCourseKeyFile($Course);
   40 &Global::error("", "Can't read $Key_file") unless (-r $Key_file);
   41 
   42 
   43 ## make sure user's already been authenticated
   44 &verify_key($User, $Key, $Key_file, $Course);
   45 
   46 my $permissionsFile = &Global::getCoursePermissionsFile($Course);
   47 my $permissions = &get_permissions($User, $permissionsFile);
   48 
   49 if ($permissions != $Global::instructor_permissions ) {
   50   print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n";
   51   print &html_NO_PERMISSION;
   52   }
   53 
   54 attachCLRecord($studentLogin);
   55 my $lastName    = CL_getStudentLastName($studentLogin);
   56 my $firstName   = CL_getStudentFirstName($studentLogin);
   57 my $studentID   = CL_getStudentID($studentLogin);
   58 
   59 
   60 ## if all the data's been entered, check it
   61 if ($Passwd && $Check) {
   62 
   63     ## make sure they know what they entered
   64     if ($Passwd ne $Check) {
   65   &error_form("Password Mismatch", "Your passwords don't match.");
   66     }
   67 
   68     ## all's well - set a new password
   69     &new_password($studentLogin, $Passwd, $Passwd_file);
   70     &success_form;
   71 }
   72 
   73 ## otherwise print the password change form (again, if necessary)
   74 else {
   75     &change_pw_form;
   76     exit;
   77 }
   78 
   79 
   80 sub change_pw_form {
   81     my $course = shift;
   82 
   83     print &htmlTOP('New Password Page', $Global::background_plain_url),
   84     hr,
   85     h1('New Password Page'),
   86     start_form('POST', url),
   87     "Choose a new password for ",b($firstName), " ", b($lastName)," ($studentID), $Course",
   88     " account, ", b($studentLogin), ".",
   89     p,
   90     password_field('passwd', '', 18), " New password", br,
   91     password_field('check', '', 18), " New password (again)", br,
   92     p,
   93     submit('Set the new password'),
   94     hidden('studentLogin'),
   95     hidden('user'),
   96       hidden('key'),
   97       hidden('course'),
   98     end_form, end_html;
   99 }
  100 
  101 
  102 sub success_form {
  103     print &htmlTOP('Password Changed', $Global::background_okay_url),
  104     hr,
  105     h1('Password Changed'),
  106     "The new password for ", b($firstName), " ", b($lastName)," ($studentID), $Course",
  107     " account, ", b($studentLogin), " is in effect.",
  108     p,
  109     start_form('POST', "${Global::cgiWebworkURL}profLogin.pl"),
  110     p,"\n",
  111     hidden('course'), "\n", hidden('user'), "\n", hidden('key'),
  112     submit('Continue'),
  113     end_form, end_html;
  114 }
  115 
  116 sub error_form {
  117     my ($title, $msg) = @_;
  118 
  119     print &htmlTOP($title, $Global::background_warn_url),
  120     hr,
  121     h1($title),
  122     $msg,
  123     p,
  124     "Hit the <B>Back</B> button and try again.",
  125     end_form, end_html;
  126     exit;
  127 }