Sample Cookie code

#!c:/perl/bin/perl 
# CHANGE above line to match your perl location
# Save as fryme.pl or change HTML form action to suit

use strict;
use CGI qw/:standard/;

    $CGI::POST_MAX=1024 * 1;    # max 1024 bytes posts
    $CGI::DISABLE_UPLOADS = 1;  # no uploads , replace smiley with  D 

# Cookie Variables -- Change to suit your site
my $domain =".Yoursite.com"; # note two dots required 
# Note: +1D or 1 day would not write a visible cookie on my machine so :
my $expiry ="+1M";  # expires one month forward
	
my $q = new CGI; 

# Form Variables lower cased
my $username =lc(param("T1"));
my $password =lc(param("T2"));
my $add      =lc(param("add"));

# end this farce if fields are blank
if (($username eq "") or ($password eq "")) { 
     
	 print $q ->header();
	 # Generic stuff to print  
     print "$ENV{'CONTENT_LENGTH'}  <br>\n";
     print "$CGI::POST_MAX  <br>\n";
     print "User = $username<br> \n";
     print "Pass = $password<br>  \n";
     print "Add = $add<br>  \n"  if ($add ne "");
     print "<hr align=\"left\" size=\"3\" color=\"red\" width=\"20%\"></br>\n";
	 print "Error : Username / Password cannot be blank <br>\n";
	 exit;
	 }

#=============================================================================
#     Here is the start and End 

# Get the previous cookie if any 
my $Kookie_contents = $q -> cookie("valid");

      &Check_Me;
	  
#=============================================================================	  
#================Subroutines below ===========================================
#=============================================================================
sub Check_Me {

my @r ="";        # stands for rubbish fields in this test
my $K_username;   # username from Cookie
my $K_password;   # password from Cookie
my $usercheck =0; # Match on text database
my $sep ="::";    # Text database field separator

if ( $Kookie_contents) { ($K_username,$K_password,$r[2],$r[3],$r[4]) = split(/ /,$Kookie_contents); }

if($add eq "") { 
open(db,"<db.txt") or die print "Text database failed with $!";
  while(<db>) { 
  	 chomp $_;
	my ($Text_username,$Text_password) = split(/::/);
# if cookie exists -- Form & Kookie & Text must match to pass check
# Note :fails check if you have a cookie and wish to log in as another person
# must consider changing this in real life situation 
if    ( $Kookie_contents) { if (($K_username eq $Text_username )   and
                      ($K_password eq $Text_password)    and 
					  ($K_username eq $username) and
					  ($K_password eq $password)) { $usercheck++;  } }
# if no cookie set					  
elsif (!$Kookie_contents) { if ((  $username eq $Text_username ) and (  $password eq $Text_password)) { $usercheck++;  }} 
    } # end of while loop
   close db;
   
if ($usercheck == 0) {  print $q ->header(); }
if ($usercheck  > 0) { &burn_cookie; }

print "Content Length : $ENV{'CONTENT_LENGTH'}  <br>\n";
print "CGI Max Post   : $CGI::POST_MAX  <br>\n";
print "User = $username<br> \n";
print "Pass = $password<br>  \n";
print "Add = $add<br>  \n"  if ($add ne "");
print "<hr align=\"left\" size=\"3\" color=\"red\" width=\"20%\"></br>\n";
	  
  if ($usercheck > 0) {  print " Yes you are Logged in from the text database !\n"; }
else { print " Not Logged as : username/password wrong against Text database,  please Try again\n"; }
 
 }# end of add ne "on"
 
#=============================================================================
# Adding to text database should be "Admin only" , but not for this test script 
if($add eq "on") {

   open(db,"<db.txt") or die print "Text database failed with $!";
        while(<db>) { 
  	         chomp $_;
	         my  ($Text_username,$Text_password) = split(/::/); 
             if (($username eq $Text_username ) and ($password eq $Text_password)) { $usercheck++;  }
	     } # end of while loop
    close db;
   
    if ($usercheck == 0) {
        open(db,">>db.txt") or die print "Text database failed with $!";
		    # Username::Password format
            print db "$username$sep$password\n";
         close db;
        }


if ($usercheck  > 0) {  print $q ->header(); }
if ($usercheck == 0) { &burn_cookie; }
        # Generic stuff to print  
        print "$ENV{'CONTENT_LENGTH'}  <br>\n";
        print "$CGI::POST_MAX  <br>\n";
        print "User = $username<br> \n";
        print "Pass = $password<br>  \n";
        print "Add = $add<br>  \n"  if ($add ne "");
        print "<hr align=\"left\" size=\"3\" color=\"red\" width=\"20%\"></br>\n";

    if ($usercheck  > 0) { 
	    print " Username Password already exists in text database, Please pick another\n"; }
    if ($usercheck == 0) {
	    print " Added to text database && you are logged in !\n"; }
		
       }# end of add eq "on"
	   
} # end of sub Check_Me

#=============================================================================
sub burn_cookie { # Set cookie for next time

# Variables to pass to cookie 
my @session  = ( "$username",
                 "$password",
                 "123rubbish",
                 "345rubbish",
				 "567rubbish"
				  );
my $Kookie = $q->cookie(-name=>"valid", 
		     -value   =>  "@session",
             -expires =>  "$expiry",
    		 -domain  =>  "$domain"
     		 );

print $q->header(-cookie=>$Kookie); 


} # end sub burn_cookie

# TODO : Filelock on real text database to prevent corruption when
# 2 opens occur at the same time. 
 
#=============================================================================
#  Html Page for use in above sample cookie test script

#<html>
#<head>
#<title>Login</title>
#</head>
#<body bgcolor="#FFFFFF">
#<form action="/cgi-bin/fryme.pl" method="POST" name="guilty">
#    <p>Login</p>
#    <p>Username <input type="text" size="20" name="T1"></p>
#    <p>Password <input type="text" size="20" name="T2"></p>
#    <p>Add      <input type="checkbox" size="20" name="add"></p>
#    <p><input type="submit" name="B1" value="Submit"></p>
#</form>
#</body>
#</html>
#=============================================================================