Re: Starting with CGI::Application and Logins

Here's a crude example I wrote last week while learning CGI::Application. Emphasis on crude.

package Login;
use base 'CGI::Application';
use Login::User;
use DBI;
use CGI::Session;

use warnings;
use strict;
use Taint;

my $cookie_name = 'example';
my $script = 'test.cgi';
my $cookie_expiry = '+2h';

my $dbinfo = { db => "db", user => "db_user", password => "db_password
+" };
my $dbh = DBI->connect("DBI:mysql:".$dbinfo->{db}, $dbinfo->{user}, $d
+binfo->{password}, {RaiseError => 1, PrintError => 0, AutoCommit => 1
+});

{

my @no_login_required = (qw(create process_login process_create login 
+logout AUTOLOAD)); # run modes that won't redirect you to login for n
+ot being logged in
my %no_login_required_hash;
@no_login_required_hash{@no_login_required} = undef;

sub login_required { return !exists $no_login_required_hash{+shift} }

}

sub cgiapp_init {
  my $self    = shift;
  my $query   = $self->query;
  
  # get the current session id from the cookie
  my $sid     = $query->cookie($cookie_name) || undef;
  
  # session setup
  my $session = CGI::Session->new('driver:MySQL', $sid, {Handle=>$dbh 
+});

  # assign the session object to a param
  $self->param(session => $session);
  
  # send a cookie if needed
  if ( !defined $sid or $sid ne $session->id ) {
    my $cookie = $query->cookie(
                -name    => $cookie_name,
                -value   => $session->id,
                -expires => $cookie_expiry,
                   );
    $self->header_props( -cookie => $cookie );
  }
}


sub cgiapp_get_query {
  my $self = shift;
  
  require CGI::Safe;
  my $q = CGI::Safe->new();
  
  return $q;
}

sub setup {
  my $self = shift;
  $self->run_modes(
           main => 'main', 
           login => 'login',
           process_login => 'process_login',
           process_create => 'process_create',
           create => 'create',
           logout => 'logout',
           AUTOLOAD => 'autoload_error',
          );
  $self->start_mode('login');
  $self->mode_param('rm');
}

sub autoload_error {
  my $self = shift;
  my $q = $self->query();

  my $output = "";
  $output .= $q->start_html(-title => "Invalid");
  $output .= $q->h1("invalid runmode " . $self->get_current_runmode);
  $output .= $q->end_html();
  return $output
}

sub main {
  my $self = shift;
  my $session = $self->param('session');
  my $q = $self->query();

  my $output = "";
  $output .= $q->start_html(-title => "Main");
  $output .= $q->h1("Do something useful here.");
  $output .= $q->p("You are logged in as " . $session->param('login'))
+;
  $output .= $q->p($q->a({href => "$script?rm=logout"}, "Logout"));
  $output .= $q->end_html();
  return $output
}

sub login {
  my $self = shift;
  my $q = $self->query();

  my $output = "";
  $output .= $q->start_html(-title => "Login");
  $output .= $q->startform();
  if ($self->param('message')) {
    $output .= $q->h3($self->param('message'));
  }
  $output .= $q->h1("Please login.");
  $output .= "Login: " . $q->textfield(-name => 'login') . "<br />";
  $q->param('password', '');
  $output .= "Password: " . $q->password_field(-name => 'password', -d
+efault => '') . "<br />";
  $output .= $q->submit(-name => 'Submit', -value => 'submit');
  $q->param('rm', 'process_login'); # make sure CGI.pm doesn't clobber
+ rm submitted below with value from URL
  $output .= $q->hidden(-name => 'rm', -value => 'process_login', -def
+ault => '');
  $output .= $q->endform();
  $output .= $q->p($q->a({-href=>"$script?rm=create"}, "Create new acc
+ount"));
  $output .= $q->end_html();
  return $output
}

sub process_login {
  my $self = shift;
  my $q = $self->query();

  my $output = "";
  $output .= $q->start_html(-title => "processing login");

  my $user = Login::User->retrieve(login => $q->param('login'));

  if (!defined $user) {
    $self->param('message', 'Specified user does not exist.');
    return $self->login;
   } else { # user is defined 
    my $password = $user->get('password');
    if ($q->param('password') ne $password) {
      $self->param('message', 'Password incorrect');
      return $self->login;
    } else { # successful login!
      my $session = $self->param('session');
      $session->param('logged_in', 1);
      $session->param('login', $q->param('login'));
      $session->expires('logged_in', '+2h');
      return $self->main;
    }
  }
  $output .= $q->end_html();
  return $output
}

sub create {
  my $self = shift;
  my $q = $self->query();

  my $output = "";
  $output .= $q->start_html(-title => "Create Account");
  $output .= $q->startform();
  if ($self->param('message')) {
    $output .= $q->h3($self->param('message'));
  }
  $output .= $q->h1("Please enter the information for your new account
+.");
  $output .= "Login: " . $q->textfield(-name => 'login', -default => d
+efined $self->param('login') ? $self->param('login') : '') . "<br />"
+;
  $q->param('password','');
  $q->param('password2','');
  $output .= "Password: " . $q->password_field(-name => 'password', -d
+efault => '') . "<br />";
  $output .= "Verify Password: " . $q->password_field(-name => 'passwo
+rd2', -default => '') . "<br />";
  $output .= $q->submit(-name => 'Submit', -value => 'submit');
  $q->param('rm', 'process_create'); # make sure CGI.pm doesn't clobbe
+r rm submitted below with value from URL
  $output .= $q->hidden(-name => 'rm', -value => 'process_create');
  $output .= $q->endform();
  $output .= $q->end_html();
  return $output
}

sub process_create {
  my $self = shift;
  my $q = $self->query();

  my $user = Login::User->retrieve(login => $q->param('login'));
  if (defined $user) {
    $self->param('message', 'Login already exists. Please choose anoth
+er.');
    return $self->create;
   } 
  if ($q->param('password') ne $q->param('password2')) {
    $self->param('message', "Passwords don't match. Please try again."
+);
    $self->param('login', $q->param('login'));
    return $self->create;
  }
  $user = Login::User->create({login => $q->param('login'), password =
+> $q->param('password')});
  my $session = $self->param('session');
  $session->param('login', $q->param('login'));
  $session->param('logged_in',  1);
  $session->expires('logged_in', '+2h');
  return $self->main;
}

sub logout {
  my $self = shift;
  my $q = $self->query();
  my $sid = $q->cookie($cookie_name);
  my $session = $self->param('session');
  $session->clear('logged_in');
  $self->param('message', 'Logged out.');
  return $self->login;
}

sub cgiapp_prerun {
  my $self = shift;
  return unless login_required($self->get_current_runmode);
  my $session = $self->param('session');
  $self->prerun_mode('login') unless defined $session and $session->pa
+ram('logged_in');   # Redirect to login, if necessary
}

1;
[download]

package Login::DBI;
use base "Class::DBI::mysql";

__PACKAGE__->connection( "dbi:mysql:db", "db_user", "db_password" );

1;
[download]

package Login::User;
use base 'Login::DBI';
use strict;

Login::User->table( "user" );
Login::User->columns(All => qw(uid login password));

1;
[download]

test.cgi

#!/usr/bin/perl -w
use Login;
my $app = Login->new();
$app->run();
[download]

Then you need a sessions table as documented in CGI::Session::MySQL and a user table:

CREATE TABLE user (
  uid int(10) unsigned NOT NULL auto_increment,
  login char(32) default NULL,
  password char(16) default NULL,
  PRIMARY KEY  (uid)
) TYPE=MyISAM;
[download]

I wince at all the CGI.pm HTML formatting to create the output; I wrote this in a hurry. On the bright side, it meant fewer files for this example than if I did the obvious thing and used HTML::Template (and I would use a template system before considering doing anything with this code.)

And when I stopped using CGI.pm's HTML functions, I'd stop overriding CGI::Application's default CGI.pm query object with a CGI::Safe and go to CGI::Simple instead. (Both set some defaults more safely than CGI.pm does, and CGI::Simple is smaller and faster.)

This code doesn't check if the user has accepted cookies; it doesn't even encrypt the password. And I'm sure you can begin to see why people separate authentication code from application code given how hard it is already in this short example to tell the authentication run modes from the routines overriding CGI::Application's defaults. Now imagine if all the application logic were in there, too.

However, what it does do is show a very basic version of the functionality you were looking for. It validates a login, stores session info, and passes it among run modes. I hope it gives you a starting point for how one might do these things. (Ordinarly I wouldn't post code this crude, but you sounded so despairing...)

Here and here are some past threads on testing CGI apps. See merlyn's Basic Cookie Management for excellent guidelines on cookies (which the above code is not yet compliant with.) And here's a big collection of links on storing session.

Have fun.

Updated: Made a fix to the code, described here.

Comment on Re: Starting with CGI::Application and Logins Select or Download Code

Replies are listed 'Best First'.
Re^2: Starting with CGI::Application and Logins by deep submerge (Scribe) on Aug 22, 2004 at 13:43 UTC
In your example, your starting run mode is the login screen. I thought the login screen was supposed to be determined in prerun? I saw an example somewhere, where the need to validate a user's login was supposed to the login. If it was good, it would go to the normal run mode. If it was bad, it would `return $self->desiredrunmode`. And the wiki doesn't help either. It made some reference to a catch-all validation, that made a seperate C::A necessary. I see that you have everything in one pm... See, I still don't understand what's going on, anywhere. In your example, your start mode is login... And then your prerun is login... So how does the user get out of the login stage if they already were logged in?	[reply] [d/l]
Re^3: Starting with CGI::Application and Logins by Zed_Lopez (Chaplain) on Aug 22, 2004 at 18:16 UTC
Good question. I was fiddling with the code at the last minute and I made one of the classic mistakes -- putting a naked 'shift' into a hash parameter. So my login_required function, as written, didn't work, but (subsequent to breaking it) I hadn't tested the case of the user trying an end run around logging in by going to a run mode that required it. I've updated the code, and maybe my prerun makes more sense now that it's governed by a function that actually works. Updated: I wasn't really addressing all the questions, so I added the following... The example with the desired_runmode you mention does something nice that this example doesn't -- if the user's not logged in (perhaps because his or her session expired), it directs them to the login screen, while remembering where they wanted to be, and directing them there after they're logged in. That's functionality that just isn't here -- here, when they log in, they go to main, period. (Of course in this example there's literally nowhere else to go.) My prerun returns without action if they're going to a run mode that doesn't require being logged in, e.g. the login and create account run modes and the run modes that process the submission of those forms. Then, having determined they're going to a run mode that does require being logged in, it checks if they're logged in, and returns without action if they are. Finally, having eliminated the above cases, it knows that the user is going to a run mode that requires being logged in, and that the user is not logged in, so it directs the user to the login screen. I am a CGI::Application beginner myself, and have no idea why someone would say something actually required splitting the application into multiple C::A's. Can you provide a link to that assertion?	[reply]


XP is just a number
	PerlMonks