WEBTOOLS/SecurityModule/SecurityModule.pm

################################################################
# SecurityModule
#
# Version info: $Id: SecurityModule.pm,v 1.20 2007/02/07 11:20:09 dfeich Exp $
################################################################
package SecurityModule;

use IO::File;
use Crypt::CBC;
use MIME::Base64;
use Digest::MD5 qw(md5_base64);
use Data::Dumper;
use CGI qw(cookie param url_param redirect);
#use Carp;
use strict;

sub new {
  my $class = shift;
  my $options = shift;

  my @settable = qw(CALLER_URL CONFIG LOGFILE LOGLEVEL PWDFORM_HANDLER KEYVALIDTIME
REQCERT_FAIL_HANDLER REVPROXY_MODE);

  my $self  = {};
  $self->{AUTHNSTATE}   = "failed";
  $self->{USERDN}    = undef;
  $self->{ROLES}  = {};

  $self->{REVPROXY_MODE} = 1; # reverse proxy mode

  $self->{CIPHER} = undef; # cipher object
  $self->{CIPHERKEY} = undef; # currently active key
  $self->{KEYID} = undef; # id of current key
  $self->{KEYVALIDTIME} = 3600; # for how long keys remain valid (in s)
  $self->{COOKIE} = undef; # holds a cookie to be set

  $self->{CALLER_URL}=""; # true URL (including any proxy transform.)

  $self->{ERRMSG} = "";
  $self->{LOGFILE} = undef; # defaults to stderr (apache err log)
  $self->{LOGH} = undef; # Log filehandle
  $self->{LOGLEVEL} = 1;

  $self->{CONFIG} = undef; # configuration file

  # handler for password page
  # $self->{PWDFORM_HANDLER} = sub { die "Not implemented"; };
  $self->{PWDFORM_HANDLER} = \&SecurityModule::_passwordForm;

  # handler for reqAuthnCert failures
  $self->{REQCERT_FAIL_HANDLER} = \&SecurityModule::_reqcertFailHandler;


  bless ($self, $class);

  # treat logfile options seperately first
  if(exists $options->{LOGFILE}) {
    $self->{LOGFILE} = $options->{LOGFILE};
  }
  if(exists $options->{LOGLEVEL}) {
    $self->{LOGLEVEL} = $options->{LOGLEVEL};
  }

  # read the config file and let command line given options override
  # the config file supplied ones
  if(exists $options->{CONFIG}) {
    $self->{CONFIG} = $options->{CONFIG};
    my $confopts = $self->_readConfigFile();
    while( my ($opt,$val) = each %$confopts) {
      $options->{$opt} = $val if ! exists $options->{$opt};
    }
  }

  while( my ($opt,$val) = each %$options) {
    next if ! grep (/$opt/,@settable);
    $self->{$opt} = $val;
    delete $options->{$opt};
  }

  # depending whether we are in reverse proxy mode, choose the
  # appropriate environment variables for the SSL authentication results
  if ($self->{REVPROXY_MODE}) {
    $self->{HTTPS} = $ENV{HTTP_HTTPS};
    $self->{SSL_CLIENT_VERIFY} = $ENV{HTTP_SSL_CLIENT_VERIFY};
    $self->{SSL_CLIENT_S_DN} = $ENV{HTTP_SSL_CLIENT_S_DN};
    $self->{REMOTE_ADDR} = $ENV{HTTP_X_FORWARDED_FOR};
  } else {
    $self->{HTTPS} = $ENV{HTTPS};
    $self->{SSL_CLIENT_VERIFY} = $ENV{SSL_CLIENT_VERIFY};
    $self->{SSL_CLIENT_S_DN} = $ENV{SSL_CLIENT_S_DN};
    $self->{REMOTE_ADDR} = $ENV{REMOTE_ADDR};
  }

  return $self;
}

sub init {
  my $self = shift;

  return 1 if $self->{HTTPS} ne "on";

  if ($self->{SSL_CLIENT_VERIFY} eq "SUCCESS") {
    $self->{AUTHNSTATE} = "cert";
    $self->{USERDN} = $self->{SSL_CLIENT_S_DN};
  }

  # return if this is the password form
  return 1 if $self->{CALLER_URL} =~ /^$self->{PWDFORM_HANDLER}.*/;

  my $show_pwdform = 0;
  # Cookies can override a SSL/cert authentication
  if((my $cookie = cookie(-name => "SecMod"))) {
    $self->_log(5,"Found cookie: $cookie");
    # do cookie authentication
    $show_pwdform =1 if ! $self->_cookieAuthen($cookie);
  } elsif (url_param("SecModLogout")){
    # if there is no cookie, but we still have a Logout directive in the URL
    # clean it and redirect to self
    (my $url = $self->{CALLER_URL}) =~ s/[?&]SecModLogout=1//;
    print redirect($url);
  }

  # do password authentication of a submitted password form
  $show_pwdform = $self->_passwordAuthen() ? 0 : 1  if(param("SecModLogin"));

  # don't show form if we are already passwd authenticated
  $show_pwdform = 1 if (param("SecModPwd") && $self->{AUTHNSTATE} ne "passwd");

  # display the password form
  if($show_pwdform) {
    $self->_showPasswdForm($self->{ERRMSG});
  }

  $self->{ROLES}=$self->_getRolesFromDN($self->{USERDN}) if $self->{AUTHNSTATE} ne "failed";

  return 1;
}

sub reqAuthnPasswd {
  my $self = shift;

  if ($ENV{HTTP_HTTPS} ne "on") {
    (my $red = $self->{CALLER_URL}) =~ s!^http:!^https:!;
    print redirect($red);
  }

  return if $self->{AUTHNSTATE} eq "cert" || $self->{AUTHNSTATE} eq "passwd";
  $self->_showPasswdForm("password authentication required");
  exit(0);
}

sub reqAuthnCert {
  my $self = shift;

  if ($ENV{HTTP_HTTPS} ne "on") {
    (my $red = $self->{CALLER_URL}) =~ s!^http:!^https:!;
    print redirect($red);
  }

  return if $self->{AUTHNSTATE} eq "cert";

  if (ref($self->{REQCERT_FAIL_HANDLER}) eq "CODE") {
    &{$self->{REQCERT_FAIL_HANDLER}}($self->{AUTHNSTATE},$self->{USERDN});
    exit 1;
  }
  print redirect($self->{REQCERT_FAIL_HANDLER} ."?caller_url=" .
                 urlencode($self->{CALLER_URL}));
  exit 1;
}

sub getAuthnState {
  my $self = shift;

  return $self->{AUTHNSTATE};
}

sub getCookie {
  my $self = shift;
  return $self->{COOKIE};
}

sub getDN {
  my $self = shift;
  return $self->{USERDN};
}

sub getRoles {
  my $self = shift;
  return $self->{ROLES};
}


sub getErrMsg {
  my $self = shift;
  return $self->{ERRMSG};
}

sub setKeyValidTime {
  my $self = shift;
  $self->{KEYVALIDTIME} = shift;
}

sub setLogFile {
  my $self = shift;
  $self->{LOGFILE} = shift;
}

sub setLogLevel {
  my $self = shift;
  $self->{LOGLEVEL} = shift;
}

sub setPwdHandler {
  my $self = shift;
  $self->{PWDFORM_HANDLER} = shift;
}


sub DESTROY {

}

# CLASS METHODS

sub urlencode {
  (my $str = shift) =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
  return $str;
}

sub urldecode {
  (my $str = shift) =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
  return $str;
}


############################################
# VIRTUAL METHODS TO BE IMPLEMENTED BY A
# SUBCLASS

# If argument keyid is given, fetches the appropriate key. If
# keyid is omitted, returns the a valid key from the DB (if no
# valid keys are found, a new one will be generated).
# @param: keyid  ID of key to be retrieved
# @return: 0 if ok, 1 if no such key in DB, 2 if key is too old
sub _getCipherKey {
  die "virtual function _getCipherKey not implemented";
}

# @param: user's DN
# @return: hash mapping roles to array of scopes
sub _getRolesFromDN {
  die "virtual function _getRolesFromDN not implemented";
}

# @param: short user name as used in passwd authentication
# @return: user's DN
sub _getDNfromUsername {
  die "virtual function _getDNfromUsername not implemented";
}

# @param: short user name as used in passwd authentication
# @return: password hash
sub _getUserPasswd {
  die "virtual function _getUserPasswd not implemented";
}

############################################
# PRIVATE METHODS


sub _getOriginatorHash {
  my $self = shift;
  $self->_log(5,"_getOriginatorHash: REMOTE_ADDR=".$self->{REMOTE_ADDR});
  return  md5_base64($self->{REMOTE_ADDR},
                     $ENV{HTTP_USER_AGENT});
}

# very primitive configuration file reader
sub _readConfigFile {
  my $self = shift;

  my $conf={};

  open(CONF,"<$self->{CONFIG}") or die "Failed to open config file " . $self->{CONFIG};

  while(my $line = <CONF>) {
    next if $line =~ /^\s*#/ || $line =~ /^\s*$/;

    if( my ($opt,$val) = $line =~ m/^\s*([A-Z_]+)\s*=\s*([^\s]+)\s*$/) {
      $conf->{$opt} = $val;
    }
  }
  close CONF;
  $self->_log(5,"Config File: " . Dumper($conf));
  return $conf;
}

# Does authentication of a presented cookie. Also implements a
# logout feature by setting an obsolete cookie
#
# @return 1 for a correct cookie, 0 if an invalid cookie was found
#         also returns 1 if a "Logout" directive was found
sub _cookieAuthen {
  my $self = shift;
  my $cookie = shift;

  # A 'logout' is performed if a parameter SecModLogout is found
  #     basically resulting in destroying the cookie
  if(param("SecModLogout")) {
    $self->{COOKIE} = cookie(-name => "SecMod",
                             -value =>"",
                             -expires => "-1h",
                             -secure => 1
                            );
    return(1);
  }

  my ($state,$user,$time,$orighash) = $self->_decryptCookie($cookie);
  #TODO test cookie creation time in addition to key validity time?
  if($state==0 && $orighash eq $self->_getOriginatorHash()) {
    $self->{AUTHNSTATE} = "passwd";
    $self->{USERDN} = $user;
    return(1);
  }
  $self->_log(5,"_cookieAuthen: Failed: orighash=" . $self->_getOriginatorHash());

  if ($state == 2) {
    $self->{ERRMSG}="reauthentication";
    return(0);
  }

  $self->{ERRMSG}="invalid cookie";
  $self->_log(1,"INVALID COOKIE from .$self->{REMOTE_ADDR}: $cookie");
  return(0)
}

# @return: 0 if all went correct
sub _log {
  my $self = shift;
  my $level = shift;
  my $msg = shift;

  return if($level>$self->{LOGLEVEL});

  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $year+=1900;
  $mon++;
  my $date = sprintf("$year-%02d-%02d %02d:%02d:%02d",
                     $mon,$mday,$hour,$min,$sec);

  if (! $self->{LOGFILE}) {
    print STDERR "$self->{REMOTE_ADDR} $date SecurityModule: $msg\n";
    return 0;
  }

  if( !$self->{LOGH} ) {
    if(! ($self->{LOGH} = IO::File->new(">>$self->{LOGFILE}")) )  {
      $self->{ERRMSG} = "Failed to open logfile " . $self->{LOGFILE};
      print STDERR "$date SecurityModule: Failed to open logfile " . $self->{LOGFILE}
        . ": $msg\n";
      return 1;
    }
    chmod 0600,$self->{LOGFILE};
  }


  #TODO: better log date formatting
  print {$self->{LOGH}} "$self->{REMOTE_ADDR} $date (L$level)" . $msg . "\n";

  return 0;
}


sub _createCryptKey {
  return Crypt::CBC->random_bytes(56);
}

# if $keyid is given the CIPHER will be initialised with
# the key matching this id (if available and still valid)
# @return: 0 if ok, 1 for invalid key, 2 for key too old,
#          3 for failure to create cipher object
sub _initCipher {
  my $self = shift;
  my $keyid = shift;

  my $rv;
  if ($keyid) {
    if ($rv = $self->_getCipherKey($keyid)) {
      if($rv == 1) {
        $self->{ERRMSG}="invalid cipher key ID $keyid";
        $self->_log(1,"WARNING: Failed to get cypher keys for ID $keyid");
      } elsif ($rv == 2) {
        $self->{ERRMSG}="old cipher key ID $keyid";
        $self->_log(3,"Refusing old cypher key (ID $keyid)");
      }
      return $rv;
    }
  } else {
    $self->_getCipherKey();
  }

  $self->{CIPHER} = Crypt::CBC->new( -cipher => 'Blowfish',
                                     -literal_key => 1,
                                     -key => $self->{CIPHERKEY},
                                     -iv => "dummyabc",
                                     -header      => 'none',
                                     -blocksize => 8,
                                     -keysize => 56
                                     -padding => 'standard'
                                   );

  return 0 if $self->{CIPHER};

  $self->_log(1,"Error: Failed to create cipher object: keyID $keyid, cipherkey:" .
              Dumper($self->{CIPHERKEY}));
  $self->{ERRMSG} = "failed to create cipher object";
  return 3;
}

# The random generated initialization vector is prepended to the
# encrypted text
sub _encrypt {
  my $self = shift;
  my $msg = shift;

  $self->_log(5,"msg to encrypt is >$msg< CIPHER: $self->{CIPHER}");
  #return "" if $msg == undef or $msg eq "";
  my $iv     = Crypt::CBC->random_bytes(8);
  $self->{CIPHER}->set_initialization_vector($iv);

  my $encr = $iv . $self->{CIPHER}->encrypt($msg);
  my $encr64 = encode_base64($encr);

  return $encr64;
}

sub _decrypt{
  my $self = shift;
  my $encr64 = shift;

  my $encr = decode_base64($encr64);
  my $iv = substr($encr,0,8,"");
  $self->{CIPHER}->set_initialization_vector($iv);

 my $decr;
  eval {
    $decr = $self->{CIPHER}->decrypt($encr);
  };
  if($@) {
    $self->_log(1,"Error: _decrypt: Failed to decrypt: $@");
    return undef;
  }

  return $decr;
}

#
#
# @return: (0,...) for ok, 1 for failed decryption or invalid key, 2 for key too old
#
sub _decryptCookie {
  my $self = shift;
  my $encrcookie = shift;

  my ($keyid,$encr) = $encrcookie =~ m/^([^|]+)\|(.+)$/s;
  return 1 if ! $keyid;

  my $rv;
  return $rv if ($rv = $self->_initCipher($keyid));

  my $decr = $self->_decrypt($encr);
  return 1 if ! $decr;
  my ($user,$time,$orighash) = split(/\|/,$decr);

  $self->_log(5,"_decryptCookie: $user | $time | $orighash");
  return (0,$user,$time,$orighash);
}

# prepares the cookie payload
sub _prepareCookie {
  my $self = shift;

  my $cleartxt = join("|",($self->{USERDN},time(),$self->_getOriginatorHash()));
  my $encr = $self->_encrypt($cleartxt);
  my $cookie =  $self->{KEYID} . "|" . $encr;

  return $cookie;
}


#
# Authenticate a user based on a password entered in the password form
#
# @return: 1 for authenticated, 0 for not authenticated
sub _passwordAuthen {
  my $self = shift;

  return 0 if $self->_initCipher();

  $self->{ERRMSG} = "";

  my $username = param("SecModLogin");
  my $pass = param('SecModPwd');

  my $dbpasswd = $self->_getUserPasswd($username);
  my $hash = crypt($pass,substr($dbpasswd,0,2));
  $self->_log(5,"_passwordAuthen: user $username, pass: $hash,  dbpass: $dbpasswd");
  if ($dbpasswd eq $hash) {
    $self->{AUTHNSTATE} = "passwd";
    if ($self->{USERDN} = $self->_getDNfromUsername($username)) {
      # for now we use no 'expires' value -expires =>'',
      $self->{COOKIE} = cookie(-name => "SecMod",
                               -value => $self->_prepareCookie(),
                               -secure => 1
                              );
      $self->_log(4,"Successful password authentication by $username for $self->{USERDN}");
      return(1);
    }

    $self->_log(3,"No distinguished name known for user $username");
    $self->{ERRMSG} = "No distinguished name known for user $username";
    return(0);
  }

  $self->{ERRMSG} = "Password verification failed";
  $self->_log(3,"Password verification failed for user $username");
  # TODO: pass on amount of failed attempts in hidden field and redirect after certain
  # number of failures?
  return(0);
}

sub _showPasswdForm {
  my $self = shift;
  my $msg = shift;

  # get rid of any unwanted url parameters
  (my $url = $self->{CALLER_URL}) =~ s/[&?]SecModLogout=1//;
  $url =~ s/[&?]SecModPwd=1//;

  if (ref($self->{PWDFORM_HANDLER}) eq "CODE") {
    &{$self->{PWDFORM_HANDLER}}($url,$msg);
    #TODO: should pass all params except SecMod* through to the next page
    exit 1;
  }
  print redirect($self->{PWDFORM_HANDLER} ."?caller_url=" .
                 urlencode($url) . "&msg=" . urlencode($msg));
  exit 1;

}

# A default password form
sub _passwordForm {
  my $caller_url = shift;
  my $msg=shift;

  my $q = new CGI;

  print $q->header,$q->start_html;
  print $q->start_form("POST","$caller_url","application/x-www-form-urlencoded");
  if ($msg) {
    print $q->h1("Error: " . $msg);
  } else {
    print $q->h1("Log in:");
  }
  print $q->p,"Login Name: ",$q->textfield('SecModLogin','',12,20);
  print $q->p,"Password: ",$q->password_field('SecModPwd','',20,30);
  print $q->p,$q->submit(-name=>'Submit',
                         -value=>'submit');
  print $q->endform;

  print $q->end_html;
  exit(0);
}

# A default page for failed certificate access
sub _reqcertFailHandler {
  my $authnstate = shift;
  my $userdn = shift;

  my $q = new CGI;
  print $q->header,$q->start_html;
  print "Access only with a valid certificate";
  if ($authnstate eq "passwd") {
    print " (and you are logged in via password)";
  } else {
    print $q->p,"Your Browser presented this certificate: " . $userdn if $userdn;
  }
  print $q->end_html;
  exit(0);

}

1;


=pod

=head1 NAME

SecurityModule.pm - Web Security Module

=head1 SYNOPSIS

Note: This applies specifically to the MySQL implementation. There is also
a SecurityModule::SQLite implementation.

  use SecurityModule::MySQL;
  $sec = new SecurityModule::MySQL;
  my $sec = new SecurityModule::MySQL({CALLER_URL => $myurl,
                                       CONFIG => "/etc/sec/SecMod.conf";
                                       LOGLEVEL => 5,
                                       KEYVALIDTIME => 7200,
                                       PWDFORM_HANDLER => \&myPasswordForm
                                      });

  $ret = $sec->init(); # returns 0 in case of failure

  $errmsg = $sec->getErrMsg(); # returns error message

  # if getCookie() returns a defined value, your page needs to make
  # sure that this cookie will be set using CGI.pm's
  # header(-cookie => $cookie ) command
  if( ($cookie=$sec->getCookie) ) {
    print header(-cookie => $cookie );
  } else {
    print header();
  }


  # Access to authentication / authorization information
  $state = $sec->getAuthnState(); # returns (failed | cert | passwd)
  $user_dn = $sec->getDN(); # returns user's distinguished name
  $roles = $sec->getRoles(); # returns a hash of roles, each role mapping to a
                             # list of scopes


  # Protecting functions: reqAuthnCert() and reqAuthnPasswd()
  sub my_certificate_protected_function {
    $sec->reqAuthnCert();
    ...
  }
  sub my_password_protected_function {
    $sec->reqAuthnPasswd();
    ...
  }

=head1 DESCRIPTION

The SecurityModule handles authentication and authorization to a web site. Users
are identified by a certificate loaded in their browser or by a previously
set cookie that was issued upon a successful password authentication.

Certificate based authentication is the strongest authentication type,
so functions protected by the reqAuthnPasswd() method will allow
access to certificate authenticated users, but reqAuthnCert() will deny
access to password authenticated users.

The SecurityModule was written for a setup where a B<remote Proxy> mediates access
to a number of backend servers. The remote proxy handles
the SSL authentication and is required to set the following request headers to
the values of the respective environment variables for this request:

B<SSL_CLIENT_VERIFY>,
B<SSL_CLIENT_S_DN>,
B<HTTPS>.

On the backend servers these must be available as environment variables of identical names
except for the prefix B<HTTP_>, e.g. B<HTTP_SSL_CLIENT_S_DN>.

Since all backend servers are hidden behind the reverse proxy, an authentication
cookie is set restrictively to only be sent back to the issueing server. The
necessary translation for the proxy is handled transparently by apache's mod_proxy
module (needs >= apache-2.2).

The SecurityModule can also be run without a reverse proxy in pure SSL mode (by
setting the REVPROXY_MODE option to 0), mainly for testing.

=head2 Initialization

Arguments which can be passed to the constructor:

=over 4

=item *

B<CALLER_URL>: (Required) URL of the current page that was invoked by
the browser, i.e. it must contain the URL which the reverse proxy got
before redirecting to the backend server.

=item *

B<REVPROXY_MODE>: 1 for reverse proxy mode, 0 for basic SSL mode. Default is 1.

=item *

B<CONFIG>: Filename of a configuration file. The file must contain "option = value"
lines as in this example:

   LOGFILE = /tmp/SecMod.log
   LOGLEVEL = 5
   KEYVALIDTIME = 1500
   # Comments and empty lines are allowed
   DBHOST = localhost
   DBPORT = 3306
   DBNAME = secmod
   DBUSER = smwriter
   DBPASS = mypasswd
   REQCERT_FAIL_HANDLER = https://localhost/bclear/testSecMod/nopermission
   PWDFORM_HANDLER = https://localhost/bclear/testSecMod/passform

B<Note>: The configuration options specified in the constructor will override
any options specified in the configuration file.

=item *

B<KEYVALIDTIME>: Validity time in seconds of generated keys

=item *

B<PWDFORM_HANDLER>: URL or reference to a function generating a
password page. If a function reference is given, two values will be
passed into the function: The URL of the present page (so we can get
back) and a status message describing why the password form was
called. If an URL is given, the two values will be passed using a
query string (?caller_url=...&msg=...) in the redirection.

        Status messages: password authentication required
                         reauthentication
                         invalid cookie

=item *

B<REQCERT_FAIL_HANDLER>: URL or reference to a function to call when a page secured by
reqAuthnCert() is encountered and the client is not certificate authenticated.
Typically, to display some diagnostic message.

=item *

B<LOGFILE>: Filename of the logfile

=item *

B<LOGLEVEL>: Integer value from 0-5

      0: no log messages at all
      1: error and security relevant messages only
      3: Logs password authentications (standard log level)
      5: debugging messages

=item *

For the MySQL implementation you can also supply the DB connection parameters
B<DBHOST, DBPORT, DBNAME, DBUSER, DBPASS>

=item *

For the SQLite implementation you only need to supply a B<DBFILE> parameter
with the location of the data base file.

=back

=head2 Calling the password form via a web page "Login" link:

You can pass B<SecModPwd=1> as a GET variable to any page using the
SecurityModule. This will call the handler for / redirect to the password form
and insure that the user can return to the same page.


=head1 AUTHOR

Derek Feichtinger <derek.feichtinger@psi.ch>

CMS web interfaces group <hn-cms-webInterfaces@cern.ch>


=head1 ISSUES / TODO

List of issues to resolve:

=over 4

=item *

POST arguments are not carried across the password form

=item *

The mapping from username to certificate distinguished name needs to be established
separately.

=item *

Look at "TODO" comments in the code.

=back
Revision:	1.2
Committed:	Fri Feb 16 10:25:08 2007 UTC (18 years, 2 months ago) by dfeichti
Content type:	text/plain
Branch:	MAIN
Changes since 1.1:	+47 -28 lines
Log Message:	- added note about current import routine doing a merge (i.e. not removing entries which are not present in the HN password file)