in reply to Re^17: global var
in thread global var

are those log messages from both the one that was failing and the one that worked? its hard to tell

IF the only thing you call in the working example is manageusers::OpenConnection() then why you you expect $manageusers::LoggedOn_user_id to be anything but zero? So You have yet to prove that you are actually setting $manageusers::LoggedOn_user_id by code that is being run anywhere. Show us all of the subroutines that contain the following code and any subroutines they call 

New login
warn("Hash evaluation succeded - $passhash = $passhash1 : $sessiondata
+2 = $sessiondata2md5p");
       my $timein = time();
       $session->param('user_id',$uid);
       $session->param('username',$username);
       $session->param('forename', $forename);
       $session->param('lastname', $lastname);
       $session->param('timein', $timein);
       $session->param('timeout', 0);
       $session->param('attempts',0);
       $session->param('isloggedin',1);
       $session->expires('+7d');
       $LoggedOn_user_id = $uid;  #$session->param("user_id");
[download]

Already logged on
  if ($status == 1) {
    warn("Process Login returning after confirmed already logged in: s
+tatus: '$status' sessionname:  '$sessionname' SID:  '$sid'");
    
    my $username1 = $session->param("user_id");
    warn("username1 : '$username1'");
    $LoggedOn_user_id = $username1;  
    warn("Already logged on LoggedOn_user_id : '$LoggedOn_user_id'");

[download]
In particular where $uid gets set before you run $LoggedOn_user_id = $uid;.

and i can become any user i want to be by manipulating the user_id parm i send back to you, that doesnt seem very secure does it? It is easy to create code that sends back any value i want in the user_id field

Replies are listed 'Best First'.
Re^19: global var
by tultalk (Monk) on Apr 11, 2017 at 20:14 UTC

    are those log messages from both the one that was failing and the one that worked? its hard to tell. The one that failed. No log from the one that worked . Ran in Padre and can't find log.

    "You have yet to prove that you are actually setting $manageusers::LoggedOn_user_id by code that is being run anywhere."

    The rwo code blocks above do exactly that.

    Entire code at end Filled with comments

    You say: In particular where $uid gets set before you run $LoggedOn_user_id = $uid; .

    $uid is popuated earlier in processing a new logon.

    "and i can become any user i want to be by manipulating the user_id parm i send back to you, that doesn't seem very secure does it? It is easy to create code that sends back any value i want in the user_id field"

    That makes no sense to me. When a legitimate user tries to log in, the username and password are encrypted and sent back for comparison to the username/password from the database as encrypted by the same algorithm on the server. 

    #---------------------------------------------------------------------
+----------
# FUNCTION:  ProcessLogonRequest($query)
# DESCRIPTION: Client requests log in: create session and send encrypt
+ion data
#---------------------------------------------------------------------
+----------
sub ProcessLoginRequest
{
  my ($query) = @_;
  my $status = 0;
#  $sessionname = 'CGISESSID';
#  my %cookies = CGI::Cookie->fetch;
#  my $sid = $cookies{$sessionname}->value; 
  my $sid = GetUserSessionCookie();
  warn("ProcessLoginRequest Query: '$query'");
  warn("ProcessLoginRequest SID from cookie: '$sid'");

  #Check if it got valid return from fetch cookie
  if ($sid ne 0){
    $status = 1;
  }
  #Or, check if valid return from cgi query
  elsif($query){
#    if (exists $query{$sessionname}){
     $sid = $query->param($sessionname);
   if ($sid){     
     warn("ProcessLogin Request SID from Query: '$sid'");
     $status = 1;
     }
   else{
     $sid = undef;
     $status = 2;
     }
  }
  else {
    #Set up for creating a new session
    $sid = undef;
    $status = 2;
  }
#  $sid = '7032f2c7f5a2c721a483dc75fc29595e';
  $session = new CGI::Session("driver:MySQL", $sid, {Handle=>$dbh});
  warn("session = '$session'");
  OpenSession($dbh,$sid);
  $session->param("#<expires>#",0);
  $session->param("isloggedin",0);
  $session->flush();
  $sid = $session->id();
  warn("ProcessLogin Request SID from from session create: '$sid'");
  my $sessiondata1 = $sid; #id created by CGI::Session;
  if ($status == 1) {
    warn("Process Login returning after confirmed already logged in: s
+tatus: '$status' sessionname:  '$sessionname' SID:  '$sid'");
    
    my $username1 = $session->param("user_id");
    warn("username1 : '$username1'");
    #my ($digits) = $text =~ /(\d+)/;
    #my ($user_id) = $username1 =~ /(\d+)/;
    
    #my $text = $username1;
    #$text =~ m/(\d+)/;
    #my $num = $1;
    #warn("num: '$num'");
    
    
    
    #$username1 =~ m/(\d+)/;
    $LoggedOn_user_id = $username1;  
    warn("Already logged on LoggedOn_user_id : '$LoggedOn_user_id'"); 
+   
    #$LoggedOn_user_id = 428;
    $adminaccess = ($username1 eq "admin");
    warn("username1: '$username1'");
    warn("adminaccess: '$adminaccess'");
    $session->param("isloggedin",1);
    
    
    $session->param('timein', time());
    $session->flush();
    return (1, "Your previous session is still valid. You are now logg
+ed in.", $sid, 0);
  }

  warn("Process Login after verify not logged in and new session: stat
+us: '$status' sessionname:  '$sessionname' SID:  '$sid'");

  #Random hash for encoding password
  my $seed_number = CreateRandomSequence(10, 1);
  my $seed_string = CreateRandomSequence(10, 0);
  my $sessiondata2 = md5_hex($ipaddress . $seed_number . $seed_string)
+;
  $session->param('sessiondata2',$sessiondata2);
  $session->expires('+7d');
#  Expires($session, Now() + 600);
  $session->flush();

  my $localtimenow = localtime(Now());
  warn("Process Login Request localtime(rightnow) = '$localtimenow'");

  return (2, $sessionname, $sessiondata1, $sessiondata2);
}

    [download]
    sub LoginUser
{
    my ($query) = @_;
    my ($day, $month, $year) = (localtime())[3,4,5];
    my $localtimenow = localtime(Now());
    $month = $month + 1;
    $year = $year + 1900;
    warn("Day: '$day' Month: '$month' Year: '$year'");
    my $currentdate = sprintf("%04d-%02d-%02d",$year,$month,$day);
#    warn("LoginUser-JustBefore Open Session  Current Time: '$localtim
+enow'");
    my $sid = $query->param('CGISESSID');
    if (!$sid){
        warn("Invalid SID at LoginUser ");
        return 0;
    }
    warn("LoginUser-JustBefore Open Session  Current Time: '$localtime
+now'");

    OpenSession($dbh,$sid);
    warn("LoginUser session: '$session' sid: '$sid'");
    my ($result, $login_timeout) = checkTimeinAttempts();
    warn("Returned result LoginUsercheckTimeinAttempts $result");
    if (($result == 0) || ($result == 4) || ($result == 5)) {
      if ($result == 5) {
        warn("Returned result 5: $result");
#        $session->delete();
#        $session->flush();
        return ($result, $login_timeout);
       }
      else{
        warn("Returned result other than 5: '$result'");
#        $session->delete();
#        $session->flush();
        return $result;
      }
    }
    my $username = $query->param("username");
    my $sessiondata2 = $query->param("sessiondata2");
    my $passhash = $query->param("passhash");
    $adminaccess = ($username eq "admin");
    
    warn("For AdminControl: $username");
    warn("For AdminControl: $adminaccess");
    my $SQL = qq|select user_id, password, forename, lastname, expire 
+from $sql_user_table where username = '$username'|;


    warn("Ready to execute SQL: $SQL");
    warn("LoginUser-JustBefore Execute Query  Current Time: '$localtim
+enow'");
    my $sth = ExecuteQuery($SQL);
    my ($uid,$password,$forename,$lastname,$expiredate) = $sth->fetchr
+ow_array();
    $sth->finish;
    warn ("LOGIN ATTEMPT USER INFORMATION Uid: $uid username: $usernam
+e  password: $password ipaddress: $ipaddress");

    # if we get an invalid username disconnect,disconnect and return w
+ithout access
    if (!$uid) {
         warn("Invalid Password manageusers Retrun 0");
#         $session->delete();
#         $session->flush();
         return 0;
    }

    # if the users expire date is less then the current date, disconne
+ct and
    # return without access
    #strip characters so numeric comparison caan be made
    $expiredate =~ s/-//g;
    $currentdate =~ s/-//g;
        warn(" Expire Date: '$expiredate'  Current Date: '$currentdate
+'  ");
    if($expiredate < $currentdate){
#       $session->delete();
#       $session->flush();
       return 2;
    }
    else {
      $sid = $session->id();
      my $sessiondata2s = $session->param('sessiondata2');
#      warn("sessiondata2 from session: '$sessiondata2s'");
      my $sessiondata2md5p = md5_hex($password . $sessiondata2s);
      my $passhash1 = md5_hex($password . $username);
       if (($passhash ne $passhash1) ||
           ($sessiondata2 ne $sessiondata2md5p)) {
         warn ("SID: '$sid' username: '$username' password: '$password
+'");
         warn("Hash evaluation failed - $passhash = $passhash1 : $sess
+iondata2 = $sessiondata2md5p");
#         $session->delete();
#         $session->flush();
         return 0;
       }
       warn("Hash evaluation succeded - $passhash = $passhash1 : $sess
+iondata2 = $sessiondata2md5p");
       my $timein = time();
       $session->param('user_id',$uid);
       $session->param('username',$username);
       $session->param('forename', $forename);
       $session->param('lastname', $lastname);
       $session->param('timein', $timein);
       $session->param('timeout', 0);
       $session->param('attempts',0);
       $session->param('isloggedin',1);
       $session->expires('+7d');
        $LoggedOn_user_id = $uid;  #$session->param("user_id");
       
       #$LoggedOn_user_id =  $username =~ /(\d+)/;
       warn("New User Login LoggedOn_user_id : '$LoggedOn_user_id'"); 
+          
       #$LoggedOn_user_id = 428;
       #Expires($session, Now() + (86400*7));
       AccessInOutLog($session); #Added 02/18/05
       my $isloggedin = $session->param('isloggedin');
       warn("Login User : SID '$sid'  Session Logged In  '$isloggedin'
+");
       $session->flush();

       #Set session cookie on client
       SetUserSessionCookie('CGISESSID', $sid);

       my $gmtimenow = gmtime(Now());
       my $localtimenow = localtime(Now());
       return 3;
    }
}

    [download]
[reply]
[d/l]
[select]

      The rwo code blocks above do exactly that.

      No they do not prove anything, you did not show us where that code was, how it was called, nor did you call it in your example.

      In the code you just showed us there are many reasons those code segments can be skipped leaving $LoggedOn_user_id set to its initial 0

      regarding $LoggedOn_user_id being undef

      at 

      #  $sid = '7032f2c7f5a2c721a483dc75fc29595e';
  $session = new CGI::Session("driver:MySQL", $sid, {Handle=>$dbh});

      [download]
      you dont check to see if $session->id() ne $sid. If they are not the same it is because either the $sid never existed or that session has expired. in either of those cases a new session-collection and session-id is created and when you try to use my $username1 = $session->param("user_id"); to set $LoggedOn_user_id = $username1; it will be undef as the following code demonstrates. 
      #!/usr/bin/perl
use strict; use warnings; 


select STDOUT; $| = 1;

use CGI;

use CGI::Session;
my $existn=0; 

my $sid=make_first(); 
sleep 10; find_if_exist ($sid); 
sleep 20; find_if_exist ($sid); 
find_if_exist('abcd'); 
exit; 

sub make_first {
my $session = new CGI::Session(undef, undef, {Directory=>'.'});

my $sid=$session->id; 

$session->expires('+15s');
$session->param('user_id',time);
$session->flush();
return $sid; 
} 


sub find_if_exist {
my $sid0=shift; 
$existn++; 
print '******Exist call:'.$existn."\n"; 
my $session = new CGI::Session(undef, $sid0, {Directory=>'.'});

my $sid=$session->id; 
my $user=$session->param('user_id'); 
unless (defined $user) {$user='undef-as-string'; } 
unless ($sid0 eq $sid) {print "********different   "; } 
print 'sid0:'.$sid0.' sid:'.$sid."\n"; 
print 'user:'.$user."\n\n";
}

      [download]
      result 
      ******Exist call:1
sid0:2bd4a7c8d0001e49e97dc332d6bf619e sid:2bd4a7c8d0001e49e97dc332d6bf
+619e
user:1491953482

******Exist call:2
********different   sid0:2bd4a7c8d0001e49e97dc332d6bf619e sid:bcd0c394
+67ce09c5b5be9910f9e1798b
user:undef-as-string

******Exist call:3
********different   sid0:abcd sid:2dd5bc5bc5e297150b1e4c7f58166135
user:undef-as-string

      [download]

[reply]
[d/l]
[select]

        Been sick.

        Back to this You siad to add this: 

        {
use strict; use warnings; 
my %wanted; 
$wanted{manageusers}=1; 

for my $inc (@INC) { 
  opendir (my $dh,$inc) || warn "Can't opendir $inc: $!";
  while (my $file=readdir $dh) {
    if ($file=~m/(.*)[.]pm$/) { 
      if ($wanted{$1}) { warn 'found:'.$inc.'/'.$file; } 
      }
    } 
  closedir $dh;
  }
}

        [download]

        What is it supposed to do? Error below: 

        
 Can't opendir /usr/local/apache/lib/perl: No such file or directory a
+t update_tables-development.cgi line 38. Tue Apr 11 11:26:22 2017 upd
+ate_tables-development.cgi: Can't opendir /usr/local/apache/lib/perl:
+ No such file or directory at update_tables-development.cgi line 38.

        [download]

        Also i have checked $LoggedOn_user_id in the code block for existing user loged on and new user login and in both cases $LoggedOn_user_id contains the value I expect. In neither case is $LoggedOn_user_id undefined or 0.

        The value is not passed across the boundary between the pm and the cgi script that calls for the value.

        You state: you dont check to see if $session->id() ne $sid. If they are not the same it is because either the $sid never existed or that session has expired.

        The $sid/session id is from the cookie. If the cookie expired then a new session is created. Both cases are addressed.

        The problem lies in my lack of understanding of the scope of variables and their persistence.

        running in padre still shows the variable in not exported by manageusers.

[reply]
[d/l]
[select]

        This is error log showing the value of LoggedOn_user_id after logon ( already logged on user) . Program waiting for next "click" before proceeding. 

        Entered GetUserSessionCookie Sessionname: 'CGISESSID' at /home/jalamio
+r/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm line 765.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: Entered GetUserSessionCoo
+kie Sessionname: 'CGISESSID' at /home/jalamior/www/httpsdocs/cgi-bin/
+lib/perl/manageusers.pm line 765.

SID From Get SeesionCookie: '09f0bc99abd030d73dd4686d3633f624' at /hom
+e/jalamior/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm line 773.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: SID From Get SeesionCooki
+e: '09f0bc99abd030d73dd4686d3633f624' at /home/jalamior/www/httpsdocs
+/cgi-bin/lib/perl/manageusers.pm line 773.

ProcessLoginRequest Query: 'CGI=HASH(0x873390)' at /home/jalamior/www/
+httpsdocs/cgi-bin/lib/perl/manageusers.pm line 238.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: ProcessLoginRequest Query
+: 'CGI=HASH(0x873390)' at /home/jalamior/www/httpsdocs/cgi-bin/lib/pe
+rl/manageusers.pm line 238.

ProcessLoginRequest SID from cookie: '09f0bc99abd030d73dd4686d3633f624
+' at /home/jalamior/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm lin
+e 239.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: ProcessLoginRequest SID f
+rom cookie: '09f0bc99abd030d73dd4686d3633f624' at /home/jalamior/www/
+httpsdocs/cgi-bin/lib/perl/manageusers.pm line 239.

SID befor new session : '09f0bc99abd030d73dd4686d3633f624' at /home/ja
+lamior/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm line 266.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: SID befor new session : '
+09f0bc99abd030d73dd4686d3633f624' at /home/jalamior/www/httpsdocs/cgi
+-bin/lib/perl/manageusers.pm line 266.

username1 : '428' at /home/jalamior/www/httpsdocs/cgi-bin/lib/perl/man
+ageusers.pm line 283.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: username1 : '428' at /hom
+e/jalamior/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm line 283.

Already logged on LoggedOn_user_id : '428' at /home/jalamior/www/https
+docs/cgi-bin/lib/perl/manageusers.pm line 296.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: Already logged on LoggedO
+n_user_id : '428' at /home/jalamior/www/httpsdocs/cgi-bin/lib/perl/ma
+nageusers.pm line 296.

username1: '428' at /home/jalamior/www/httpsdocs/cgi-bin/lib/perl/mana
+geusers.pm line 299.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: username1: '428' at /home
+/jalamior/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm line 299.

result = '1'   message0 = 'Your previous session is still valid. You a
+re now logged in.'   message1 = '09f0bc99abd030d73dd4686d3633f624'  m
+essage2 = '0' at manage_users.cgi line 87.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: result = '1'   message0 =
+ 'Your previous session is still valid. You are now logged in.'   mes
+sage1 = '09f0bc99abd030d73dd4686d3633f624'  message2 = '0' at manage_
+users.cgi line 87.

Already logged in so send client already logged in form This is in the
+ initial action GetLoginForm at manage_users.cgi line 96.

[Thu Apr 20 17:20:07 2017] manage_users.cgi: Already logged in so send
+ client already logged in form This is in the initial action GetLogin
+Form at manage_users.cgi line 96.

        [download]

        And here is the program code

        #!/usr/bin/perl -w
#---------------------------------------------------------------------
+----------
# Perl Script manage_users.cgi
# 02/12/2011 by R. Tulloch <tultalk@attglobal.net>
#Revised 2/25/2017 R Tulloch
# Based on lots of other folks work that went before me
# licensed under the GNU General Public License ver. 2.0
# see the accompaning LICENSE file
#---------------------------------------------------------------------
+----------
use strict;
use diagnostics -verbose;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI qw(:standard escapeHTML);
use CGI qw/:standard/;
use lib qw(/usr/local/apache/lib/perl);
use CGI::Session;
#use CGI::Switch;
#use feature ':5.12';
#use feature 'switch'; 
use Time::HiRes qw(usleep);

#local ($CGI::DISABLE_UPLOADS, $CGI::POST_MAX);
$CGI::DISABLE_UPLOADS = 1;          # Disable uploads
$CGI::POST_MAX        = 32 * 1024; # limit posts to 32K max


use lib qw(/home/jalamior/www/httpsdocs/cgi-bin/lib/perl);
#use Switch;
#use lib qw(/home/httpd/vhosts/jala-mi.org/cgi-bin/lib/perl);
#use lib qw(/srv/www/cgi-bin/lib/perl);
use manageusers qw(GetUserSessionCookie CheckForAuthorizedUser Process
+LostDataRequest ProcessLoginRequest LoginUser LogoutUser UpdateUserDa
+ta  GetUserLostData print_md5_javascript CheckValidLoginChar CheckVal
+idEmailChar);
#use Trace;

#---------------------------------------------------------------------
+----------
# Admin Configuration Section
#---------------------------------------------------------------------
+----------
#Association name and acronym
my $fbformtitle = "Jackson Area Landlords ";
my $fbacronym = "JALA";

#Only change page titles.
my $htmlFeedbackheader='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 T
+ransitional//EN"><html><head><title>User Feedback Form</title>';
my $htmlInvalidLoginheader='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.
+01 Transitional//EN"><html><head><title>Invalid Login Data Feedback F
+orm</title>';
my $htmlInvalidUpdateheader='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4
+.01 Transitional//EN"><html><head><title>Invalid Update Input Data Fe
+edback Form</title>';
my $htmlLoginheader='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Tran
+sitional//EN"><html><head><title>Login Form</title>';
my $htmlUpdateUserheader='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01
+ Transitional//EN"><html><head><title>Update User Information</title>
+';
my $htmlRequestMissingheader='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 
+4.01 Transitional//EN"><html><head><title>Lost Information Request</t
+itle>';
my $htmlheader2 = '<base href="http://www.jala-mi.org/"><meta http-equ
+iv="Content-Type" content="text/html;charset=iso-8859-1">';
my $htmlheader3 = '<link rel="StyleSheet" href="/css/jala.css" type="t
+ext/css">';
#our $loggedon_id =0;
my $accessAdmin = 0;
$accessAdmin = $manageusers::adminaccess;
#warn("accessAdmin =  '$accessAdmin'");
#---------------------------------------------------------------------
+----------
#  Non-Configuarable
#---------------------------------------------------------------------
+----------
my $query = new CGI;
my $cgiURL = CGI::url();
my %params = CGI::Vars();

#Error Handling
BEGIN {
 my $blank = "           "; 
require 5.004;
use CGI::Carp qw(fatalsToBrowser carpout);
my $logfile = '/home/jalamior/public_html/httpsdocs/cgi-bin/logs/error
+Log/errorFile.log';
open LOG, ">>$logfile" or die "Couldn't append to $logfile: $!\n";
carpout(\*LOG);
};


#---------------------------------------------------------------------
+----------
#  CGI Switch Tree
#---------------------------------------------------------------------
+----------
Main();

sub Main {
      my $action = $query->param('action');
 {
      #warn("Request for LoginForm manage_users.cgi: '$action'");
      ($action eq "GetLoginForm")  && do {
        manageusers::OpenConnection();
        #warn("Just before ProcessLoginRequest - create session = '$qu
+ery'");
        my ($result,$message0,$message1,$message2) = ProcessLoginReque
+st($query);
        warn("result = '$result'   message0 = '$message0'   message1 =
+ '$message1'  message2 = '$message2'");
        if(!$result){
           #warn("Tell client that login failed");
           manageusers::CloseConnection();
           LoginUserFailedForm("The Login Request failed due to some i
+nternal errot. Please try again or contact the office.");
           exit(0);
           #return; #exit;
        }
        elsif ($result == 1) {
          warn("Already logged in so send client already logged in for
+m This is in the initial action GetLoginForm");
          manageusers::CloseConnection();
          CreateAlreadyLoggedinForm($message0);
          exit (0); 
          #return;
        }

        elsif ($result == 2){
          #warn("Not logged in so send client login form");
          manageusers::CloseConnection();
          CreateLoginForm($message0, $message1, $message2);
          
          exit(0);
          #return; #exit;
        }
        };

        [download]

        No it is not all there. ust the aprt that produced the error log. 

        #---------------------------------------------------------------------
+----------
# Perl Modu
le manageusers
# 12/28/2003 by R. Tulloch <tultalk@attglobal.net>
# Revised 3/4/2017 9:37 am R Tulloch
# Based on lots of other folks work that went before me
# licensed under the GNU General Public License ver. 2.0
# see the accompaning LICENSE file
#---------------------------------------------------------------------
+----------
# This software is provided 'as-is' and without warranty. Use it at
# your own risk.
#
# JavaScript MD5 code by Paul Johnston <paj@pajhome.org.uk>
#
# * Version 1.1 Copyright (C) Paul Johnston 1999 - 2002.
# * Code also contributed by Greg Holt
# * See http://pajhome.org.uk/site/legal.html for details.
#
# The original Digest::MD5 Perl Module interface was written by
# Neil Winton <N.Winton@axion.bt.co.uk> and is maintained by
# Gisle Aas <gisle@ActiveState.com>
#
#---------------------------------------------------------------------
+----------
# The MD5 algorithm is defined in RFC 1321. The basic C code implement
+ing
# the algorithm is derived from that in the RFC and is covered by the
# following copyright:
#
# Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All righ
+ts
# reserved. License to copy and use this software is granted provided 
+that
# it is identified as the "RSA Data Security, Inc. MD5 Message-Digest
# Algorithm" in all material mentioning or referencing this software o
+r
# this function.
#
# License is also granted to make and use derivative works provided th
+at
# such works are identified as "derived from the RSA Data Security, In
+c.
# MD5 Message-Digest Algorithm" in all material mentioning or referenc
+ing
# the derived work.
#---------------------------------------------------------------------
+----------
package manageusers;

use strict;
use diagnostics -verbose;
use warnings;
use CGI;
#use Carp::Always;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI qw(:standard escapeHTML);
use CGI qw/:standard/;
use Data::Dumper;

use Digest::MD5 qw(md5_hex);
#use DB_File;    # persistent hash database
use CGI::Session;
use CGI::Cookie;
#use vars qw($session_cookie1 $session_cookie2 $login_timeout);
#use vars qw($session);
use Mail::Sendmail;
use Time::HiRes qw(usleep);
use Time::Local;
BEGIN {
    require Exporter;
    use vars qw($VERSION @ISA @EXPORT_OK);
    use DBI;
#    use vars qw(@ISA @EXPORT_OK);
#    $ENV{DBI_TRACE}=1;
#    $ENV{PERL_DBI_DEBUG}=1;

    @ISA = qw(Exporter);

    # exported functions
  our @EXPORT_OK = qw(
  &OpenConnection
  &OpenSession
  &ProcessLoginRequest
  &ProcessLostDataRequest
  &LoginUser
  &decodeEncryptedPassName
  &UpdateUserData
  &GetUserLostData
  &LogoutUser
  &GetUserSessionCookie
  &CheckForAuthorizedUser
  &Expires
  $LoggedOn_user_id
  &GetLoggedOnUserId
  $attempts
  $adminaccess
  &Now
  &CheckValidLoginChar
  &CheckValidEmailChar
  &print_md5_javascript);

  $VERSION = '0.0.1';
}

#  $LoggedOn_user_id


# package globals
#use vars qw($dbh $session $sessionname);
#use vars qw($dbh $session);
my $dbh = "";
my $session = '';
my $sessionname = "CGISESSID";

#my $database = "assoc_mgr";
#my $sql_user_table = "users";
#my $sql_session_table = "sessions";
#my $host = "localhost";

#my $sql_username = "administrator";
#my $sql_password = "lmi2048";

my $database = "jalamior_assoc_mgr";
my $sql_user_table = "users";
my $sql_session_table = "sessions";
my $host = "localhost";

my $sql_username = "jalamior_user";
my $sql_password = "jac2175";

my $domain = $ENV{'HTTP_HOST'};
my $ipaddress = $ENV{'REMOTE_ADDR'};
my $query = new CGI;
my $dsn = "dbi:mysql:database=$database;host=$host";
my $admin_log_file = "/home/jalamior/public_html/httpsdocs/cgi-bin/log
+s/memberaccess.log";
#my $admin_log_file = "/srv/www/cgi-bin/logs/memberaccess.log";
#my $sessionname = "a";
#my ($dbh,$session);
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{PATH} =~ /(.*)/ and $ENV{PATH} = $1;

#package variables
#my $mailprog = '/home/jalamior/public_html/httpsdocs/cgi-bin/lib/perl
+/mail/sendmail -oi';
#my $mailprog = '/usr/lib/sendmail -oi -t';
my $mailprog = '/usr/sbin/sendmail -oi -q -t';
my $session_cookie_timeout = '+7d';
my $login_timeout = 1000;
#my $seed_number = 0;
#my $seed_string = "";
our $adminaccess = 0;
our $LoggedOn_user_id = 555;

#Error Handling
BEGIN {
  require 5.004;
  use CGI::Carp qw(fatalsToBrowser carpout);
  my $logfile = '/home/jalamior/public_html/httpsdocs/cgi-bin/logs/err
+orLog/errorFile.log';
  open LOG, ">>$logfile" or die "Couldn't append to $logfile: $!\n";
  carpout(\*LOG);
};



#---------------------------------------------------------------------
+----------
#  Database Conection Functions
#---------------------------------------------------------------------
+----------
# FUNCTION:  OpenConnection()
# DESCRIPTION: Connect to the MySQL database
#---------------------------------------------------------------------
+----------
sub OpenConnection
{
    my $localtimenow = localtime(Now());
    $dbh = DBI->connect($dsn,$sql_username,$sql_password)
        or ErrorMessage("Could not connect to the database.");

    #warn("Open Connection-JustBefore returning database handle: '$dbh
+' Current Time: '$localtimenow'");
   return $dbh;
}


#---------------------------------------------------------------------
+----------
# FUNCTION:  CloseConnection
# DESCRIPTION: Disconnect from the MySQL database
#---------------------------------------------------------------------
+----------
sub CloseConnection
{
    my $localdbh = @_;
    my $localtimenow = localtime(Now());
    if ($localdbh){
        $localdbh->disconnect();
    }
    elsif ($dbh) {
        $dbh->disconnect();
    }
        #warn("Close Connection -just before exit  Current Time: '$loc
+altimenow'");
#    exit(0);
}

#---------------------------------------------------------------------
+----------
# FUNCTION:  ExecuteQuery($dbh,$SQL)
# DESCRIPTION:  Executes a query against the database ($dbh) using the
+ passed
#                SQL statement $SQL and returns the result set.
#---------------------------------------------------------------------
+----------
sub ExecuteQuery
{
    my ($SQL) = @_;

    my $sth = $dbh->prepare($SQL) || ErrorMessage($SQL);
    $sth->execute() || ErrorMessage($SQL);
    return $sth;
}

#---------------------------------------------------------------------
+----------
# FUNCTION:  ErrorMessage
# DESCRIPTION: Print the error message that is passed and we also outp
+ut to a log.
#---------------------------------------------------------------------
+----------
sub ErrorMessage
{
    my $message = shift;
    print qq|$message\n $DBI::errstr|;
#    CloseConnection();
}

#---------------------------------------------------------------------
+----------
# FUNCTION: OpenSession($dbh, $sid)
# Opens existing session or creates new depending on $sid
#---------------------------------------------------------------------
+----------
sub OpenSession{
  my ($dbh, $sid)= @_;
  $session  = new CGI::Session("driver:MySQL", $sid, {Handle=>$dbh, Lo
+ckHandle=>$dbh});
  return $session;
}

#---------------------------------------------------------------------
+----------
#  User Requests for Login,Update Data and Missing Data
#---------------------------------------------------------------------
+----------
# FUNCTION:  ProcessLogonRequest($query)
# DESCRIPTION: Client requests log in: create session and send encrypt
+ion data
#---------------------------------------------------------------------
+----------
sub ProcessLoginRequest
{
  my ($query) = @_;
  my $status = 0;
#  $sessionname = 'CGISESSID';
#  my %cookies = CGI::Cookie->fetch;
#  my $sid = $cookies{$sessionname}->value; 
  my $sid = GetUserSessionCookie();
  warn("ProcessLoginRequest Query: '$query'");
  warn("ProcessLoginRequest SID from cookie: '$sid'");

  #Check if it got valid return from fetch cookie
  if ($sid ne 0){
    $status = 1;
  }
  #Or, check if valid return from cgi query
  elsif($query){
#    if (exists $query{$sessionname}){
     $sid = $query->param($sessionname);
   if ($sid){     
     #warn("ProcessLogin Request SID from Query: '$sid'");
     $status = 1;
     }
   else{
     $sid = undef;
     $status = 2;
     }
  }
  else {
    #Set up for creating a new session
    $sid = undef;
    $status = 2;
  }

 
  #  $sid = '7032f2c7f5a2c721a483dc75fc29595e';
  warn("SID befor new session : '$sid'");
  $session = new CGI::Session("driver:MySQL", $sid, {Handle=>$dbh});
  #warn("session = '$session'");
  OpenSession($dbh,$sid);
  $session->param("#<expires>#",0);
  $session->param("isloggedin",0);
  $session->flush();
  $sid = $session->id();
  #warn("ProcessLogin Request SID from from session create: '$sid'");
  my $sessiondata1 = $sid; #id created by CGI::Session;



  if ($status == 1) {
    #warn("Process Login returning after confirmed already logged in: 
+status: '$status' sessionname:  '$sessionname' SID:  '$sid'");
    
    my $username1 = $session->param("user_id");
    warn("username1 : '$username1'");
    #my ($digits) = $text =~ /(\d+)/;
    #my ($user_id) = $username1 =~ /(\d+)/;
    
    #my $text = $username1;
    #$text =~ m/(\d+)/;
    #my $num = $1;
    #warn("num: '$num'");
    
    
    
    #$username1 =~ m/(\d+)/;
    $LoggedOn_user_id = $username1;  
    warn("Already logged on LoggedOn_user_id : '$LoggedOn_user_id'"); 
+   
    #$LoggedOn_user_id = 428;
    $adminaccess = ($username1 eq "admin");
    warn("username1: '$username1'");
    #warn("adminaccess: '$adminaccess'");
    $session->param("isloggedin",1);
    
    
    $session->param('timein', time());
    $session->flush();
    return (1, "Your previous session is still valid. You are now logg
+ed in.", $sid, 0);
  }

=for comment  
  #  $sid = '7032f2c7f5a2c721a483dc75fc29595e';
  $session = new CGI::Session("driver:MySQL", $sid, {Handle=>$dbh});
  #warn("session = '$session'");
  OpenSession($dbh,$sid);
  $session->param("#<expires>#",0);
  $session->param("isloggedin",0);
  $session->flush();
  $sid = $session->id();
  #warn("ProcessLogin Request SID from from session create: '$sid'");
  #my $sessiondata1 = $sid; #id created by CGI::Session;
=cut
  
  
  #warn("Process Login after verify not logged in and new session: sta
+tus: '$status' sessionname:  '$sessionname' SID:  '$sid'");

  #Random hash for encoding password
  my $seed_number = CreateRandomSequence(10, 1);
  my $seed_string = CreateRandomSequence(10, 0);
  my $sessiondata2 = md5_hex($ipaddress . $seed_number . $seed_string)
+;
  $session->param('sessiondata2',$sessiondata2);
  $session->expires('+7d');
#  Expires($session, Now() + 600);
  $session->flush();

  my $localtimenow = localtime(Now());
  #warn("Process Login Request localtime(rightnow) = '$localtimenow'")
+;

  return (2, $sessionname, $sessiondata1, $sessiondata2);
}

        [download]

        Too much code? Hey too much code. Not enough code? Hey not enough code.

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom