in reply to Re: Sessions Questions
in thread Sessions Questions

The modules are mine. I just did a search in the module on expire and no hit which set expire to 1 day. I uncommented the line with +7d and commented out the line with now() + (86400*7)and tghe session still expires in 1 day. Weird. Code block below is the whole login:

#------------------------------------------------------------------------------- # FUNCTION: LoginUser($dsn,$sql_username,$sql_password,$sql_user_table,$sql_session_table,$passhash,$sessionhash,$uvId,$username,$ipaddress); # DESCRIPTION: The user will log in, sending the username and password #------------------------------------------------------------------------------- 


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 login 330");
        return 0;
    }
    warn("LoginUser-JustBefore Open Session  Current Time: '$localtime
+now'");

    OpenSession($dbh,$sid);
    warn("LoginUser Line 285 session: '$session' sid: '$sid'");
    my ($result, $login_timeout) = checkTimeinAttempts();
    warn("Returned result line 293: $result");
    if (($result == 0) || ($result == 4) || ($result == 5)) {
      if ($result == 5) {
        warn("Returned result line 296: $result");
#        $session->delete();
#        $session->flush();
        return ($result, $login_timeout);
       }
      else{
        warn("Returned result line 302: '$result'");
#        $session->delete();
#        $session->flush();
        return $result;
      }
    }
    my $username = $query->param("username");
    my $sessiondata2 = $query->param("sessiondata2");
    my $passhash = $query->param("passhash");

    warn("Line 360 Username: $username");
    my $SQL = qq|select 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: $us
+ername  password: $password ipaddress: $ipaddress");

    # if we get an invalid username disconnect,disconnect and return w
+ithout access
    if (!$uid) {
         warn("Invalid Password manageusers 371");
#         $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("Line 465 Expire Date: '$expiredate'  Current Date: '$cur
+rentdate'  ");
    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 line 406 - $passhash = $passhash
+1 : $sessiondata2 = $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');
#       Expires($session, Now() + (86400*7));
       AccessInOutLog($session); #Added 02/18/05
       my $isloggedin = $session->param('isloggedin');
       warn("Login User Line 420: SID '$sid'  Session Logged In  '$isl
+oggedin'");
       $session->flush();

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

       my $gmtimenow = gmtime(Now());
       my $localtimenow = localtime(Now());
#       warn("Login gmtime(gmtnow) =  '$gmtimenow'");
#       warn("Login localtime(localnow) = '$localtimenow'");
       return 3;
    }

[download]

Replies are listed 'Best First'.
Re^3: Sessions Questions
by huck (Prior) on Mar 01, 2017 at 23:30 UTC

    I'd love to have you explain what you think is in %query

    I'm going to take pity and assume its use CGI::Session;

    http://search.cpan.org/~sherzodr/CGI-Session-3.95/Session.pm
    expire($time)
    Sets expiration date relative to atime().     so Now() + (86400*7) was real huge considering now is something close to 1488409938.

    Seems expire and expires does the same thing 

    # expires() - alias to expire(). For backward compatibility
sub expires {
    return expire(@_);
}

    [download]

    This works just fine for me 

    #!/usr/bin/perl
use strict; use warnings; 


select STDOUT; $| = 1;

use CGI;

use CGI::Session;
use Data::Dumper;
use HTML::Entities qw/encode_entities/;

  my $q = CGI->new;

  my $tssid  = $q->cookie('TSSID');
  my $title='huh'; 
  my $cookie=undef; 
  my $delete=0; 
  my @lines; 
  my $session; 
  unless ($tssid){ 
      $session = new CGI::Session(undef, undef, {Directory=>'/tmp'});
      $cookie = $q->cookie(TSSID => $session->id );
      $title='No session'; 
      push @lines,$title; 
      setup_new($session);
      } # no ssid 
  else { 
      push @lines,'tssid:'.$tssid;
      $session = new CGI::Session(undef, $tssid, {Directory=>'/tmp'});
      if ($tssid ne $session->id) { 
          $cookie = $q->cookie(TSSID => $session->id );
          setup_new($session);
          $title='Expired Session .. made new one'; 
          push @lines,$title; 
          } 
      else { 
          $delete=5>int(rand(10)); 
          $title='old session'; 
          if ($delete) { 
              $cookie = $q->cookie (
                        -name    => 'TSSID',
                        -value   => '',
                        -path    => '/',
                        -expires => '-1d'
                        );
              push @lines,'deleted'; 
              } # delete 
          } #  not expired 
      } # not missing 
  if ($cookie){ print $q->header(-cookie=>$cookie);} 
  else { print $q->header();} 
  print '<head><title>'.$title.'</title></head>'."\n"; 
  print '<body>'."\n"; 
  print '<br>session:'.$session->id."\n"; 
  for my $l (@lines) {print '<br>'.$l."\n"; } 
  print '<pre>'."\n"; 

local $Data::Dumper::Deepcopy=1;
local $Data::Dumper::Purity=1;
local $Data::Dumper::Sortkeys=1;
local $Data::Dumper::Indent=2; 

  print encode_entities(Dumper($session))."\n";

  print '</pre>'."\n"; 
  print '</body>'."\n"; 
  if ($delete){$session->delete();} 
  exit; 

sub setup_new { 
my $session=shift; 
my $expires=5>int(rand(10))?'+1m':'+7d'; 

#    $session->expire('+1m');
    $session->expires($expires);
#    $session->expires('+7d');


       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);
}

    [download]
    Notice the 50% chance of being deleted, and the 50% chance of +1m vs +7d. refresh it a few times to watch it delete-cycle and expire-cycle. I'm Looking at a '_SESSION_ETIME' => 604800, run now, thats 7 days.

    play with that, get it to do what you want them make LoginUser do the same thing

    so what does AccessInOutLog($session); #Added 02/18/05 do, are you sure it doesnt change expires?

    and i just love 

    warn ("*****LOGIN ATTEMPT USER INFORMATION Uid: $uid username: $userna
+me  password: $password ipaddress: $ipaddress");

    [download]
    Maybe you need to email me your error.log so i can debug farther

[reply]
[d/l]
[select]

      Hi: I'd love to have you explain what you think is in %query It is used all over and contains the parameters (pairs) of the request. "Sets expiration date relative to atime(). so Now() + (86400*7) was real huge considering now is something close to 1488409938." Indeed. Tried with Now() + 7d and it did not work. There is a skunk in the woodpile somewhere. Please bear with me, I have not "really" revisited this code for 12-13 years. 

      
#---------------------------------------------------------------------
+----------
# Log File Functions
#---------------------------------------------------------------------
+----------
# FUNCTION: AccessInOutLog($username, $forename, $lastname, $timein,$i
+paddress,$timeout);
# DESCRIPTION: Enters user information in log file
#---------------------------------------------------------------------
+----------
sub AccessInOutLog {
     use Time::localtime;
     my $username = $session->param('username');
     my $forename = $session->param('forename');
     my $lastname = $session->param('lastname');
     my $timein = $session->param('timein');
     #my $ipaddress = $session->remote_addr();
     my $timeout = $session->param('timeout');

     warn("AccessInOutLog line 688: $username  $forename  $lastname $t
+imein $ipaddress $timeout");

#---------------------------------------------------------------------
+----------
#    Format the log in time
     my $tm = localtime($timein);
     my $intimestamp =  sprintf("Log In: %4d-%02d-%02d %02d:%02d:%02d"
+,$tm->year + 1900,$tm->mon + 1,$tm->mday,$tm->hour,$tm->min,$tm->sec)
+;
     warn "$timein,$intimestamp";
#---------------------------------------------------------------------
+----------
#    Format the log out time
     $tm = localtime($timeout);
     my $outimestamp =  sprintf("Log Out: %4d-%02d-%02d %02d:%02d:%02d
+",$tm->year + 1900,$tm->mon + 1,$tm->mday,$tm->hour,$tm->min,$tm->sec
+);
     warn "$timeout,$outimestamp";
#---------------------------------------------------------------------
+----------
#    Open the log file and append the entries
     open(ACCESSLOG, "+>>$admin_log_file") or LogErrorMessage("Unable 
+to open log file $admin_log_file\n");
     print ACCESSLOG $intimestamp . " " . $outimestamp . "  Username =
+ " . $username . "  Name = " . $forename . " " . $lastname . "  IP Ad
+dress = " . $ipaddress . "\n";
     close(ACCESSLOG);
}

      [download]

      Example from log: Log In: 2017-02-26 11:32:16 Log Out: 1969-12-31 18:00:00 Username = admin Name = Admin Access IP Address = 72.168.129.123 Log In: 2017-02-26 15:55:14 Log Out: 1969-12-31 18:00:00 Username = admin Name = Admin Access IP Address = 72.168.129.123 Log In: 2017-02-26 18:06:59 Log Out: 1969-12-31 18:00:00 Username = admin Name = Admin Access IP Address = 72.168.129.123 Log In: 2017-02-26 18:10:31 Log Out: 1969-12-31 18:00:00 Username = admin Name = Admin Access IP Address = 72.168.129.123 Log In: 2017-02-26 19:08:26 Log Out: 1969-12-31 18:00:00 Username = admin Name = Admin Access IP Address = 72.168.129.123 Log In: 2017-02-27 23:47:36 Log Out: 1969-12-31 18:00:00 Username = admin Name = Admin Access IP Address = 72.168.129.123

[reply]
[d/l]

        It is used all over and contains the parameters (pairs) of the request. No it isnt/doesnt, $query seems to have a cgi object in it, but %query (a whole nother thing) if dumped would look like 

        {
$dsn               =>$sql_username,
$sql_password      =>$sql_user_table,
$sql_session_table =>$passhash,
$sessionhash       =>$uvId,
$username          =>$ipaddress
}

        [download]
        $query->param(...) is not the same as $query{admin} (which at times contains '72.168.129.123').

        Those wern't the error.log lines of interest, the ones from this were 

        warn ("*****LOGIN ATTEMPT USER INFORMATION Uid: $uid username: $us
+ername  password: $password ipaddress: $ipaddress");

        [download]

        I understand old code too, been looking over the stuff i wrote back in '96, full of &subroutine calls, *var=... statements, raw socket setups, and require 'cgi-lib.pl' statements. But i cant find the dos bigperl code, it may only exist on floppys now

        You need to step back and look at what is really going on, not what you think is going on. you are using global variables that you dont know where they are being set, ie 

             #my $ipaddress = $session->remote_addr();
     warn("AccessInOutLog line 688: $username  $forename  $lastname $t
+imein $ipaddress $timeout");

        [download]
        I showed $session->expires() still works just fine, if you are not getting what you want by it you need to find out everywhere you change it and figure out which one is the last one to change it.

        And warn(...) to the error.log is not the way to debug. You have stuff in there that shouldnt be there. Those logs could be archived for years and years.

[reply]
[d/l]
[select]
      Hi: I'd love to have you explain what you think is in %query Tail between legs. sub ProcessLoginRequest { my %query = @_; <-----produces error log entry below and derails code to determine if already logged in. Sat Mar 04 18:53:25 2017 error client 72.168.128.100 Sat Mar 4 18:53:25 2017 manage_users.cgi: Reference found where even-sized list expected at /home/jalamior/www/httpsdocs/cgi-bin/lib/perl/manageusers.pm line 211., referer: http://jala-mi.org/ Tired and blind. Can't figure this out. Also a side question, the warn( in my cgi scripts do not print in the error log but the warn( from the pm (modules do? Should have researched this more based on your first comment. Best regards Robert
[reply]

        My response about what was in %query was based on the line above 

        LoginUser($dsn,$sql_username,$sql_password,$sql_user_table,$sql_sessio
+n_table,$passhash,$sessionhash,$uvId,$username,$ipaddress);

        [download]
        that i took to be the call to this subroutine.I had counted the args and determined it was even so your "even-sized list expected" message made me wonder, so I searched other posts of yours and found much to my surprise that that the actual calling code seems to be 
        my ($result, $login_timeout) = LoginUser($query);

        [download]


        A hash, (something starting with a % sign, or used as $something{...}, or $something->{...}) can be thought of a special array with a even number of elements and the odd numbered elements have special magic associated with them. This allows you to assign an list to them like %hash=('a','b'); or often seen as %hash=(a=>'b');. A reference to an @array is seen as a list, and here @_ is an array of the arguments to the call, so %query=@_; qualifies as assigning a list to a hash. but the list needs to have an even number of items in it to properly make the hash work. when use warnings; is in effect you get an warning if a list assignment is made to a hash and the number of items in it is not even, as you now have seen. Warnings do not stop the program tho.

        I still stand by my assertion that you do not understand what is in %query, in a similar call 
        use CGI; 
my $query=new CGI; 
test($query); 

sub test { 
my (%query)=@_; 
use Data::Dumper; 
print Dumper(\%query); 
}

        [download]
        Dumper shows 
        $VAR1 = {
          'CGI=HASH(0x3f7e24)' => undef
        };

        [download]
        Which is not what you expected at all is it? Based on seeing that the actual call is 
        my ($result, $login_timeout) = LoginUser($query);

        [download]
        and that you never use the %query hash i suspect that when you said my (%query) = @_; you really wanted my ($query) = @_; That sets the localized scalar variable $query to the first argument of the call rather than trying to set the hash %query to the entire argument list. It also matches your call better and creates a localized $query variable to use in the LoginUser subroutine based on the arguments to the call rather than using the $query variable set somewhere else.

        as i noted warnings do not stop execution and i dont know what you mean by "derails code to determine if already logged in"

        as to why "the warn( in my cgi scripts do not print in the error log" i cannot answer, mine do, and a google search has produced no further answers either.

        as you see debugging by proxy can be a real pain, even more so for me when you only release code in little pieces, spread across many threads. I understand your frustration, do you understand mine?

        I understand debugging old code, both of mine and that from someone else. i stand by my previous statement "You need to step back and look at what is really going on, not what you think is going on."

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom