Moviendo el CGI de un servidor a otro

[moNTeZIon]

Código:

#!/usr/bin/perl

use CGI;

# ----------------------------- define variables -----------------------------

# @restrictTo is an array containing refering addresses to which you
# wish to grant access to your script.  If it contains a single value of
# 'all' then any refering address can access your script.

# uncomment the next line to grant access to only restricted addresses
#@restrictTo = ('envatech.net');

# comment the next line if you restrict access.
@restrictTo = ('all');

# $toEmail is the default email you wish this script to send all
# emails to.  uncomment the line below to do this.
$toEmail = 'info\@envatech.net';

# $sendMailProg is the location of the mail send program on your server.
# the default setting will work for most Unix servers.

$sendMailProg = '/var/qmail/bin/sendmail';

# ------------------------ end define variables ----------------------------------

# -------------------------- call subroutines ------------------------------------

# step 1: validate the refering address
&validateReferer;

#step 2: get data from form post
&getData;

#step 3: check the output request type
&checkOutputRequest;

#step 4: check required fields
&checkRequired;

#step 5: send email
&sendEmail;

# ----------------------- end call subroutines -----------------------------------

# --------------------------- subroutines ----------------------------------------

sub validateReferer
{
    local $isValid = 0;

    # checks to make sure that the HTTP_REFERER has been passed
    if ($ENV{'HTTP_REFERER'}) 
    {
        # compares each address in the @restrictTo array to the refering address
        # if it finds a match, it flags $isValid to true and breaks out of the 
        # foreach loop
        foreach $address (@restrictTo)
        {
            if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$address|i || $address eq 'all') 
            {
                $isValid = 1;
                last;
            }
        }
    }
    # if HTTP_REFERER has not been passed, it checks to see if the value of the first 
    # element of the restrictTo array is 'all', in which case all refering addresses
    # are granted access, so the $isValid is flagged true.
    elsif ($restrictTo[0] eq 'all')
    {
        $isValid = 1;
    }
    
    # if the refering address is not a valid on, output an error message.
    if ($isValid != 1)
    {
        &output('invalidAddress');
    }
}

sub getData
{
    if ($ENV{'REQUEST_METHOD'} eq 'GET') 
    {
        # split the query_string into an array that holds the name/value pairs.
        @variables = split(/&/, $ENV{'QUERY_STRING'});
    }
    elsif ($ENV{'REQUEST_METHOD'} eq 'POST') 
    {
        read(STDIN, $fromPost, $ENV{'CONTENT_LENGTH'});
        
        # split the previously assigned value of $fromPost into an array that
        # holds the name/value pairs. 
        @variables = split(/&/, $fromPost);
    }
    
    # if no request method has been passed (no form information) then output
    # an error message.
    else 
    {
        &error('noRequestMethod');
    }

    # break each name/value pair apart, convert them from the URLenceded format,
    # and place them into an associative array.
    $k = 0;
    foreach $variable (@variables) 
    {

        local($varName, $varValue) = split(/=/, $variable);
 
        $varName =~ tr/+/ /;
        $varName =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        $varValue =~ tr/+/ /;
        $varValue =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        $varValue =~ s/<!--(.|\n)*-->//g;

        $FIELDS{$varName} = $varValue;

        $order[$k] = $varName;
 $k = $k + 1;
    }
    
}

sub checkOutputRequest
{
    $outputEnvVars = 0;
    if (defined($FIELDS{'envVars'}))
    {
        if ($FIELDS{'envVars'} eq 'yes')
        {
            $outputEnvVars = 1;
        }
        if ($FIELDS{'envVars'} eq  'only')
        {
            &output('envVars');
        }
    }
}

sub checkRequired
{
    # checks to see if a formfield called 'required' has been passed
    # if not, define @required to be empty.  otherwise, define @required
    # to be the elements from the comma-delimited list passed from the form.
    if (!defined($FIELDS{'required'}))
    {
        @required = ();
    }
    else
    {
        @required = split(/,/,$FIELDS{'required'}); 
    }

    # in order to send an email it is necessary to have an address to
    # which to send.  if no value was passed and a default has not been
    # specified within the script, then add to the array of missing
    # values.
    if (!defined($FIELDS{'to'}))
    {
        if (!defined($toEmail))
        {
            push(@missing, 'to');
        }
    }
    # if an email address has been passed frmo the form, then make sure that it
    # is a valid format for an email address.  otherwise, output an error message.
    elsif ($FIELDS{'to'} =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $FIELDS{'to'} !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)
    {
        &output('badEmail');
    }

    # check to make sure each required formfield has been passed.
    foreach $require (@required)
    {
        if (!defined($FIELDS{$require}))
        {
            push(@missing, $require);
        }
    }
  
    # if any missing formfields were detected, output the error message.
    if (defined(@missing))
    {
        &output('missingRequired');
    }
}

sub sendEmail
{

    # begin sending the mail.
    open(MAILPROG, "|$sendMailProg -t");
    if (defined($FIELDS{'to'}))
    { 
        print MAILPROG "To: $FIELDS{'to'}\n";
    }
    elsif (defined($toEmail))
    {
        print MAILPROG "To: $toEmail\n";
    }
    else
    {
        &output('badEmail');
    }

    if (defined($FIELDS{'from'}))
    {
        print MAILPROG "From: $FIELDS{'from'}\n";
    }
    else
    {
        print MAILPROG "From: <unknown>\n";
    }

    if (defined($FIELDS{'subject'}))
    {
        print MAILPROG "Subject: $FIELDS{'subject'}\n\n";
    }
    else
    {
        print MAILPROG "Subject: <none>\n\n";
    }

    # print each variable name and value to the body of the email.
    foreach $index (@order)
    #foreach $member (keys %FIELDS)
    {
        if ($index ne 'to' && $index ne 'from' && $index ne 'subject')
    #    if ($member ne 'to' && $member ne 'from' && $member ne 'subject')
        {
            print MAILPROG "$index:\n\n$FIELDS{$index}\n\n";
    #        print MAILPROG "$member:\n\n$FIELDS{$member}\n\n";
        }
    }
    
    # sends email. 
    print MAILPROG ".";

    close (MAILPROG);



    # output the success of the send to the user.
    &output('sentEmail');

}
 

sub output
{
    # create a local variable to hold the value of the paramaters
    # passed to the subroutine.
    local ($outputType) = @_;

    if ($outputType eq 'invalidAddress')
    {
        print "Content-type: text/plain\n\n";
        print "success=0&error=invalidAddress";
        exit;
    }

    elsif ($outputType eq 'noRequestMethod')
    {
        print "Content-type: text/plain\n\n";
        print "success=0&error=noRequestMethod";
        exit;
    }

    elsif ($outputType eq 'missingRequired')
    {
        # create local variable to hold length of array for 
        # missing formfields.
        local $howManyMissing = scalar(@missing);
        print "Content-type: text/plain\n\n";
        print "success=0&error=missingRequired&missing=";
        
        # print a comma-delimited list of the missing formfields.
        for ($i=0; $i< $howManyMissing-1; $i++) 
        {
                print "$missing[$i],";
        }
        print "$missing[$howManyMissing-1]";
        exit;
    }

    elsif ($outputType eq 'badEmail')
    {
        print "Content-type: text/plain\n\n";
        print "success=0&error=badEmail";
        exit;
    }

    elsif ($outputType eq 'envVars')
    {
        print "Content-type: text/plain\n\n";
        print &envVars;
        print "&timeDate=";
        print &makeDate;
        exit;
    }

    elsif ($outputType eq 'sentEmail')
    {
        print "Content-type: text/plain\n\n";
        print "success=1&timeDate=";
        print &makeDate;
        exit;
    }
}

sub makeDate {

    @days   = ('Sunday','Monday','Tuesday','Wednesday',
               'Thursday','Friday','Saturday');
    @months = ('January','February','March','April','May','June','July',
          'August','September','October','November','December');

    ($sec,$min,$hour,$dayOfMonth,$month,$year,$dayOfWeek) = (localtime(time))[0,1,2,3,4,5,6];
    $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
    $year += 1900;

    $date = "$days[$dayOfWeek] $dayOfMonth $months[$month] $year $time";
    $date = CGI::escape($date);

    return $date;
}


sub envVars
{
    local $remoteHost = $ENV{'REMOTE_HOST'};
    local $httpReferer = $ENV{'HTTP_REFERER'};
    local $httpUserAgent = $ENV{'HTTP_USER_AGENT'};

    $remoteHost = CGI::escape($remoteHost);
    $httpReferer = CGI::escape($httpReferer);
    $httpUserAgent = CGI::escape($httpUserAgent);

    $envVars = "REMOTE_HOST=$remoteHost&HTTP_REFERER=$httpReferer&HTTP_USER_AGENT=$httpUserAgent";
    return $envVars;
}
# ----------------------------- end subroutines ------------------------------------