CGI::SessionM - Module provides sessions support inside CGI-scripts.

  Version 2.00
  05.03.2007

  #If your module SessionM.pm is located in another directory than @ISA array contains:
  #use lib 'path to your lib'; 
  use CGI::SessionM 2.00;

  -- or --

  # If your module SessionM.pm is located in another directory than @ISA array contains:
  unshift(@INC,"path to your lib");
  require CGI::SessionM;

  my $session = new CGI::SessionM(
    -content=>'user data string',
    -count=>5, # maximum count of unsuccessful 
               # attempt of password entering! (0 - endless attempts)
    -forbidden=>10800, # blocking period after unsuccessful 
               # login in seconds (3 hours by default)
    -time=>1200, # session life time, in seconds after last 
               # access to a page (20 minutes by default)
    -db=>'database name',
    -login=>'database username',
    -password=>'database password',
    -host=>'database server', # is empty by default
    -table=>'tablename for working with sessions data' 
               # "sessionm" by default
  );

  my ($err, @authdata) = $session->authorize($login, (<$password eq '********'>), $content);

  $login - autorizing user login.
  The expression (<$password eq '********'>) returns "true" 
  if entered password is correct!
  $content - user data string.
  $err - value returned by function (return code/error). 
  See the errors description in ERRORS chapter.
  @authdata - processed data. See details in DESCRIPTION chapter.

  my ($err, @authdata) = $session->validate($GUIDM);

  $GUIDM - GUIGM of session. This value passes from one 
  page to another on the site.
  $err - value returned by function (return code/error). 
  See the errors description in ERRORS chapter.
  @authdata - processed data. See details in DESCRIPTION chapter.

  my $err = $session->logout($GUIDM);

  $GUIDM - GUIGM of session. This value passes from one 
  page to another on the site.
  $err - value returned by function (return code/error). 
  See the errors description in ERRORS chapter.

  my ($err, $tablename) = $session->create_table();

  Be attentive! This function is relates to DDL queries class.
  $err - value returned by function (return code/error). 
  See the errors description in ERRORS chapter.
  $tablename - name of table to create.

  my $err = $session->logout($GUIDM);
  $GUIDM - GUIGM of session. This value passes from one
  page to another on the site.
  $err - value returned by function (return code/error). 
  See the errors description in ERRORS chapter.

  print $session->echo(<key>)

  <key> - one of the enumeration: 
   maxcnt,timeout,timedie,content,guidm,login,dt,id,cnt,table

  if ($err == 0) {
     print "Set-Cookie: guidm=$guidm;\n";
  } else {
    if ($err == 1) {
      $error = session->echoerr($err)." (attempt $authdata[0] of $authdata[1])";
    } elsif($err == 4) {
      $error = session->echoerr($err)." (service is not available till $authdata[0])";
    } elsif($err == 6) {
      $error = session->echoerr($err)." \{$authdata[0]\}";
    } else {
      $error = session->echoerr($err);
    }
  }

   CREATE TABLE sessionm (
      id INT(11) default NULL auto_increment,
      guidm char(39) default NULL,
      ip char(255) default NULL,
      dt INT(11) default NULL,
      login char(255) default NULL,
      cnt int(5) default NULL,
      content text default NULL,
      UNIQUE KEY (login),
      PRIMARY KEY (id))

##########################################################################
#
# Copyright (C) 1998-2007 Lepenkov Sergej (Serz Minus) <minus@mail333.com>
# Copyright (C) 1998-2007 D&D Corporation. All Rights Reserved
#
# Version: 2.00
# Date   : 05.03.2007
#
##########################################################################

########################################################################## SessionM
package CGI::SessionM;
use 5.008;
$VERSION = '2.00';
use strict;

my $dbh;   # example of DataBaseConnect
my $table = "sessionm"; # Work-Table (default)

# Òàáëèöà âíóòðåííèõ îøèáîê
my @errors = (
      "OK", #0
      "PASSWORD INCORRECT", #1
      "LOGIN INCORRECT", #2
      "GUIDM INCORRECT", #3
      "FORBIDDEN", #4
      "SESSION LOST", #5
      "SESSION EXPIRED", #6
      "UPDATE DONE", #7
      "TABLE CREATED", #8
      "LOGOUT DONE" #9
  ); 


BEGIN {
  use DBI;
}


sub new {
  my $class = shift;
  my @args = @_;
  my ($content, $maxcnt, $timeout, $timedie, $base, $login, $password, $host, $table_tmp);
  
  ($content, $maxcnt, $timeout, $timedie, $base, $login, $password, $host, $table_tmp) =
  _read_attributes([
        ['DATA','CONTENT','USERDATA'],
        ['COUNT','MAXCOUNT','MAXCNT'],
        ['TIMEOUT','FORBIDDEN','INTERVAL'],
        ['TIMEDIE','TIME'],
        ['BD','DB','BASE','DATABASE'],
        ['LOGIN','USER'],
        ['PASSWORD','PASS'],
        ['HOST','HOSTNAME','ADDRESS','ADDR'],
        ['TABLE','TABLENAME','NAME','SESSION','SESSIONNAME']
  ],@args) if defined $args[0];
  
  $table = $table_tmp if $table_tmp;

  my %properties = (
        maxcnt => $maxcnt || 0,   # ìàêñèìàëüíîå êîëè÷åñòâî ïîïûòîê! (0 - áåç îãðàíè÷åíèÿ)
        timeout => $timeout || 10800, # êîëè÷åñòâî ñåêóíä äåéñòâèÿ îãðàíè÷åíèÿ FORBIDDEN (3 ÷àñà)
        timedie => $timedie || 1200, # êîëè÷åñòâî ñåêóíä æèçíè ñåññèè ïîñëå çàëîãèíèâàíèÿ (20 ìèíóò)
        content => $content || '',
        guidm => '',
        login => '',
        dt => '',
        id => 0,
        ip => '',
        cnt => 0,
        table => $table
        # param => [@args]
  );
  
  #$dbh = DBI->connect("DBI:mysql:localhost", "root", "password");
  #my $dbih = $ENV{'REMOTE_ADDR'} eq '127.0.0.1' ?";host=192.168.4.106":'';
   
  my $dbih = '';
  $dbih = ";host=".$host if $host;
  $base = 'localhost' if $base eq '';
  my $dbis = "DBI:mysql:database=".$base.$dbih;
  my $dbil = $login || "root";
  my $dbip = $password || "";
  $dbh = DBI->connect($dbis, $dbil, $dbip) || die("Database connection error ($DBI::err) -> $DBI::errstr");
  my $self = bless {%properties}, $class; # example of object
  return $self;
}
sub create_table {
  my $self = shift;
  
  &_mysql_create_table();
  #return "TABLE CREATED (Table name: $table)";
  return (8, $table)
}

sub echo {
  my $self = shift;
  if (defined $_[0]) {
    return $self->{$_[0]};
  } else {
    return '';
  }
}
sub echoerr{
   #
   # errors
   #
   my $self = shift;
   my $indx = shift || 0;
   $errors[$indx] = "UNDEFINED ERROR #$indx: $!" unless exists $errors[$indx];
   return $errors[$indx];
}

sub authorize {
#
# Àâòîðèçàöèÿ
#
my $self = shift;
my $login = shift || '';
my $predicate = shift;
my $content = shift || '';
#return "LOGIN INCORRECT" if ($login eq '');
return 2 if ($login eq '');
my @login_data = _mysql_select_login_rec($login);
if (defined $login_data[0]){
    # çàïèñü ñóùåñòâóåò
    if ($predicate) {
      # ïàðîëü âåðåí
      if ($login_data[5] >= $self->{'maxcnt'} && $self->{'maxcnt'} > 0 && ($login_data[3]+$self->{'timeout'}) > time) {
        # èñòåêëè ïîïûòêè ;)
        #return "FORBIDDEN (service is not available till ".get_time($login_data[3]+$self->{'timeout'}).")";
        return (4, ($login_data[3]+$self->{'timeout'}));
      } else {
        # ïîïûòêè åùå åñòü!
        $self->_mysql_clear();
        $self->{'content'} = $content if $content;
        &_mysql_update_count($login,0,1,$self->{'content'}); # îáíóëåíèå ñ÷åò÷èêà if $login_data[5] > 0
        @login_data = _mysql_select_login_rec($login);
        ($self->{'guidm'},$self->{'ip'},$self->{'dt'},$self->{'login'},$self->{'cnt'}) = @login_data[1..5];
        return (0, @login_data);
      }
    } else {
      # ïàðîëü íå âåðåí
      if (($self->{'maxcnt'} == 0) || ($login_data[5] <= $self->{'maxcnt'})) {
          # ïîïûòêè åùå åñòü!
          if ($login_data[5] >= $self->{'maxcnt'}) {
            &_mysql_update_count($login,++$login_data[5]);
            #return "FORBIDDEN (service is not available till ".get_time($login_data[3]+$self->{'timeout'}).")";
            return (4, ($login_data[3]+$self->{'timeout'}));
          }
          # èíêðåìåíòèðóåì ñ÷åò÷èê ïîïûòîê
          #return "PASSWORD INCORRECT (attempt ".&_mysql_update_count($login,++$login_data[5])." of ".($self->{'maxcnt'}).")";
          return (1, &_mysql_update_count($login,++$login_data[5]), $self->{'maxcnt'});
      } else {
          # èñòåêëè ïîïûòêè ;) 
          if (($login_data[3]+$self->{'timeout'}) <= time) {
            # òàéìàóò èñòåê!
            # èíèöèàëèçèðîâàòü ñ÷åò÷èê ñáðîñèâ åãî çàíà÷åíèå äî åäèíèöû
            #return "PASSWORD INCORRECT (attempt ".&_mysql_update_count($login,1)." of ".($self->{'maxcnt'}).")";
            return (1, &_mysql_update_count($login,1), $self->{'maxcnt'});
          } else {
            # òàéìàóò íå èñòåê!
            #return "FORBIDDEN (service is not available till ".get_time($login_data[3]+$self->{'timeout'}).")";
            return (4, ($login_data[3]+$self->{'timeout'}));
          }
          
      }
    }
} else {
    # çàïèñè ïî ëîãèíó íåò
    $self->{'content'} = $content if $content;
    @login_data = _mysql_create_session($login,$self->{'content'});
    ($self->{'guidm'},$self->{'ip'},$self->{'dt'},$self->{'login'},$self->{'cnt'}) = @login_data[1..5];
    if ($predicate) {
      # ïàðîëü âåðåí
      $self->_mysql_clear();
      return (0,@login_data);
    } else {
      # ïàðîëü íå âåðåí
      # èíêðåìåíòèðóåì ñ÷åò÷èê ïîïûòîê
      #return "PASSWORD INCORRECT (attempt ".&_mysql_update_count($login,++$login_data[5])." of ".($self->{'maxcnt'}).")";
      return (1, &_mysql_update_count($login,++$login_data[5]), $self->{'maxcnt'});
    }

}

}
sub validate {
#
# Ïîëó÷åíèå äàííûõ ñåññèè è âûõîä ïî èñòå÷åíèþ ñðîêà åå æèçíè
#
my $self = shift;
my $guidm = shift || '';
#return "GUIDM INCORRECT (check is cookies accessible)" if ($guidm !~ /^[A-F0-9\-]{39}$/i);
return 3 if ($guidm !~ /^[A-F0-9\-]{39}$/i);
my @guidm_data = _mysql_select_guidm_rec($guidm);

if (defined $guidm_data[0]) {
  # äàííûå åñòü â áàçå
  if (($guidm_data[3]+$self->{'timedie'}) > time ) {
    # Ïåðèîä æèçíè ñåññèè íå èñòåê!
    _mysql_update_dt($guidm);
    ($self->{'guidm'},$self->{'ip'},$self->{'dt'},$self->{'login'},$self->{'cnt'}) = @guidm_data[1..5];
    return (0,@guidm_data);
  } else  {
    # Ïåðèîä æèçíè ñåññèè èñòåê!
    # óáèâàåì âñå ñåññèè ËÎÃÈÍÀ, âðåìÿ æèçíè êîòîðûõ èñòåêëî
    &_mysql_delete_session($guidm);
    #return "SESSION EXPIRED \{$guidm_data[1]\}";
    return (6,$guidm_data[1]);
  }
} else {
  # äàííûõ ÍÅÒ â áàçå
  #return "SESSION LOST (check is cookies accessible)";
  return 5;
}
return (0,@guidm_data);
}
sub update {
#
# Îáíîâëåíèå ïîëüçîâàòåëüñêèõ äàííûõ â áàçå ïî guidm
#
my $self = shift;
my $guidm = shift || '';
my $content = shift || '';
&_mysql_update_data($guidm,$content);
#return "UPDATE DONE";
return 7;
}
sub logout {
#
# Ïîëó÷åíèå äàííûõ ñåññèè è âûõîä ïî èñòå÷åíèþ ñðîêà åå æèçíè
#
my $self = shift;
my $guidm = shift || '';
&_mysql_delete_session($guidm);
#return "LOGOUT DONE";
return 9;
}
sub _mysql_select_login_rec {
#
# Âçÿòèå çàïèñè ïî ëîãèíó
#
  my $login = shift || '';
  my $sql;
  $sql="SELECT * FROM $table WHERE login=\'".&slash($login)."\'";
  my @retdata = &_MYSQL_EXECUTE_RECORD($sql);
  return @retdata;
}
sub _mysql_select_guidm_rec {
#
# Âçÿòèå çàïèñè ïî GUIDM
#
  my $guidm = shift || '';
  my $sql;
  $sql="SELECT * FROM $table WHERE guidm=\'".&slash($guidm)."\'";
  my @retdata = &_MYSQL_EXECUTE_RECORD($sql);
  return @retdata;
}
sub _mysql_create_table {
#
# Ñîçäàíèå íîâîé òàáëèöû
#
 
  my $sql="
    CREATE TABLE $table (
          id INT(11) default NULL auto_increment,
          guidm char(39) default NULL,
          ip char(255) default NULL,
          dt INT(11) default NULL,
          login char(255) default NULL,
          cnt int(5) default NULL,
          content text default NULL,
          UNIQUE KEY (login),
          PRIMARY KEY (id))
    ";
  
  &_MYSQL_EXECUTE($sql);

}

sub _mysql_create_session {
#
# Ñîçäàíèå íîâîé ñåññèè
#
# íà âõîä:
#   - $login
#   - @data
# íà âûõîäå:
#   - âñå ñîçäàííûå ïîëÿ

  my $login = shift || '';
  my $content = shift || ''; # defined $_[0]?join "\t", @_ :'';
  my $guidm = get_guidm();
  my $ip = $ENV{'REMOTE_ADDR'} || '';
  my $dt = time;
  my $cnt = 0;
  
  my $sql;
  $sql="INSERT INTO $table(guidm,ip,dt,login,cnt,content) VALUES (\'$guidm\',\'$ip\',\'$dt\',\'".&slash($login)."\',\'$cnt\',\'".&slash($content)."\')";
  my @retdata;
  if ($login ne '') {
    &_MYSQL_EXECUTE($sql);
    @retdata = _mysql_select_login_rec($login);
  }
  return @retdata;
}

sub _mysql_update_count {
#
# Îáíîâëåíèå ñ÷åò÷èêà è âðåìåíèäîñòóïà äëÿ óêàçàííîãî ëîãèíà
#
# íà âõîä:
#   - $login
#   - $cnt
# íà âûõîäå:
#   - $cnt

  my $login = shift || '';
  my $cnt = shift || 0;
  my $gmflag = shift || 0;
  my $content = shift || '';
  my $dt = time;
  
  
  my $sql;
  $sql="UPDATE $table SET dt=\'$dt\', cnt=\'$cnt\' ".($gmflag?(", guidm=\'".get_guidm()."\', content=\'".&slash($content)."\'"):'')." WHERE login = \'".&slash($login)."\'";
  if ($login ne '') {
    &_MYSQL_EXECUTE($sql);
  }
  #return @retdata;
  return $cnt;
}
sub _mysql_update_data {
#
# Îáíîâëåíèå ïîëüçîâàòåëüñêèõ äàííûõ ñåññèè
#
# íà âõîä:
#   - $guidm
#   - $content
# íà âûõîäå:
#   - $content

  my $guidm = shift || '';
  my $content = shift || '';


  my $sql;
  $sql="UPDATE $table SET content=\'".&slash($content)."\' WHERE guidm = \'".&slash($guidm)."\'";
  my @retdata;
  if ($guidm ne '') {
    &_MYSQL_EXECUTE($sql);
  }
 
  return $content;
}
sub _mysql_delete_session {
#
# Óäàëåíèå óêàçàííîé ñåññèèé
#
  my $guidm = shift || '';
  my $sql;
  $sql="DELETE FROM $table WHERE guidm = '".&slash($guidm).'\'';
  # dt < '.(time - $self->{'timedie'}).' and 
  &_MYSQL_EXECUTE($sql);

}
sub _mysql_clear {
#
# Óäàëåíèå ñåññèèé, âðåìÿ æèçíè êîòîðûõ èñòåêëî
#
  my $self = shift;
  my $sql;
  $sql="DELETE FROM $table WHERE (cnt < ".($self->{'maxcnt'}).' and dt < '.(time - $self->{'timedie'}).') or dt < '.(time - $self->{'timeout'});
  
  # (A ang C) or B
  # A - cnt < $self->{'maxcnt'}          # ñ÷åò÷èê â äîïóñòèìûõ çíà÷åíèÿõ
  # B - dt < (time - $self->{'timeout'}) # ïåðèîä çàïðåòà èñ÷åðïàí (èñòåê)
  # C - dt < (time - $self->{'timedie'}) # ïåðèîä âðåìåíè æèçíè ñåññèè èñòåê

  &_MYSQL_EXECUTE($sql);
  return 1;
  
}
sub _mysql_update_dt {
#
# Îáíîâëåíèå âðåìåíè äîñòóïà äëÿ óêàçàííîãî GUIDM
#
my $guidm = shift || '';
my $dt = time;

  my $sql;
  $sql="UPDATE $table SET dt=\'$dt\' WHERE guidm = \'".&slash($guidm)."\'";
  if ($guidm ne '') {
    &_MYSQL_EXECUTE($sql);
  }
  return 1;
}
sub _MYSQL_EXECUTE_RECORD {
 my $sql = shift || '';
 my $sth = $dbh->prepare($sql) or die($dbh->errstr."<br><br>MySQL: Can't prepare query: <br><br>$sql ");
 my $rv = $sth->execute or die($dbh->errstr."<br><br>MySQL: Can't execute expression: <br><br>$sql ");
 my @result = $sth->fetchrow_array;
 return @result;
}
sub _MYSQL_EXECUTE_FIELD {
 my $sql = shift || '';
 my $sth = $dbh->prepare($sql) or die($dbh->errstr."<br><br>MySQL: Can't prepare query: <br><br>$sql ");
 my $rv = $sth->execute or die($dbh->errstr."<br><br>MySQL: Can't execute expression: <br><br>$sql ");
 my @result = $sth->fetchrow_array;
 return $result[0] || '';
}
sub _MYSQL_EXECUTE {
 my $sql = shift || '';
 my $sth = $dbh->prepare($sql) or die($dbh->errstr."<br><br>MySQL: Can't prepare query: <br><br>$sql ");
 my $rv = $sth->execute or die($dbh->errstr."<br><br>MySQL: Can't execute expression: <br><br>$sql ");
 return '';
}
sub AUTOLOAD {
    my $self = shift;
    if (defined $_[0]) {
        $self->echo(@_ );
    } else {
        $self->echo();
    }
}

DESTROY {
  $dbh->disconnect;
}

sub get_guidm {
#
# Procedure return GUIDM
#
# Example: {01BF-05E9-46F3-FF1F-B91B-6681-C3A9-15FB}
#

my $guidm = "";
my $value ='';
for (my $i=0; $i<8;$i++) {
  $value = '0000'.sprintf "%X",int(rand((2**16)-1));
  $value =~ s/^[0-9A-F]+([0-9A-F]{4})$/$1/;
  $guidm .= "-".$value;
}
$guidm=~s/^\-//;
return $guidm;
}



sub slash {
#
# Ïðîöåäóðà óäàëÿåò ñèñòåìíûå äàííûå èç ñòðîêè çàìåíÿÿ èõ 
#
my $data_staring=shift || '';

$data_staring=~s/\\/\\\\/g;
$data_staring=~s/'/\\'/g;

return $data_staring;
}
sub get_time {
 my @dt = localtime(shift || time);
 #my @months=('ßíâàðü','Ôåâðàëü','Ìàðò','Àïðåëü','Ìàé','Èþíü','Èþëü','Àâãóñò','Ñåíòÿáðü','Îêòÿáðü','Íîÿáðü','Äåêàáðü');
 my @months=('jan','feb','mar','apr','may','jun','jul','aug','sep','oct','nov','dec');
 return ($months[$dt[4]].' '.$dt[3].', '.($dt[5]+1900).' '.$dt[2].':'.$dt[1]);
}

sub _read_attributes {
    my($order,@param) = @_;
    return () unless @param;

    if (ref($param[0]) eq 'HASH') {
	@param = %{$param[0]};
    } else {
        return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
    }

    # map parameters into positional indices
    my ($i,%pos);
    $i = 0;
    foreach (@$order) {
	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) {
            $pos{lc($_)} = $i;
        }
	$i++;
    }

    my (@result,%leftover);
    $#result = $#$order;  # preextend
    while (@param) {
	my $key = lc(shift(@param));
	$key =~ s/^\-//;
        if (exists $pos{$key}) {
	    $result[$pos{$key}] = shift(@param);
	} else {
	    $leftover{$key} = shift(@param);
	}
    }

    push (@result,_make_attributes(\%leftover,1)) if %leftover;
    @result;
}

sub _make_attributes {
    my $attr = shift;
    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
    my $escape = shift || 0;
    my(@att);
    foreach (keys %{$attr}) {
	my($key) = $_;
        $key=~s/^\-//;
	($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
	my $value = $escape ? $attr->{$_} : $attr->{$_};
	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
    }
    return @att;
}



1;

__END__