Foro - Perl en Español

#!/usr/bin/perl

require 'cookie.lib';
if (&GetCookies('usuario')){
    $usuario=$Cookies{'usuario'};
    print "Content-type: text/html\n\n";
}else{
        $usuario= int(rand(999999999999999));
        print "Content-type: text/html\n";
        &SetCookies('usuario',"$usuario",);
        print "\n";
}

##############################################################################
# HTTP Cookie Library           Version 2.1                                  #
# Copyright 1996 Matt Wright    [email protected]                      #
# Created 07/14/96              Last Modified 12/23/96                       #
# Script Archive at:            http://www.worldwidemart.com/scripts/        #
#                               Extensive Documentation found in README file.#
##############################################################################
# COPYRIGHT NOTICE                                                           #
# Copyright 1996 Matthew M. Wright.  All Rights Reserved.                    #
#                                                                            #
# HTTP Cookie Library may be used and modified free of charge by anyone so   #
# long as this copyright notice and the comments above remain intact.  By    #
# using this code you agree to indemnify Matthew M. Wright from any          #
# liability that might arise from it's use.                                  #
#                                                                            #
# Selling the code for this program without prior written consent is         #
# expressly forbidden.  In other words, please ask first before you try and  #
# make money off of my program.                                              #
#                                                                            #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium.  In all cases copyright and header must remain intact.#
##############################################################################
# Define variables for this library.                                         #

    # This is an optional variable.  If not defined, the cookie will expire  #
    # when a user's session ends.                                            #
    # Should be defined as: Wdy, DD-Mon-YYYY HH:MM:SS GMT                    #

$Cookie_Exp_Date = '';

    # By default this will be set to the same path as the document being     #
    # described by the header which contains the cookie.                     #

$Cookie_Path = '';

    # By default this will be set to the domain host name of the server      #
    # which generated the cookie response.                                   #

$Cookie_Domain = '';

    # This should be set to 0 if the cookie is safe to send across over      #
    # unsecured channels.  If set to 1 the cookie will only be transferred   #
    # if the communications channel with the host is a secure one. Currently #
    # this means that secure cookies will only be sent to HTTPS (HTTP over   #
    # SSL) servers.  According to Netscape docs at least.                    #

$Secure_Cookie = '0';

    # These are the characters which the HTTP Cookie Library will translate  #
    # to url encoded (hex characters) when it sets individual or compressed  #
    # cookies.  The array holds the order in which these should be           #
    # translated (as we wouldn't want to translate spaces into pluses and    #
    # then pluses into the URL encoded form, but rather the other way        #
    # around) and the associative array holds the values to translate        #
    # characters into.  The decoded set will reverse the process.  Feel free #
    # to add any other characters here, but it shouldn't be necessary.       #
    # This is a correction in version 2.1 which makes this library adhere    #
    # more to the Netscape specifications.                                   #

@Cookie_Encode_Chars = ('\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s');

%Cookie_Encode_Chars = ('\%',   '%25',
                        '\+',   '%2B',
                        '\;',   '%3B',
                        '\,',   '%2C',
                        '\=',   '%3D',
                        '\&',   '%26',
                        '\:\:', '%3A%3A',
                        '\s',   '+');

@Cookie_Decode_Chars = ('\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25');

%Cookie_Decode_Chars = ('\+',       ' ',
                        '\%3A\%3A', '::',
                        '\%26',     '&',
                        '\%3D',     '=',
                        '\%2C',     ',',
                        '\%3B',     ';',
                        '\%2B',     '+',
                        '\%25',     '%');
# Done                                                                       #
##############################################################################

##############################################################################
# Subroutine:    &GetCookies()                                               #
# Description:   This subroutine can be called with or without arguments. If #
#                arguments are specified, only cookies with names matching   #
#                those specified will be set in %Cookies.  Otherwise, all    #
#                cookies sent to this script will be set in %Cookies.        #
# Usage:         &GetCookies([cookie_names])                                 #
# Variables:     cookie_names - These are optional (depicted with []) and    #
#                               specify the names of cookies you wish to set.#
#                               Can also be called with an array of names.   #
#                               Ex. 'name1','name2'                          #
# Returns:       1 - If successful and at least one cookie is retrieved.     #
#                0 - If no cookies are retrieved.                            #
##############################################################################

sub GetCookies {

    # Localize the variables and read in the cookies they wish to have       #
    # returned.                                                              #

    local(@ReturnCookies) = @_;
    local($cookie_flag) = 0;
    local($cookie,$value);

    # If the HTTP_COOKIE environment variable has been set by the call to    #
    # this script, meaning the browser sent some cookies to us, continue.    #

    if ($ENV{'HTTP_COOKIE'}) {

        # If specific cookies have have been requested, meaning the          #
        # @ReturnCookies array is not empty, proceed.                        #

        if ($ReturnCookies[0] ne '') {

            # For each cookie sent to us:                                    #

            foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {

                # Split the cookie name and value pairs, separated by '='.   #

                ($cookie,$value) = split(/=/);

                # Decode any URL encoding which was done when the compressed #
                # cookie was set.                                            #

                foreach $char (@Cookie_Decode_Chars) {
                    $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
                    $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
                }

                # For each cookie to be returned in the @ReturnCookies array:#

                foreach $ReturnCookie (@ReturnCookies) {

                    # If the $ReturnCookie is equal to the current cookie we #
                    # are analyzing, set the cookie name in the %Cookies     #
                    # associative array equal to the cookie value and set    #
                    # the cookie flag to a true value.                       #

                    if ($ReturnCookie eq $cookie) {
                        $Cookies{$cookie} = $value;
                        $cookie_flag = "1";
                    }
                }
            }

        }

        # Otherwise, if no specific cookies have been requested, obtain all  #
        # cookied and place them in the %Cookies associative array.          #

        else {

            # For each cookie that was sent to us by the browser, split the  #
            # cookie name and value pairs and set the cookie name key in the #
            # associative array %Cookies equal to the value of that cookie.  #
            # Also set the coxokie flag to 1, since we set some cookies.      #

            foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
                ($cookie,$value) = split(/=/);

                # Decode any URL encoding which was done when the compressed #
                # cookie was set.                                            #

                foreach $char (@Cookie_Decode_Chars) {
                    $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
                    $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
                }

                $Cookies{$cookie} = $value;
            }
            $cookie_flag = 1;
        }
    }

    # Return the value of the $cookie_flag, true or false, to indicate       #
    # whether we succeded in reading in a cookie value or not.               #

    return $cookie_flag;
}

##############################################################################
# Subroutine:    &SetCookieExpDate()                                         #
# Description:   Sets the expiration date for the cookie.                    #
# Usage:         &SetCookieExpDate('date')                                   #
# Variables:     date - The date you wish for the cookie to expire, in the   #
#                       format: Wdy, DD-Mon-YYYY HH:MM:SS GMT                #
#                       Ex. 'Wed, 09-Nov-1999 00:00:00 GMT'                  #
# Returns:       1 - If successful and date passes regular expression check  #
#                    for format errors and the new ExpDate is set.           #
#                0 - If new ExpDate was not set.  Check format of date.      #
##############################################################################

sub SetCookieExpDate {

    # If the date string is formatted as: Wdy, DD-Mon-YYYY HH:MM:SS GMT, set #
    # the $Cookie_Exp_Date to the new value and return 1 to signal success.  #
    # Otherwise, return 0, as the date was not successfully changed.         #
    # The date can also be set null value by calling: SetCookieExpDate('').  #

    if ($_[0] =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/ ||
        $_[0] eq '') {
        $Cookie_Exp_Date = $_[0];
        return 1;
    }
    else {
        return 0;
    }
}

##############################################################################
# Subroutine:    &SetCookiePath()                                            #
# Description:   Sets the path for the cookie to be sent to.                 #
# Usage:         &SetCookiePath('path')                                      #
# Variables:     path - The path to which this cookie should be sent.        #
#                       Ex. '/' or '/path/to/file'                           #
# Returns:       Nothing.                                                    #
##############################################################################

sub SetCookiePath {

    # Set the new Cookie Path, assuming it is correct.  No error checking is #
    # done.                                                                  #

    $Cookie_Path = $_[0];
}

##############################################################################
# Subroutine:    &SetCookieDomain()                                          #
# Description:   Sets the domain for the cookie to be sent to.  You can only #
#                specify a domain within the current domain.  Must have 2 or #
#                3 periods, depending on type of domain. e.g., .domain.com   #
#                or .k12.co.us.                                              #
# Usage:         &SetCookieDomain('domain')                                  #
# Variables:     domain - The domain to set the cookie for.                  #
#                         Ex. '.host.com'                                    #
# Returns:       1 - If successful and value of $Cookie_Domain was set.      #
#                0 - If unsuccessful and value was not changed.              #
##############################################################################

sub SetCookieDomain {

    # Following Netscape specifications, if the domain specified is one of 7 #
    # top level domains, only require it to contain two periods, and if it   #
    # is not, require that there be three.  If the new domain passes error   #
    # checking, set the new domain and return a true value.  Otherwise,      #
    # return 0.  Trying to set a domain other than the current one is futile,#
    # since the browser won't allow it.  But if people may be accessing the  #
    # page from www.host.xxx or host.xxx, you may wish to set it to .host.xxx#
    # so that either host the access will have access to the cookie.         #

    if ($_[0] =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
        $_[0] =~ /\..+\.\w{3}$/) {
        $Cookie_Domain = $_[0];
        return 1;
    }
    elsif ($_[0] !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
           $_[0] =~ /\..+\..+\..+/) {
        $Cookie_Domain = $_[0];
        return 1;
    }
    else {
        return 0;
    }
}

##############################################################################
# Subroutine:    &SetSecureCookie()                                          #
# Description:   This subroutine will set the cookie to be either secure,    #
#                meaning the cookie will only be passed over a secure HTTP   #
#                channel, or unsecure, meaning it is safe to pass unsecured. #
# Usage:         &SetSecureCookie('flag')                                    #
# Variables:     flag - 0 or 1 depending whether you want it secure or not   #
#                       secure.  By default, it is set to unsecure, unless   #
#                       $Secure_Cookie was changed at the top.               #
#                       Ex. 1                                                #
# Returns:       1 - If successful and value of $Secure_Cookie was set.      #
#                0 - If unsuccessful and value was not changed.              #
##############################################################################

sub SetSecureCookie {

    # If the value passed to this script is a 1 or 0, set $Secure_Cookie     #
    # accordingly and return a true value.  Otherwise, return a false value. #

    if ($_[0] =~ /^[01]$/) {
        $Secure_Cookie = $_[0];
        return 1;
    }
    else {
        return 0;
    }
}

##############################################################################
# Subroutine:    &SetCookies()                                               #
# Description:   Sets one or more cookies by printing out the Set-Cookie     #
#                HTTP header to the browser, based on cookie information     #
#                passed to subroutine.                                       #
# Usage:         &SetCookies(name1,value1,...namen,valuen)                   #
# Variables:     name  - Name of the cookie to be set.                       #
#                        Ex. 'count'                                         #
#                value - Value of the cookie to be set.                      #
#                        Ex. '3'                                             #
#                n     - This is tacked on to the last of the name and value #
#                        pairs in the usage instructions just to show you    #
#                        you can have as many name/value pairs as you wish.  #
#               ** You can specify as many name/value pairs as you wish, and #
#                  &SetCookies will set them all.  Just string them out, one #
#                  after the other.  You must also have already printed out  #
#                  the Content-type header, with only one new line following #
#                  it so that the header has not been ended.  Then after the #
#                  &SetCookies call, you can print the final new line.       #
# Returns:       Nothing.                                                    #
##############################################################################

sub SetCookies {

    # Localize variables and read in cookies to be set.                      #

    local(@cookies) = @_;
    local($cookie,$value,$char);

    # While there is a cookie and a value to be set in @cookies, that hasn't #
    # yet been set, proceed with the loop.                                   #

    while( ($cookie,$value) = @cookies ) {

        # We must translate characters which are not allowed in cookies.     #

        foreach $char (@Cookie_Encode_Chars) {
            $cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
            $value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
        }

        # Begin the printing of the Set-Cookie header with the cookie name   #
        # and value, followed by semi-colon.                                 #

        print 'Set-Cookie: ' . $cookie . '=' . $value . ';';

        # If there is an Expiration Date set, add it to the header.          #

        if ($Cookie_Exp_Date) {
            print ' expires=' . $Cookie_Exp_Date . ';';
        }

        # If there is a path set, add it to the header.                      #

        if ($Cookie_Path) {
            print ' path=' . $Cookie_Path . ';';
        }

        # If a domain has been set, add it to the header.                    #

        if ($Cookie_Domain) {
            print ' domain=' . $Cookie_Domain . ';';
        }

        # If this cookie should be sent only over secure channels, add that  #
        # to the header.                                                     #

        if ($Secure_Cookie) {
            print ' secure';
        }

        # End this line of the header, setting the cookie.                   #

        print "\n";

        # Remove the first two values of the @cookies array since we just    #
        # used them.                                                         #

        shift(@cookies); shift(@cookies);
    }
}

##############################################################################
# Subroutine:    &SetCompressedCookies                                       #
# Description:   This routine

print "Content-type: text/html\n";
        &SetCookies('usuario',"$usuario",);
        print "\n";

print "Content-type: text/html \n\n";