view release on metacpan or  search on metacpan

AuthRegister.pm  view on Meta::CPAN

  $GenCasPageCustom
  analyze_cookie header_delete_cookie header_session_cookie
  import_dir_and_config login logout
  require_https require_login run_cas send_email_reminder
  get_user get_user_by_userid send_email_to_admin
  set_new_session store_log
 );

use vars qw( $AddAuthenticatedUser $AllowSignup
  $DBdir $DBusers $DBpwd $DBsessions $DBusersCas $DBpwdCas
  $DBsessionsCas $DBcasTokens $DebugLevel
  $Email_admin $Email_from $Email_bcc $Error $ErrorInternal
  $GenCasPageCustom $Header $LogReport
  $LDAPuse $LDAPserver $LDAPdn $LDAPaddUsers $LinkForgotpwd
  $Sendmail $Session $SessionId $SiteId $SiteName $Ticket
  $User $UserEmail $UserId $SendLogs $SecretSalt);
$AddAuthenticatedUser = ''; # If user is authenticated and not in database,
      # add user to the database. (it should replace $LDAPaddUsers)!!!
$AllowSignup = ''; # 1 to allow new user signup
$DBdir      = 'db'; # directory for stored data (822 db, sessions)
$DBusers    = 'users.db';      # Users db
$DBusersCas = 'users-cas.db';  # CAS users db
$DBpwd      = 'passwords';     # Passwords file
$DBpwdCas   = 'passwords-cas'; # CAS passwords
$DBsessions = 'sessions.d';    # Sessions
$DBsessionsCas = 'sessions-cas.d'; # CAS sessions
$DBcasTokens = 'cas-tokens.db'; # CAS Tokens
# $Error = ''; # Appended error messages, OK to be sent to user
# $ErrorInternal = ''; # Appended internal error messages, intended
                       # for administrator
# $Header         # Keeps the latest prepared HTTP header, if not printed
# $LogReport = '';  # Collecting some important log events if needed
$SecretSalt = &random_name; # Secret salt for generating secrets (e.g. tokens)
# $Session   = '';  # Session data structure
# $SessionId = '';  # Session identifier, generated
$SiteId = 'Site';   # Site identifier, used in cookies and emails
$SiteName = 'Site'; # Site name, can include spaces
# $Ticket = '';     # Session ticket for security, generated
# $User      = '';  # User data structure
# $UserEmail = '';  # User email address
# $SendLogs  = '';  # If true, send logs by email to admin ($Email_bcc)

$Email_from = ''; # Example: $SiteId.' <vlado@dnlp.ca>';
$Email_bcc  = ''; # Example: $SiteId.' Bcc <vlado@dnlp.ca>';

$Sendmail = "/usr/lib/sendmail"; # Sendmail with full path

# Some function prototypes
sub putfile($@);

########################################################################
# Section: Configuration
# sets site id as the base directory name; imports configuration.pl if exists
sub import_dir_and_config {
  my $base = `pwd`; $base =~ /\/([^\/]*)$/; $base = $1; $base =~ s/\s+$//;
  $SiteId = $SiteName = $base;
  if (-r 'configuration.pl') { package main; require 'configuration.pl'; }
}

########################################################################
# Section: HTTPS Connection and Cookies Management

# Check that the connection is HTTPS and if not, redirect to HTTPS.
# It must be done before script produces any output.
sub require_https {
  if ($ENV{'HTTPS'} ne 'on') {
      print "Status: 301 Moved Permanently\n".
       "Location: https://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}\n\n";
      exit 0; }
}

# Used to run a CAS service.  If not logged in, ask for userid and password.
# On success, offer to pass confirmation back to the site; on fail offer retry
# or go back to the site. If site not given, stay.  If previously logged in
# offer to pass confirmation to the site.  Handles ?logout requests.
# Allows parentheses in userid's for login, which are removed.  This allows
# users to use auxiliary comments with userid, so that browser can distinguish
# passwords.
sub run_cas {
  my %params = @_;
  my $querystring = $ENV{QUERY_STRING};
  $DBusers = $DBusersCas; $DBpwd = $DBpwdCas; $DBsessions = $DBsessionsCas;
  &import_dir_and_config; &require_https;
  if ($querystring eq '' && param('querystring')) {
    $querystring=param('querystring') }
  if ($querystring eq 'cas-all.css') { &deliver('cas-all.css') }
  if ($querystring eq 'cas-mobile.css') { &deliver('cas-mobile.css') }

  if (param('rt') ne '' && param('rt') eq 'verify') {
    my $username = param('username'); my $stoken = param('stoken');
    my $r = &_db8_find_first("$DBdir/$DBcasTokens", 'k=stoken', $stoken);
    my $ans = 'fail';
    if ($r ne '' and $r->{stoken} eq $stoken and $r->{userid} eq $username) {
      $ans = 'ok';
      if ($DebugLevel > 5) { $LogReport .= "CAS verification OK for ".
        "username($username) stoken($stoken)"; &store_log; }
    }
    if ($ans ne 'ok') {
      print header(), "answer:fail\n";
      if ($DebugLevel > 5) { $LogReport .= "CAS verify failed for ".
        "username($username) stoken($stoken)"; }
      &store_log; exit(); }
    &_db8_remove("$DBdir/$DBcasTokens", 'k=stoken', $stoken);
    print header(), "answer:ok\n"; exit();
  }
  
  my $redirect_uri;
  if (param('redirect_uri') ne '') { $redirect_uri = param('redirect_uri') }
  elsif (param('r') ne '') { $redirect_uri = param('r') }

  ### Helper functions: finishGeneral, finishWithPageBack

  local *finishGeneral = sub {
    my $page = &gen_cas_page;
    if ($redirect_uri ne '') {
      my $h = "<input type=\"hidden\" name=\"redirect_uri\" ".
	"value=\"$redirect_uri\">";
      $page=~ s/<!--!hiddenfields-->/$h\n$&/;
      my $t = "CAS Authentication requested by the following site:<br>\n".
	"<code>".&htmlquote($redirect_uri)."</code>";
      $page =~ s/(<!--38--)>(.*)/$1>$t/;

AuthRegister.pm  view on Meta::CPAN

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