view release on metacpan or  search on metacpan

AuthRegister.pm  view on Meta::CPAN

  $Request_type = param('request_type');
  $Request_type = '' unless grep {$_ eq $Request_type}
    qw(Login Logout Send_Password);
  
  if ($Request_type eq '') {
    print header(), $HTMLstart;
    if ($SessionId eq '') {
      print "You must login to access this site.\n".
        "You can login using the form with the site-specific password:\n".
        $Formstart."Userid or email: ".textfield(-name=>"userid")."\n".
        "Password: ".password_field(-name=>"password")."\n".
        '<input type="submit" name="request_type" value="Login"/>'.
        "</form>\n";
      print "If you forgot your password, you can retrieve it by email:\n";
      print $Formstart."Email: ".textfield(-name=>"email_pw_send")."\n".
        '<input type="submit" name="request_type" value="Send_Password"/>'.
        "</form>\n";
    } else {
      print "You are logged in as: $UserEmail\n",
        "You can logout by clicking this button:\n",
        $Formstart, '<input type="submit" name="request_type" value="Logout"/>',
        "</form>\n$Back";
    }
  }
  elsif ($Request_type eq 'Login') {
    if ($SessionId ne '') {
      print header(), $HTMLstart, "You are already logged in.\n",
        "You should first logout:\n",
        $Formstart, '<input type="submit" name="request_type" value="Logout"/>',
        "</form>\n$Back";
    }
    else {
      my $email = param('userid'); my $password = param('password');
      if (! &login($email, $password) ) { # checks for userid and email
        print header(), $HTMLstart, "Unsuccessful login!\n"; }
      else {
        print header_session_cookie(), $HTMLstart, "Logged in as $UserEmail.\n"; }
      print $Back; exit;
    }
  }
  elsif ($Request_type eq 'Send_Password') {
    &send_email_reminder(param('email_pw_send'), 'raw');
    print header(), $HTMLstart, "You should receive password reminder if ".
      "your email is registered at this site.\n".
      "If you do not receive remider, you can contact the administrator.\n$Back";
  }
  elsif ($Request_type eq 'Logout') {
    if ($SessionId eq '') {
      print header(), $HTMLstart, "Cannot log out when you are not logged in.\n",
        $Back;
    }
    else {
      logout(); print header_delete_cookie(), $HTMLstart, "Logged out.\n$Back"; }
  }


=head1 DESCRIPTION

CGI::AuthRegister is a Perl module for CGI user authentication and
registration.  It is created with objective to be simple, flexible,
and transparent.  For the sake of simplicity, it is not completely
portable, but mostly designed for Linux environment.  As an example,
it relies on a directly calling sendmail for sending email messages.

Example 1, included in the distribution, and shown above, illustrates
the main functionalities of the module in one CGI file.  The module is
designed with the assumption that the CGI programs run with user uid.

=head1 PREDEFINED VARIABLES

=head2 $CGI::AuthRegister::AddAuthenticatedUser

If true, a user authenticated via CAS and not in the client record,
is added to the client record.

=head2 $CGI::AuthRegister::DebugLevel

=head2 $CGI::AuthRegister::Email_admin

=head2 $CGI::AuthRegister::Email_bcc

For example,

  $CGI::AuthRegister::Email_bcc = 'Vlado Keselj <vlado+bcc@dnlp.cad>';

If nonempty, causes BCC copies of the emails to be sent to this address.
This is typically an administrator's address.  If Email_admin is empty and
Email_bcc is not, then Email_bcc is used as Email_admin.

=head2 $CGI::AuthRegister::Email_from

Example:
  $CGI::AuthRegister::Email_from = $CGI::AuthRegister::SiteId
      . ' <vlado@dnlp.ca>;

=head2 $CGI::AuthRegister::SendLogs

If true, the log entries will be sent by email to the admin.

=head1 FUNCTIONS

=head2 analyze_cookie()

Analyzes cookied of the web page.  It is called at the beginning of
the script.  If the cookie contains a valid session id and security
ticket, it will set variables $SessionId, $Session (a hash),
$UseEmail, and $User (a hash).  A typical usage is as follows, at the
beginning of a CGI script, after 'use' and similar statements:

  &import_dir_and_config;  # load configuration.pl, optional
  &require_https;          # require HTTPS, optional
  &analyze_cookie;

=head2 import_dir_and_config()

Sets the SiteId as the base directory name.  Loads the configuration.pl
if it exists.

=head2 require_https()

Checks whether the connection is HTTPS.  If it is not, prints redirection
HTTP headers to the HTTPS version of the same URL and exits the program.

=head2 require_login()

Used in an CGI to check login status.  An example of usage:

  &import_dir_and_config;
  &require_https;  # Require HTTPS connection

  # Require CAS login
  my $status =
    &require_login(-cas=>"https://cas.server.com/",
      -logout_title=>'Logout from My Site',
      -logout_redirect=>'https://my.site.com/mainpage');
  #status: logged out, 1, not logged in, login failed

  if ($status != 1) {
    print "<html><body>Not logged in.\n";
    exit;
  }


=head2 require_session(-redirect=>LoginScript, -back=>BackScript)

Analyzes the cookie and requires non-empty session, meaning a correctly
logged-in user.  If the session is empty, and the redirect argument is
provided (LoginScript) that is different from the current script,
redirection HTTP headers are printed for a redirection to LoginScript.
If LoginScript is not provided, index.cgi is used by default.
If LoginScript (or default index.cgi) is the same as the current script
(which would cause an infinite-loop behaviour), a simple error page is
printed.  If give, the back argument (BackScript) is passed to LoginScript
as a `goto' parameter.  LoginScript is supposed to use this parameter to
redirect back to this page after a successful login.

=head1 SEE ALSO

There are already several modules for CGI authentication in Perl, but
they do not seem to satisfy some specific requirements, that could be
vaguely described as: simple, flexible, robust, and transparent.
Additionally, they do not typically include registration process for
new users and password reminders using email, which are added here.

These are some of the current implementation:

=over 4

=item [CGI::Application::Plugin::Authentication]

Too complex, relies on plugins for different backends (database, flat
files).  The proposed module just uses flat files.

=item [CGI::Auth]

A lot of parameters; too high level, not sufficient flexibility.

=item [CGI::Auth::Auto]

Similar to CGI::Auth.

=item [Apache::AuthCookie]

Relies on the Apache web server; not very flexible.

=item [CGI::Session]

Seem to be too high-level and not leaving sufficient low-level control
and flexibility.

=back

=cut