in reply to Re^2: Sessions Questions
in thread Sessions Questions

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

Replies are listed 'Best First'.
Re^4: Sessions Questions
by tultalk (Monk) on Mar 02, 2017 at 13:58 UTC

    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]
Re^4: Sessions Questions
by tultalk (Monk) on Mar 05, 2017 at 02:19 UTC
    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]

        Thanks for timely response. "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 totally understand your frustration. Repeated warning say not to post lots of code. So the snippets.

        Last first:

        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.

        I searched everywhere also and found nothing that matched my problem. At a loss.

        On the first part, I had already tried my ($query) = @_;

        and got

        Sun Mar 5 07:51:35 2017 -: Global symbol "%query" requires explicit package name at - line 225, <DATA> line 998. Sun Mar 5 07:51:35 2017 -: BEGIN not safe after errors--compilation aborted at - line 646, <DATA> line 998.

        Shows in syntax check in Padre. This I totally don't understand as the syntax check is still finding "global symbol "%query" somewhere.

        I shut Padre down. Reopened and still there. Again did search on %query and nothing.

        Ran a debug and still there:

        Status: 500 Content-type: text/html

        Software error:

        Global symbol "%query" requires explicit package name at manageus
ers.pm line 226, <DATA> line 998.
BEGIN not safe after errors--compilation aborted at manageusers.pm line 647, <
;DATA> line 998.


This error does not show up in komodo syntax check.

[reply]

In Section Seekers of Perl Wisdom