view release on metacpan or  search on metacpan

lib/CGI/Auth/Basic.pm  view on Meta::CPAN

   INVALID_OPTION    => 'Options must be in "param => value" format!',
   CGI_OBJECT        => 'I need a CGI object to run!!!',
   FILE_READ         => 'Error opening pasword file: ',
   NO_PASSWORD       => 'No password specified (or password file can not be found)!',
   UPDATE_PFILE      => 'Your password file is empty and your current setting does not allow this code to update the file! Please update your password file.',
   ILLEGAL_PASSWORD  => 'Illegal password! Not accepted. Go back and enter a new one',
   FILE_WRITE        => 'Error opening password file for update: ',
   UNKNOWN_METHOD    => 'There is no method called "<b>%s</b>". Check your coding.',
   EMPTY_FORM_PFIELD => q{You didn't set any password (password file is empty)!},
   WRONG_PASSWORD    => '<p>Wrong password!</p>',
   INVALID_COOKIE    => 'Your cookie info includes invalid data and it has been deleted by the program.',
);

sub new {
   my($class, @args) = @_;
   my $self  = {};
   bless $self, $class;
   $self->_fatal($ERROR{INVALID_OPTION}) if @args % 2;
   $self->_set_options( @args );
   $self->_init;
   return $self;
}

sub _set_options {
   my($self, %o) = @_;
   if ( $o{cgi_object} eq 'AUTOLOAD_CGI' ) {
      require CGI;
      $o{cgi_object} = CGI->new;
   }
   else {
      # long: i_have_another_cgi_like_object_and_i_want_to_use_it
      # don't know if such a module exists :p
      if ( ! $o{ihacloaiwtui} ) {
         $self->_fatal($ERROR{CGI_OBJECT}) if ref $o{cgi_object} ne 'CGI';
      }
   }

   my $password;
   if ($o{file} and -e $o{file} and not -d $o{file}) {
      $self->{password_file_path} = $o{file};
      # Don't execute until check_user() called.
      $password = sub {$self->_pfile_content};
   }
   else {
      $password = $o{password};
   }

   $self->_fatal($ERROR{NO_PASSWORD}) if ! $password;

   $self->{password}       = $password;
   $self->{cgi}            = $o{cgi_object};
   $self->{program}        = $self->{cgi}->url  || EMPTY_STRING;

   # object tables           user specified         default
   $self->{cookie_id}      = $o{cookie_id}      || 'authpass';
   $self->{http_charset}   = $o{http_charset}   || 'ISO-8859-1';
   $self->{logoff_param}   = $o{logoff_param}   || 'logoff';
   $self->{changep_param}  = $o{changep_param}  || 'changepass';
   $self->{cookie_timeout} = $o{cookie_timeout} || EMPTY_STRING;
   $self->{setup_pfile}    = $o{setup_pfile}    || 0;
   $self->{chmod_value}    = $o{chmod_value}    || CHMOD_VALUE;
   $self->{use_flock}      = $o{use_flock}      || 1;
   $self->{hidden}         = $o{hidden}         || [];
   return;
}

sub exit_code {
   my $self = shift;
   my $code = shift || return;
   $self->{EXIT_PROGRAM} = $code if ref $code eq 'CODE';
   return;
}

sub _init {
   my $self = shift;

   if ( ! ref $self->{hidden} eq 'ARRAY' ) {
      $self->_fatal('hidden parameter must be an arrayref!');
   }

   my $hidden;
   my @hidden_q;
   foreach (@{ $self->{hidden} }) {
      next if $_->[0] eq $self->{cookie_id}; # password!
      next if $_->[0] eq $self->{cookie_id} . '_new'; # password!
      $hidden .= qq~<input type="hidden" name="$_->[0]" value="$_->[1]">\n~;
      push @hidden_q,  join q{=}, $_->[0], $_->[1];
   }

   $self->{hidden_q}     = @hidden_q ? join(q{&}, @hidden_q) : EMPTY_STRING;
   $self->{hidden}       = $hidden || EMPTY_STRING;
   $self->{logged_in}    = 0;
   $self->{EXIT_PROGRAM} = sub {CORE::exit()};

   # Set default titles
   $self->{_TEMPLATE_TITLE} = {
      title_login_form       => 'Login',
      title_cookie_error     => 'Your invalid cookie has been deleted by the program',
      title_login_success    => 'You are now logged-in',
      title_logged_off       => 'You are now logged-off',
      title_change_pass_form => 'Change password',
      title_password_created => 'Password created',
      title_password_changed => 'Password changed successfully',
      title_error            => 'Error',
   };

   $self->{_TEMPLATE_TITLE_USER} = {};
   $self->{_TEMPLATE_NAMES}      =  [
                                       qw(
                                          login_form
                                          screen
                                          logoff_link
                                          change_pass_form
                                       )
                                    ];

   # Temporary template variables (but some are not temporary :))
   $self->{$_} = EMPTY_STRING foreach qw(
      page_form_error 
      page_logoff_link 
      page_content 
      page_title
   );

   return;
}

sub _setup_password {
   my $self = shift;
      $self->_fatal($ERROR{UPDATE_PFILE}) unless $self->{setup_pfile};
   if ( ! $self->{cgi}->param('change_password') ) {
      return $self->_screen(
         content => $self->_change_pass_form($ERROR{EMPTY_FORM_PFIELD}),
         title   => $self->_get_title('change_pass_form'),
      );
   }
   my $password = $self->{cgi}->param($self->{cookie_id}.'_new');
   $self->_check_password($password);
   $self->_update_pfile($password);
   return $self->_screen(
            content => $self->_get_title('password_created'),
            title   => $self->_get_title('password_created'),
            cookie  => $self->_empty_cookie,
            forward => 1,
         );
}

sub _check_password {
   my $self     = shift;
   my $password = shift;
   my $not_ok   = !      $password                        ||
                         $password  =~ /\s/xms            ||
                  length($password) < MIN_PASSWORD_LENGTH ||
                  length($password) > MAX_PASSWORD_LENGTH ||
                         $password  =~ $RE;
   $self->_error( $ERROR{ILLEGAL_PASSWORD} ) if $not_ok;
   return;
}


sub _update_pfile {
   my $self     = shift;
   my $password = shift;
   require IO::File;
   my $PASSWORD = IO::File->new;
   $PASSWORD->open( $self->{password_file_path}, '>' ) or $self->_fatal($ERROR{FILE_WRITE}." $!");
   flock $PASSWORD, Fcntl::LOCK_EX() if $self->{use_flock};
   my $pok = print {$PASSWORD} $self->_encode($password);
   flock $PASSWORD, Fcntl::LOCK_UN() if $self->{use_flock};
   $PASSWORD->close;
   return chmod $self->{chmod_value}, $self->{password_file_path};
}

sub _pfile_content {
   my $self = shift;
   require IO::File;
   my $PASSWORD = IO::File->new;
   $PASSWORD->open($self->{password_file_path}) or $self->_fatal($ERROR{FILE_READ}." $!");
   my $flat = do { local $/; my $rv = <$PASSWORD>; $rv };
   chomp $flat;
   $PASSWORD->close;
   $flat =~ s{\s}{}xmsg;
   return $flat;
}

sub check_user {
   my $self = shift;
   $self->_check_user_real;

   # We have a valid user. Below are accessible as user functions
   if ( $self->{cgi}->param($self->{changep_param}) ) {
      if ( ! $self->{cgi}->param('change_password') ) {
         $self->_screen(
            content => $self->_change_pass_form,
            title   => $self->_get_title('change_pass_form')
         );
      }
      my $password = $self->{cgi}->param($self->{cookie_id}.'_new');
      $self->_check_password($password);
      $self->_update_pfile($password);
      $self->_screen(content => $self->_get_title('password_changed'),
                    title   => $self->_get_title('password_changed'),
                    cookie  => $self->_empty_cookie,
                    forward => 1);
   }
   return;
}

# Main method to validate a user
sub _check_user_real {
   my $self = shift;
   my $pass_param;

   if(ref($self->{password}) eq 'CODE') {
      require Fcntl; # we need flock constants
      $self->{password} = $self->{password}->() || $self->_setup_password;
   }

   if ($self->{cgi}->param($self->{logoff_param})) {
      $self->_screen(
         content => $self->_get_title('logged_off'),
         title   => $self->_get_title('logged_off'),
         cookie  => $self->_empty_cookie,
         forward => 1,
      );
   }

   # Attemp to login via form
   if ($pass_param = $self->{cgi}->param($self->{cookie_id})){
      if ( $pass_param !~ $RE && $self->_match_pass( $pass_param ) ) {
         $self->{logged_in} = 1;

lib/CGI/Auth/Basic.pm  view on Meta::CPAN

Note that: you must protect your password file(s). Put it above your
web root if you can. Also, giving it a I<.cgi> extension can be 
helpful; if a web server tries to execute it, you'll get a 500 ISE,
not the source (you can get the source however; it depends on your
server software, OS and configuration). You can also put it in
a hard-to-guess named directory. But don't put it in your program 
directory.

Also note that: these are I<just> suggestions and there is no 
guarantee that any of this will work for you. Just test and see
the results.

=item setup_pfile

If your "I<password file>" is empty and you set this parameter to a 
true value, then the module will ask you to enter a password for the
first time and will update the password file. Note that: someone 
that runs the program will set the default value. Also, if you 
forgot your password, set this parameter. You can replace your password 
file with an empty file and run the program to set the password. You 
can turn off this option after the password is set.

=item cookie_id

The name of the cookie and the name of the password area name 
in the login form. Default value is I<password>.

=item http_charset

If you are using custom templates and changed the interface language,
set this to a correct value. Defaut is C<ISO-8859-1> (english).

=item logoff_param

Default value is C<logoff>. If the user is logged-in, you can show him/her
a logoff link (see L<logoff_link|/logoff_link> method). With the default value, 
You'll get this link:

   <your_program>?logoff=1

If you set it to C<logout>, you'll get:

   <your_program>?logout=1

Just a cosmetic option, but good for translation.

=item cookie_timeout

When the user sends the correct password via the login form, the 
module will send a password cookie to the user. Set this parameter 
if you want to alter the module's setting. Default is an empty string
(means; cookie is a session cookie, it'll be deleted as soon as the user 
closes all browser windows)

=item changep_param

Form area name for password change. Same as C<logoff_param>. Cosmetic
option.

=item chmod_value

Password file's chmod value. Default value is C<0777>. Change this value 
if you get file open/write errors or want to use different level of 
permission. Takes octal numbers like C<0777>.

=item use_flock

Default value is C<1> and C<flock()> will be used on filehandles. You can 
set this to zero to turn off flock for platforms that does not implement 
flock (like Win9x).

=item hidden

If the area you want to protect is accessible with some parameters, 
use this option to set the hidden form areas. Passed as an array of 
array, AoA:

   hidden => [
               [action => 'private'],
               [do     => 'this'],
   ],

They'll also be used in the refresh pages and links as a query string.

=back

=head3 check_user

The main method. Just call it anywhere in your code. You do 
not have to pass any parameters. It'll check if the user knows 
the password, and until the user enters the real password, he/she 
will see the login screen and can not run any code below. For example
you can password-protect an admin section like this.

=head3 set_template

Change the module GUI. Create custom templates. Available templates:
C<login_form>, C<change_pass_form>, C<screen>, C<logoff_link>.

   $auth->set_template(login_form => qq~ ... ~, ...);

If you want to load the default templates on some part of
the program, pass C<delete_all> parameter with a true value:

   $auth->set_template(delete_all => 1);

This can be good for debugging and note that this will delete
anything you've set before.

For examples, see the test directory in the distribution.

=head3 set_title

Create your custom page titles. You can need this if you 
want to translate the interface. Available templates:
C<login_form>, C<cookie_error>, C<login_success>, C<logged_off>, 
C<change_pass_form>, C<password_created>, C<password_changed>, 
C<error>.

   $auth->set_title(error => "An error occurred", ...)

If you want to load the default titles on some part of