Ir para conteúdo
Fórum CódigoFonte.net
pedrobernou

HTTP Error 502.2 - Bad Gateway ao usar o soupermail

Recommended Posts

Boa noite, estou tentando implementar o soupermail (script escrito em perl) para enviar um formulário de contato de um site. Fiz a instalação como é sugerido pelo manual do autor, e rodei o script souperinstall.pl que acompanha o soupermail para instalação e configuração. Até aqui não deu erro nenhum, fiz as alterações no arquivo soupermail.pl alterando os valores das seguintes strings, como sugerido pelo próprio souperinstall.pl:

$soupermailAdmin = '[email protected]';

$serverRoot = 'E:/home/meudominio/Web';

$privateRoot = "e:/home/meudominio/Dados";

$mailhost = 'smtp.meudominio.com.br';

$tempDir = 'c:/temp/';

$forkable = 0;

$fhBug = 0;

No action de meu form coloquei action="/cgi-bin/soupermail.pl";

Ainda na código da página onde está o formulário coloquei:

<input type="hidden" name="SoupermailConf" value="contato.txt">

indicando o arquivo que possui as configurações para o soupermail, o tanto o arquivo onde está o formulário quanto o arquivo contato.txt foram salvos na mesma pasta do domínio.

O arquivo contato.txt contém o seguinte:

nomailfooter: yes

alphasort: no

mailtamplate:email.txt

mailto: [email protected]

subject: Contato pelo site

success: www.meudominio.com.br/sucesso.html

O arquivo onde está o formulário tem o seguinte código:

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html>

<head>

<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

<title>Untitled Document</title>

<link href="css/teste3.css" rel="stylesheet" type="text/css" />

<script language="JavaScript">

<!--

self.name = "contato";

//-->

</script>

</head>

<body>

<div id="cabecalhoesquerda"></div><div id="cabecalho"></div>

<div id="clear"></div>

<div id="esquerda"></div>

<form method="post" enctype="multpart/formdata" name="form1" action="/cgi-bin/soupermail.pl">

<input type="hidden" name="SoupermailConf" value="contato.txt">

<div id="tudo">

<div id="um">

<label><strong>Nome:</strong>

<input type="text" name="camponome" id="camponome">

</label><br />

<label><strong>E-mail:</strong>

<input type="text" name="Email" id="campoemail" >

</label><br />

<label><strong>Anexos:</strong>

<input type="file" name="anexo" id="campoanexo" ><br />

</label>

</div>

<div id="dois">

<input type="submit" value="" id="submit" />

</div>

<div id="tres">

<label><strong>Mensagem:</strong><br />

<textarea name="campomensagem" id="mensagem" cols="45" rows="7"></textarea>

</label>

</div>

<div class="clear"></div>

</div>

</form>

<div id="peesquerda"></div><div id="pe"></div>

</body>

</html>

O arquivo soupermail.pl está na pasta cgi-bin, que tem permissão de somente leitura (já alterei a permissão da pasta para leitura e escrita e não adiantou). Fiz o upload do script soupermail.pl como modo ASCII. O código do soupermail.pl é o seguinte:

#!/usr/local/bin/perl --

# -*-mode: Perl; tab-width: 4 -*-

my $relVersion = "1.0.8";

############################################################################

# Soupermail

#

# Internal build version:

# $Id: soupermail.pl,v 1.136 2001/02/07 22:04:55 aithalv Exp $

#

# Soupermail. A whacky and powerful WWW to Email form handler.

# Copyright © 1998, 1999, 2000, 2001

# Vittal Aithal <[email protected]>

#

# This program is free software; you can redistribute it and/or modify it

# under the terms of the GNU General Public License as published by the

# Free Software Foundation; either version 2 of the License, or (at your

# option) any later version.

#

# This program is distributed in the hope that it will be useful, but

# WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See

# the GNU General Public License for more details. You should have received

# a copy of the GNU General Public License along with this program; if not,

# write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,

# MA 02139, USA.

#

############################################################################

############################################################################

# Set up the modules soupermail uses - these should all be perl5 standard

############################################################################

use warnings;

use diagnostics;

use lib qw(.);

use CGI '-debug';

use FileHandle;

use File::Copy;

use Fcntl qw(:DEFAULT :flock);

use Time::Local;

use POSIX qw(floor);

use lib "/cgi-bin/MIME";

use lib "E:/home/meudominio/Web/cgi-bin";

use lib "C:/Perl/lib/io";

use MIME::Lite;

use strict;

use 5.004;

# Not all systems will have DBI, so eval to trap.

eval('use DBI;');

my $hasDbi = ([email protected] ? 0 : 1);

BEGIN {

if ($^O =~ /MSWin/i) {

require Win32::File;

import Win32::File;

}

}

############################################################################

my ($soupermailAdmin, $serverRoot, $mailprog, $mailhost, $pgpencrypt,

$tempDir, $debug, $lout, $loutOpts, $pgpSet, $privateRoot, $forkable,

$fhBug, $uploadTimeout, $ps2pdf, $fileLocking, $smtpPoolSize, $paranoid) = "";

############################################################################

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# This is who to mail when soupermail goes wrong

# PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE

# PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE

# PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE

# CHANGE THIS!!!

# I REALLY DON'T WANT TO GET ADMIN EMAILS ABOUT YOUR SITE!!!!

############################################################################

$soupermailAdmin = '[email protected]';

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# This is where the webserver's document tree starts

# Do NOT include a trailing '/' character

#

# Some examples:

# $serverRoot = 'c:/inetpub/wwwroot'; # Default NT/IIS setup

# $serverRoot = $ENV{'DOCUMENT_ROOT'}; # May work on some webservers

# $serverRoot = '/home/www/html'; # A typical UNIX setting

############################################################################

$serverRoot = 'E:/home/meudominio/Web';

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# If you want to hide your config files from people browsing your site,

# provide a path OUTSIDE your server root here.

#

# Some examples:

# $privateRoot = "c:/inetpub/private";

############################################################################

$privateRoot = "e:/home/meudominio/Dados";

############################################################################

# Program locations. These will vary from site to site, so check that

# they're there and setup as appropriate

############################################################################

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# To send outgoing mail, soupermail needs an SMTP mailserver to talk to.

# If you don't know the address of a suitable mailserver, ask your ISP

# or a system administrator. If you don't have a mailserver handy, you

# can use sendmail.

# If you indend to use the maillist features, I suggest you use a mailhost

# since it is probably faster.

#

# Some examples:

# $mailhost = 'localhost'; # Local SMTP server for NT

# $mailprog = ''; # No mail program for NT

#

# $mailhost = ''; # No SMTP host for UNIX

# $mailprog = '/usr/lib/sendmail'; # Local sendmail for UNIX

############################################################################

$mailhost = 'smtp.meudominio.com.br';

$mailprog = '';

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# The program to do pgp encryption. This was tested with PGP 5.0i

# and GNU Privacy Guard 1.0.4 on my home Linux box, your milage

# may vary with others.

# Set up the versions of GPG and/or pgp you have on your server

# here.

############################################################################

$pgpSet = {

'gpg' => '/usr/local/bin/gpg',

'pgp2' => '/usr/local/bin/pgp2.6.3',

'pgp5' => '/usr/local/bin/pgpe',

};

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# These are the programs needed to generate PDFs

# $ps2pdf is the location of the ps2pdf command

# $lout is the location of the lout executable

# Safe to comment out if they're not used

#

# Some examples:

# Ghostscript and lout settings for NT

# $ps2pdf = 'c:/gstools/gs5.50/ps2pdf.bat';

# $lout = 'c:/lout/3.17/lout.exe';

############################################################################

# Ghostscript and lout settings for UNIX

$ps2pdf = '/usr/bin/ps2pdf';

$lout = '/usr/local/bin/lout';

############################################################################

# ---CHANGE ME FOR YOUR SITE---

# Where to write out temporary files. If you're using PGP, or making

# PDFs, several files will be generated in a sudirectory off here.

# Include a trailing '/' character.

#

# Some examples:

# $tempDir = 'c:/temp/'; # Default temp area on NT

############################################################################

$tempDir = 'c:/temp/';

############################################################################

# Uncomment this to see what soupermail's doing.

# On a production server make sure its commented out.

############################################################################

$debug = "";

#$debug = "${tempDir}soupermaillog";

############################################################################

# If your machine doesn't have fork() support, try setting this to 0

############################################################################

$forkable = 0;

############################################################################

# If you have trouble uploading files, try setting this to 1

# FreeBSD users may well need to do this

############################################################################

$fhBug = 0;

############################################################################

# If you are uploading large files, and soupermail's timing out, then

# increase this value. The units are seconds

############################################################################

$uploadTimeout = 240;

############################################################################

# This stuff is for PDF generation

############################################################################

$loutOpts = " -S";

############################################################################

# $maxbytes is the maximum number of bytes allowed to be uploaded.

# Its not very cleverly handled at the moment, but what can you do.

############################################################################

my ($maxbytes) = 1048576;

############################################################################

# $maxdownload is the maximum number of bytes allowed to be downloaded.

############################################################################

my ($maxdownload) = 10485760;

############################################################################

# To prevent problems when lots of people are submiting fileto forms at

# the same time, file locking can be used. However - NT may screw up.

############################################################################

$fileLocking = 1;

############################################################################

# If you are sending out a large mailing list to several hundred addresses

# and you find that mailing stops after a while, you may have to increase

# this value. Check your SMTP server's maximum messages per connection to

# get a feel for the value.

############################################################################

$smtpPoolSize = 20;

############################################################################

# Paranoid should be used where people other than yourself have access to

# your server. i.e. Other people can put content on some part of your

# server. At worst case the person would write their own config files,

# and read data from your server. Setting $paranoid to 1 prevents

# Soupermail from reading files from a directory, unless that directory

# contains a file called soupermail.allow

############################################################################

$paranoid = 1;

############################################################################

# Right, that in theory is the end of anything you have to configure in

# soupermail.pl - the rest's generic... well, maybe :)

#

# HOWEVER - remember you'll have to write config files for your forms -

# so now would be a good time to ==> READ THE MANUAL!! <==

# Just to repeat... READ THE MANUAL, READ THE MANUAL, READ THE MANUAL

# If things are going wrong, also READ THE FAQ AND THE HELP FORUM!!!!

#

# http://soupermail.sourceforge.net/manual.html

# http://soupermail.sourceforge.net/faq.html

# http://sourceforge.net/forum/forum.php?forum_id=342

#

# Very important that stuff, Soupermail's complex, and takes time to learn,

# please try to read about it BEFORE using it.

############################################################################

############################################################################

# Set up some global constants

############################################################################

############################################################################

# Useful month shortcuts

############################################################################

my (%MONTHS) =

('Jan','01','Feb','02','Mar','03','Apr','04','May','05','Jun','06',

'Jul','07','Aug','08','Sep','09','Oct','10','Nov','11','Dec','12');

############################################################################

# We may be generating cookies, and they'll live in @cookieList

# $cookieStr determines how many cookies we're allowing (9 by default)

############################################################################

my (@cookieList) = ();

my ($cookieStr) = 'cookie([123456789])';

############################################################################

# Other globals

############################################################################

my ($pageRoot, $config, %CONFIG, @required, @typeChecks, $configRoot,

$query, $child, @bindVals, %sqlVals, %sqlCount, @listSql, $base);

my $parent = $$;

my @ignored = ('SoupermailConf');

my $CRLF = "\015\012";

############################################################################

# Some default configuration values

############################################################################

my $today = time;

$CONFIG{'expirydate'} = $today;

$CONFIG{'subject'} = "Form Submission";

$CONFIG{'error'} = "";

$CONFIG{'successcookie'}= 1;

$CONFIG{'failurecookie'}= 0;

$CONFIG{'blankcookie'} = 0;

$CONFIG{'expirescookie'}= 0;

$CONFIG{'cgiwrappers'} = 0;

$CONFIG{'pgpuploads'} = 1;

$CONFIG{'pgppdfs'} = 1;

$CONFIG{'pgptextmode'} = 0;

$CONFIG{'counter'} = {};

$CONFIG{'charset'} = 'iso-8859-1';

$CONFIG{'encoding'} = '8BIT';

$CONFIG{'pgpmime'} = 1;

$CONFIG{'alphasort'} = 1;

$CONFIG{'encodesubjects'}= 0;

$CONFIG{'successmime'} = 'text/html';

$CONFIG{'failuremime'} = 'text/html';

$CONFIG{'blankmime'} = 'text/html';

$CONFIG{'expiresmime'} = 'text/html';

$CONFIG{'listprecedence'}= 'list';

$CONFIG{'defaultencryption'} = 'gpg';

$CONFIG{'charset'} = 'iso-8859-1';

$CONFIG{'sqluser'} = "";

$CONFIG{'sqlpassword'} = "";

$CONFIG{'sqlname'} = "";

$CONFIG{'listbase'} = "";

$CONFIG{'mailbase'} = "";

$CONFIG{'senderbase'} = "";

my %needToReplace = ();

### These are the config options that can use variable replacement

my $replaceable = "^(mailto|(sender)?replyto|senderfrom|${cookieStr}value|" .

'(sender)?subject|(sender)?bcc|ref|fileto|error|' .

'goto(success|blank|expires|failure))';

my $scratchPad = "";

my $OS;

my $attachCount = 1;

my $eToken = q([\w\-\.\!\#\$\%\^\&\*\{\}\'\|\+\`\~]);

### Taint things if we're not private

my $privateConfig = 0;

my $denyFile = "soupermail.deny";

my $allowFile = "soupermail.allow";

if ($^O =~ /MSWin/i) {

$OS = "windows";

} else {

$OS = "unix";

}

### Just in case people didn't read the instructions :)

$serverRoot =~ s/[\/\\]$//;

### Concatenate dir breaks into single ones.

$serverRoot =~ s/[\/\\]+/\//g;

### Speed things up by interpreting only what we need

my $fileFunctions =<<'END_OF_FILE_FUNCTIONS';

############################################################################

# Subroutine: hideFile ( filename )

# Make an OS specific call to hide a file from the webserver

# makes the file hidden under windows, chmoded under unix

############################################################################

sub hideFile {

($debug) && (print STDERR "hideFile (@_) \@ " . time . "\n");

my $filename = shift;

no strict 'subs';

if ($OS eq "windows") {

Win32::File::SetAttributes($filename, Win32::File::HIDDEN)

} else {

if ($CONFIG{"cgiwrappers"}) {

chmod 0600, $filename;

} else {

chmod 0266, $filename;

}

}

}

############################################################################

# Subroutine: saveResults ()

# Save the results to a file called $fileto

############################################################################

sub saveResults {

($debug) && (print STDERR "saveResults (@_) \@ " . time . "\n");

my $outstring = "";

my $outbuffer = "";

my ($value, $tmpfile);

if ($CONFIG{'filetemplate'}) {

grabFile($CONFIG{'filetemplate'}, \$outbuffer);

if ($CONFIG{'nofilecr'}) {

substOutput(\$outbuffer, '2');

} else {

substOutput(\$outbuffer, '0');

}

$outbuffer =~ s/\cM?\n$//;

} else {

my (@keylist) = sort($query->param());

my ($key);

foreach $key (@keylist) {

### Because we may be dealing with multiple values, need to

### join with a comma.

$value = join(',', $query->param($key));

$value =~ s/\cM?\n/ /g if ($CONFIG{'nofilecr'});

$outbuffer .= "$key = $value\n";

}

}

my ($header, $footer, $fileto) = "";

if ($CONFIG{'headings'}) {

grabFile($CONFIG{'headings'}, \$header);

}

if ($CONFIG{'footings'}) {

grabFile($CONFIG{'footings'}, \$footer);

}

showFile($CONFIG{'fileto'});

if (-f $CONFIG{'fileto'}) {

my @fileStats = stat($CONFIG{'fileto'});

### Is the file going to be bigger than the maximum?

if ($CONFIG{'filemaxbytes'} &&

($fileStats[7] + length($outbuffer)) > $CONFIG{'filemaxbytes'}) {

### Yes, it is too big, but first see if it needs copying.

if ($CONFIG{'filebackupformat'}) {

copy($CONFIG{'fileto'}, $CONFIG{'filebackupformat'});

hideFile($CONFIG{'filebackupformat'})

unless ($CONFIG{'filereadable'});

}

### Now delete it.

unlink $CONFIG{'fileto'};

} else {

grabFile($CONFIG{'fileto'}, \$fileto);

}

}

$fileto = $header . $footer unless ($fileto);

if ($CONFIG{'filepgpuserid'}) {

pgpMessage(\$outbuffer, $CONFIG{'filepgpuserid'});

}

open (FILETO, "> $CONFIG{fileto}") ||

fatal("Failed to write data file:\n\n $CONFIG{fileto}");

($fileLocking) && flock(FILETO, LOCK_EX);

if ($CONFIG{'fileattop'}) {

### want to add new entries to top of file.

print FILETO $header;

print FILETO $outbuffer;

print FILETO substr($fileto, length($header));

} else {

if ($footer) {

print FILETO substr($fileto, 0, (-1 * length($footer)));

} else {

print FILETO $fileto;

}

print FILETO $outbuffer;

print FILETO $footer;

}

($fileLocking) && flock(FILETO, LOCK_UN);

close (FILETO);

hideFile($CONFIG{'fileto'}) unless ($CONFIG{'filereadable'});

return 1;

}

sub genFileto {

$CONFIG{'fileto'} = makePath(translateFormat($CONFIG{'fileto'}));

$CONFIG{'fileto'} =~ m!^(.*)/[^/]*$!;

my $tmpFileName = $1;

### We have to check to see if its writable, or at least the

### directory where it'll be created is writable. Also check

### the file's a read file and not a symlink

fatal ("Can not write to fileto of:\n\n $CONFIG{fileto}")

if ((-e $CONFIG{'fileto'} && ! -w $CONFIG{'fileto'}) ||

(-e $CONFIG{'fileto'} && -l $CONFIG{'fileto'}) ||

(! -e $CONFIG{'fileto'} && ! -w $tmpFileName));

}

END_OF_FILE_FUNCTIONS

my $templateFunctions =<<'END_OF_TEMPLATE_FUNCTIONS';

############################################################################

# Subroutine: getOutVals ( name, {attributes}, iscounter )

# Given a variable name and an assoc array of attributes, return a list

# of values with appropriate formatting. The value of iscounter is set by

# reference.

############################################################################

sub getOutVals {

my @nameoutput = ();

$_ = shift;

my $at = shift;

my $isCounter = shift;

my %ATTRIBS = %$at;

$debug && print STDERR "In getOutVals with $_\n";

$ATTRIBS{'format'} = '%ddd% %mmmm% %dd% %yyyy%' if (/^http_date/ &&

!$ATTRIBS{'format'});

$ATTRIBS{'format'} = '%hhhh%:%mm%:%ss%' if (/^http_time/ &&

!$ATTRIBS{'format'});

$$isCounter = 0;

if (/^http_[a-zA-Z_]+$/) {

if (!/^http_(time|date)$/) {

push(@nameoutput, getHttpValue($_)) if (getHttpValue($_));

} else {

push(@nameoutput, translateFormat($ATTRIBS{'format'},

$ATTRIBS{'timeoffset'}));

}

} elsif (/^cookie_([\w\-]+)/) {

push(@nameoutput, $query->cookie($1)) if ($query->cookie($1));

} elsif (/^counter_(\d+)/i) {

push(@nameoutput, $CONFIG{"counter"}->{"${1}value"})

if ($CONFIG{"counter"}->{"${1}value"});

$$isCounter = (!$CONFIG{"counter"}->{"${1}value"});

} elsif (/^maillist_(\d+)$/) {

if ($CONFIG{"maillistdata"}) {

push(@nameoutput, $CONFIG{"maillistdata"}->{$1});

}

} elsif (/^sql_\d+_\d+_\d+$/) {

push(@nameoutput, $sqlVals{$_}) if ($sqlVals{$_} || $sqlVals{$_} eq '0');

} else {

push(@nameoutput, $query->param($_));

}

if ($ATTRIBS{'format'} =~ /^\%(c+)\%$/) {

my $span = length($1);

@nameoutput = map { s/\D//g; s/(\d{0,$span})/$1 /g; s/\s+$//s; $_; }

@nameoutput;

}

return @nameoutput;

}

############################################################################

# doMaths ( element_list, element_name, attributes )

# For every element in the list, perform the maths function specified in

# the math attribute. Assume this is for the element named element_name

############################################################################

sub doMaths {

my $list = shift;

my $name = shift;

my $at = shift;

my $isCounter = 0;

my $expr = $at->{'math'};

$expr =~ s/\s//g;

my $toEval = "";

my $mathSyms = '\)\(\+\-\*\/';

$debug && print STDERR "In doMath with $expr\n";

while ($expr =~ /[sS][uU][mM]\(([^\)]+)\)/) {

my $var = $1;

my @vals = getOutVals($var, $at, \$isCounter);

my $sum = 0;

for (@vals) {

if (/^(\-?(\d*\.)?\d+)$/) {

$sum += $_;

}

}

$expr =~ s/[sS][uU][mM]\(\Q$var\E\)/$sum/g;

}

while ($expr =~ /[cC][oO][uU][nN][tT]\(([^\)]+)\)/) {

my $var = $1;

my @vals = getOutVals($var, $at, \$isCounter);

my $cnt = scalar(@vals);

$expr =~ s/[cC][oO][uU][nN][tT]\(\Q$var\E\)/$cnt/g;

}

my @breakdown = split(/([^$mathSyms]+)/, $expr);

$debug && print STDERR ("Breakdown = " . join(" | ", @breakdown) . "\n");

for (@breakdown) {

if (/^\s*([$mathSyms]+|(?:\d*\.)?\d+)\s*$/) {

s/^0+([^\.])/$1/;

$toEval .= $_;

} elsif ($_ ne $name && $_) {

my @vals = getOutVals($_, $at, \$isCounter);

if ($vals[0] && $vals[0] =~ /^(\-?(\d*\.)?\d+)$/) {

my $x = sprintf("%f", $vals[0]);

$toEval .= "(" . $x . ")";

} elsif ($_) {

$toEval .= "0";

}

} elsif ($_) {

$toEval .= $name;

}

}

$toEval =~ s/([$mathSyms])(\-(?:(\d*\.)?\d+))/$1\($2\)/g;

$toEval =~ s/\)\(\-(\d)/\)-\($1/g;

$debug && print STDERR "to eval is $toEval\n";

my $i = 0;

while ($i < scalar(@$list)) {

my $thisEval = $toEval;

my $rep = ($list->[$i] ?

($list->[$i] =~ /^(\-?(\d*\.)?\d+)$/ ?

$list->[$i] : "1") : "0");

$thisEval =~ s/\Q$name\E/$list->[$i]/g;

$thisEval =~ s/[^${mathSyms}\.\d]//g;

$debug && print STDERR "Evaling $thisEval\n";

my $r = eval($thisEval);

if ($at->{'precision'} =~/^(\-?)\d+$/) {

### allow for negative precisions for the fractional portion

if ($1) {

$at->{'precision'} = $at->{'precision'} * -1;

$r = $r - int($r);

$r = sprintf("%." . $at->{'precision'} . "f", $r);

$r =~ s/.*\.//;

} else {

$r = sprintf("%." . $at->{'precision'} . "f", $r);

}

}

$list->[$i] = ($r ? $r : ([email protected] ? "NaN" : "0"));

$i++;

}

}

############################################################################

# Subroutine: URLunescape ( string )

# Takes a URL escaped string and unencodes it. Again pinched from CGI.pm

############################################################################

sub URLunescape {

($debug) && (print STDERR "URLunescape (@_) \@ " . time . "\n");

my $todecode = shift;

return undef unless defined($todecode);

$todecode =~ tr/+/ /; # pluses become spaces

$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;

return $todecode;

}

############################################################################

# Subroutine: substOutput ( buffer_containing_output_tags,

# flag_to_specify_format )

# Substitute all instances of the output tag in a string

# returning the substituted string

# $format is '0' for no changes

# '1' for output newlines as HTML <br> elements

# '2' for remove all newlines, and replace with space characters.

# '4' prepare the output for lout

############################################################################

sub substOutput {

($debug) && (print STDERR "substOutput (@_) \@ " . time . "\n");

my ($buffer, $format, $includes) = @_;

my ($tempstring, $endstring, $outstring, $doLines) = "";

$outstring = "";

doLoops($buffer);

$$buffer =~ s#<only\s+if\s*=\s*(?:"([^"]+)"|'([^']+)')\s*>(.*?)</only>#

subOnly($3,$1,$2)#siexg;

while ($$buffer =~ /(<output(\s+[^>\s]+?\s*=\s*('[^']*'|

"[^\"]*"|[^\s>]+))+\s*>)/iox) {

$$buffer = $';

$endstring = $`;

($tempstring, $doLines) = translateOutput($1);

$tempstring =~ s/\n/<br \/>/g if ($format == 1 && !$doLines);

$tempstring =~ s/\cM?\n/ /g if ($format == 2);

$tempstring = clean4Lout($tempstring) if ($format == 4);

$outstring .= "$endstring$tempstring";

}

$$buffer = "$outstring$$buffer";

$outstring = "";

if ($format == 1 || $includes) {

### CRAZZEEEE!!! do SSI type includes if its a HTML format type

### substitution.

while ($$buffer =~ /<\!\-\-\#include\s+virtual\s*=\s*

("([^"]+)"|'([^']+)'|(\S+))\s*

(type\s*=\s*(?:html|"html"|'html')\s*)?-->/xi) {

$$buffer = $';

$endstring = $`;

$tempstring = "";

my $incFile = $2;

$incFile = $3 if ($3);

$incFile = $4 if ($4);

my $needsEncoding = $5;

($debug) && (print STDERR "including $incFile\n");

$incFile = makePath($incFile);

if (-f $incFile && -r $incFile &&

-T $incFile) {

grabFile($incFile, \$tempstring);

}

$tempstring = clean4Lout($tempstring) if ($format == 4);

$tempstring = dehtml(undef, $tempstring) if ($needsEncoding);

$outstring .= "$endstring$tempstring";

}

}

$$buffer = $outstring . $$buffer;

}

############################################################################

# Subroutine: subOnly ( replace_data, condition [, condition ] )

# Return the replacement text if the condition is true

############################################################################

sub subOnly {

my $repTxt = shift;

my $cond = shift;

$cond = shift unless ($cond);

return (evalCond($cond) ? $repTxt : "");

}

############################################################################

# Subroutine: translateOutput ( output_tag_string )

# Take a tag in the form <output ...> and return the value based on

# %rqpairs. If no pair exists, return "".

############################################################################

sub translateOutput {

($debug) && (print STDERR "translateOutput (@_) \@ " . time . "\n");

my ($line) = shift;

my ($name, $attrib, $tag, $nameoutput) = "";

my (@nameoutput) = ();

my (%ATTRIBS) = ();

my (%SETATTRIBS) = ();

my $isCounter = 0;

my $newlineTrans = 0;

my $matchVal = 1;

my $matchData = 1;

### Some attributes can be declared multiple times. define them here

my $multiAttr = { charmap => 1 };

foreach (keys %$multiAttr) {

$ATTRIBS{$_} = [];

}

$ATTRIBS{'list'} = $ATTRIBS{'post'} = $ATTRIBS{'pre'} = $ATTRIBS{'case'} =

$ATTRIBS{'name'} = $ATTRIBS{'sub'} = $ATTRIBS{'alt'} =

$ATTRIBS{'math'} = $ATTRIBS{'format'} = $ATTRIBS{'delim'} =

$ATTRIBS{'type'} = $ATTRIBS{'indent'} = $ATTRIBS{'newline'} =

$ATTRIBS{'altvar'} = $ATTRIBS{'subvar'} =

$ATTRIBS{'value'} = $ATTRIBS{'valuevar'} = $ATTRIBS{'data'} =

$ATTRIBS{'wrap'} = $ATTRIBS{'timeoffset'} = "";

while ($line =~ /(\w+)\s*=\s*("[^"]*"|'[^']*'|[^\s>]+)/) {

print STDERR "Translating $line\n" if ($debug);

$line = $';

$attrib = lc($1);

$tag = $2;

$tag =~ s/^'([^']*)'/$1/ unless ($tag =~ s/^"([^"]*)"/$1/);

if ($multiAttr->{$attrib}) {

push(@{$ATTRIBS{$attrib}}, $tag);

} else {

$ATTRIBS{$attrib} = $tag;

}

$SETATTRIBS{$attrib} = 1;

}

$ATTRIBS{'name'} =~ s/^\s*([\S])/$1/;

$ATTRIBS{'name'} =~ s/(.*[\S])\s*$/$1/;

$_ = $ATTRIBS{'name'};

securityName($_);

@nameoutput = getOutVals($_, \%ATTRIBS, \$isCounter);

### Firstly, it should be unescaped if needed.

if ($ATTRIBS{'type'} =~ /^unescaped(html)?$/i) {

@nameoutput = map { URLunescape($_); } @nameoutput;

} elsif ($ATTRIBS{'type'} =~ /^sql$/i) {

push(@{$ATTRIBS{'charmap'}}, "',''");

$SETATTRIBS{'charmap'} = 1;

}

if (scalar(@nameoutput) && $ATTRIBS{'subvar'} &&

(!$SETATTRIBS{'valuevar'} || $nameoutput[0] eq $ATTRIBS{'valuevar'})) {

securityName($ATTRIBS{'subvar'});

$debug && print STDERR "subvar replace $_ with $ATTRIBS{'subvar'}\n";

$_ = $ATTRIBS{'subvar'};

@nameoutput = getOutVals($_, \%ATTRIBS, \$isCounter);

} elsif ((!scalar(@nameoutput) || ($SETATTRIBS{'valuevar'} &&

$nameoutput[0] ne $ATTRIBS{'valuevar'})) && $ATTRIBS{'altvar'}) {

securityName($ATTRIBS{'altvar'});

$debug && print STDERR "altvar replace $_ with $ATTRIBS{'altvar'}\n";

$_ = $ATTRIBS{'altvar'};

@nameoutput = getOutVals($_, \%ATTRIBS, \$isCounter);

}

if ($SETATTRIBS{'value'}) {

$matchVal = ($nameoutput[0] eq $ATTRIBS{'value'}) ? 1 : 0;

}

if ($SETATTRIBS{'data'} && scalar(@nameoutput)) {

$ATTRIBS{'data'} =~ s/^\s*(.*?)\s*$/\L$1\E/;

$debug && print STDERR "data $nameoutput[0] as a $ATTRIBS{'data'}\n";

$matchData = !checkType($ATTRIBS{'data'},$nameoutput[0]);

$debug && print STDERR "check results in $matchData\n";

}

### We can now apply various transformations on the data.

### Upper of lowercase

if ($ATTRIBS{'case'} =~ /^upper$/i) {

@nameoutput = map { uc($_); } @nameoutput;

} elsif ($ATTRIBS{'case'} =~ /^lower$/i) {

@nameoutput = map { lc($_); } @nameoutput;

}

### Perform maths functions

if ($ATTRIBS{'math'}) {

doMaths(\@nameoutput, $_, \%ATTRIBS);

}

### Map special character

if ($SETATTRIBS{'charmap'}) {

foreach (@{$ATTRIBS{'charmap'}}) {

if (m!(.)\,(.*)!) {

my $fromChar = $1;

my $toStr = $2;

$debug && print STDERR "Char mapping -${fromChar}- to -${toStr}-\n";

$debug && print STDERR "(" . join("),(", @nameoutput) . ")\n";

@nameoutput = map { s/\Q$fromChar\E/$toStr/gs;$_; } @nameoutput;

$debug && print STDERR "(" . join("),(", @nameoutput) . ")\n";

}

}

}

if ($ATTRIBS{'type'} =~ /^escaped$/i) {

@nameoutput = map { URLescape($_); } @nameoutput;

} elsif ($ATTRIBS{'type'} =~ /^(unescaped)?html$/i) {

@nameoutput = map { dehtml($1,$_); } @nameoutput;

}

# Wrap the element

if ($ATTRIBS{'wrap'} && $ATTRIBS{'wrap'} =~ /^0*[1-9][0-9]*$/) {

my $wrapCnt = 0;

while ($wrapCnt < scalar(@nameoutput)) {

wrapText($ATTRIBS{'wrap'}, \${nameoutput[$wrapCnt++]});

}

}

if ($ATTRIBS{'newline'} =~ /^html$/i) {

@nameoutput = map { s/(\r?\n)/<br>\n/gs;$_; } @nameoutput;

$newlineTrans = 1;

} elsif ($ATTRIBS{'newline'} =~ /^none$/i) {

@nameoutput = map { s/(\r?\n)/ /gs;$_; } @nameoutput;

$newlineTrans = 1;

} elsif ($ATTRIBS{'newline'} =~ /^paragraphs$/i) {

@nameoutput = map { s/(\r?\n){3,}/\n\n/gs;$_; } @nameoutput;

@nameoutput = map { s/(\r?\n){1,1}/\n/gs;$_; } @nameoutput;

$newlineTrans = 1;

} elsif ($ATTRIBS{'newline'} =~ /^unchanged$/i) {

$newlineTrans = 1;

}

if (@nameoutput || $nameoutput || $isCounter) {

### Now we have to be smart and handle multiple lists. Default

### behavior is to display multiples as HTML UL lists, but can

### be overridden by the list tag of OL, DIR or MENU.

if (!$SETATTRIBS{'sub'} && ($ATTRIBS{'list'} || scalar(@nameoutput) > 1 )) {

if ($SETATTRIBS{'delim'}) {

$nameoutput= join("$ATTRIBS{post}$ATTRIBS{delim}$ATTRIBS{pre}",

@nameoutput);

return("$ATTRIBS{pre}$nameoutput$ATTRIBS{post}", $newlineTrans);

} elsif ($ATTRIBS{'list'} =~ /TEXT/i) {

### Plain text list.

$nameoutput = join("$ATTRIBS{post}\n * $ATTRIBS{pre}",

@nameoutput);

return("\n * $ATTRIBS{pre}$nameoutput$ATTRIBS{post}\n",

$newlineTrans);

} else {

$ATTRIBS{'list'} = 'UL' unless ($ATTRIBS{'list'} ne "");

$nameoutput = join ("$ATTRIBS{post}<LI>$ATTRIBS{pre}",

@nameoutput);

return("<$ATTRIBS{list}><LI>$ATTRIBS{pre}" .

"$nameoutput$ATTRIBS{post}</$ATTRIBS{list}>",

$newlineTrans);

}

} else {

$nameoutput = $nameoutput[0] unless ($nameoutput);

if ($SETATTRIBS{'sub'} && $matchVal && $matchData) {

return($ATTRIBS{'sub'},0);

} elsif ($matchVal && $matchData) {

if ($SETATTRIBS{'indent'}) {

$nameoutput =~ s/(\cM?\n)/$1$ATTRIBS{'indent'}/g ;

$nameoutput = $ATTRIBS{'indent'} .

($isCounter ? '0' : $nameoutput);

$isCounter = 0;

}

return("$ATTRIBS{pre}" .

($isCounter ? '0' : $nameoutput) . "$ATTRIBS{post}",

$newlineTrans);

} else {

return($ATTRIBS{'alt'},0);

}

}

} else {

return($ATTRIBS{'alt'},0);

}

}

sub doLoops {

my $data = shift;

my $loopCnt = 0;

my $pos = 0;

my $buffer = "";

my $num = "-?(?:\\d+|\\d*\\.\\d+)";

my @els = split(/(<loop\s+[^>]+>|<\/loop>)/m, $$data);

my $max = 0;

while (@els && $max++ < 10000) {

my $el = $els[$pos];

my $isLoop = ($el =~ /^<loop\s+[^>]+>/i);

my $isEndLoop = ($el =~ /^<\/loop>/i);

if ($isLoop && $#els > 1) {

$loopCnt++;

$pos++;

} elsif ($isLoop) {

splice(@els, $pos, 1);

$pos--;

} elsif ($isEndLoop) {

if ($loopCnt > 0) { $loopCnt--; }

if ($pos >= 1) {

my $e1 = $els[$pos - 1];

my $p1 = $pos - 1;

my $p2 = $pos - 2;

my $e2 = $els[$p2];

my $start = undef;

my $end = undef;

my $step = 1;

my $name = "";

my $field = "";

my $sql = "";

#get loop data from $els[$p2];

if ($e2 =~ /\sstart\s*=\s*(?:"($num)"|'($num)'|($num))/i) {

$start = $+;

}

if ($e2 =~ /\send\s*=\s*(?:"($num)"|'($num)'|($num))/i) {

$end = $+;

}

if ($e2 =~ /\sstep\s*=\s*(?:"($num)"|'($num)'|($num))/i) {

$step = $+;

}

if ($e2 =~ /\sname\s*=\s*(?:"(\w+)"|'(\w+)'|(\w+))/i) {

$name = $+;

}

if ($e2 =~ /\sfield\s*=\s*(?:"([\-\.\w]+)"|'([\-\.\w]+)'|([\-\.\w]+))/i) {

if ($query->param($+)) { $field = $+; }

}

if ($e2 =~ /\ssqlrun\s*=\s*(?:"(\d+)"|'(\d+)'|(\d+))/i) {

$sql = $+;

}

my @flist = ();

if ($field) {

@flist = $query->param($field);

if ($step > 0) {

$start = 0 unless ($start && $start > 0);

$end = $#flist unless ($end && $end < $#flist);

} else {

$start = $#flist unless ($start && $start < $#flist);

$end = 0 unless ($end && $end > 0);

}

}

if ($sql) {

if ($step > 0) {

$start = 1;

$end = $sqlCount{$sql};

} else {

$start = $sqlCount{$sql};

$end = 1;

}

}

# are we able to loop?

my $tmpBuff = "";

if (defined($start) && defined($end) &&

(($step > 0 && $start <= $end) ||

($step < 0 && $start >= $end))) {

my $a = $start;

my $b = $end;

while (($step > 0 && $a <= $b) || ($step < 0 && $a >= $b)) {

my $data = $e1;

if ($name) {

if (@flist) {

$data =~ s/\@$name\@/$flist[$a]/sg;

} else {

$data =~ s/\@$name\@/$a/sg;

}

}

$tmpBuff .= $data;

$a += $step;

}

}

my $o = ($pos > 2) ? 3 : 2;

if ($o == 3) {

$els[$pos - $o] .= $tmpBuff;

} else {

$els[$pos - $o] = $tmpBuff;

}

if ($pos + 1 <= $#els) {

$els[$pos - $o] .= $els[$pos + 1];

splice(@els, $pos + 1, 1);

}

splice(@els, $pos - $o + 1, $o);

}

$pos = 0;

$loopCnt = 0;

} elsif ($loopCnt == 0) {

# not in a loop, so this can be added to the content

$buffer .= shift(@els);

} elsif ($pos >= $#els) {

# end of the line... if we're here, then there are

# unclosed loops - join the array, and shove it on buffer.

$buffer .= join("", @els);

@els = ();

$pos = 0;

} elsif (!$isLoop && !$isEndLoop) {

$pos++;

}

}

$$data = $buffer;

}

END_OF_TEMPLATE_FUNCTIONS

my $pdfFunctions =<<'END_OF_PDF_FUNCTIONS';

sub makePdf {

my $template = shift;

my $pdfName = shift;

$pdfName =~ s!(.*/)([^/]+)(\.[^/]*)$!$2\.pdf!;

my $pdfDir = $1;

($debug) && print STDERR "pdfDir is $pdfDir\n";

my $fname = "$scratchPad/$pdfName";

if ($ps2pdf && $lout && -d $scratchPad) {

opendir (PDFDIR, $pdfDir);

my @epsFiles = grep { /^[^\.]/ && /\.eps$/i } readdir(PDFDIR);

closedir (PDFDIR);

for (@epsFiles) {

($debug) && print STDERR "copying $pdfDir$_\n";

copy("${pdfDir}$_", "${scratchPad}/$_");

}

open (LIN, ">${scratchPad}/lout.in");

print LIN $$template;

close (LIN);

my $cmd1 = "$lout $loutOpts lout.in >lout.ps";

my $cmd2 = "$ps2pdf lout.ps ${fname}";

($debug) && print STDERR "fname is $fname\n";

($debug) && print STDERR "Running $cmd1\nand\n$cmd2\n";

chdir ($scratchPad);

system("$cmd1");

system("$cmd2");

if ($fname) {

return $fname;

}

}

return "";

}

sub clean4Lout {

my $val = shift;

$val =~ s/[\t ]+/ /gs;

$val =~ s/([\"\\])/\"\\$1\"/gs;

$val =~ s/([\#\&\/\@\^\{\|\}\~])/\"$1\"/gs;

$val =~ s/(\r?\n){2,2}/\n\@LP\n/gs;

# Win latin stuff... can we check for this in form

# enctype?

$val =~ s/\x82/ \@Char quotesinglbase /gs;

$val =~ s/\x83/ \@Florin /gs;

$val =~ s/\x84/ \@Char quotedblbase /gs;

$val =~ s/\x85/ \@Char ellipsis /gs;

$val =~ s/\x86/ \@Dagger /gs;

$val =~ s/\x87/ \@DaggerDbl /gs;

$val =~ s/\x88/ \@Char circumflex /gs;

$val =~ s/\x8a/ \@Char S /gs;

$val =~ s/\x8c/ \@Char OE /gs;

$val =~ s/\x91/ \@Char quoteleft /gs;

$val =~ s/\x92/ \@Char quoteright /gs;

$val =~ s/\x93/ \@Char quotedbl /gs;

$val =~ s/\x94/ \@Char quotedbl /gs;

$val =~ s/\x95/ \@Sym bullet /gs;

$val =~ s/\x96/ \@Char endash /gs;

$val =~ s/\x97/ \@Char emdash /gs;

$val =~ s/\x99/ \@Sym trademarkserif /gs;

$val =~ s/\x9c/ \@Char oe /gs;

$val =~ s/\x9e/ \@Char z /gs;

$val =~ s/\x9f/ \@Char Y /gs;

return $val;

}

END_OF_PDF_FUNCTIONS

my $mailFunctions =<<'END_OF_MAIL_FUNCTIONS';

############################################################################

# Subroutine: attachFilesToMail (fileset_name, message_ref, has_body_content)

# This attaches files to a message body.

############################################################################

sub attachFilesToMail {

my $type = shift;

my $msg = shift;

my $hasBody = shift;

my ($key, $file);

while (($key, $file) = each %{$CONFIG{$type}}) {

($debug) && print STDERR "examining attachment $key, $file\n";

next unless ($key =~ /(\d+)file/ && -f $file);

my $attachNum = $1;

$file =~ m!/([^/]+)$!;

my $filename = $1;

my $mime_type =

$CONFIG{$type}->{"${attachNum}mime"};

($debug) && print STDERR "Attaching a mime type of $mime_type for $filename ($key)\n";

unless ($mime_type) {

$mime_type = (!$fhBug && -T $file) ? 'text/plain' :

'application/octet-stream';

}

my @stats = stat($file);

($debug) && print STDERR "Attaching $file ($stats[7] bytes) " .

"to email\n";

my $data = { Path => $file,

ReadNow => 1,

Filename => $filename

};

unless ($mime_type =~ /^text\//) {

$data->{'Encoding'} = "base64";

}

if (!$hasBody) {

$$msg->data("This is a MIME message with attachments");

}

my $m = $$msg->attach(%$data);

$m->attr("content-type" => $mime_type);

}

}

############################################################################

# Subroutine: fakeEmail (address)

# MIME::Lite doesn't like sending odd email From addresses, so make them

# look a bit saner.

############################################################################

sub fakeEmail {

($debug) && (print STDERR "fakeEmail (@_) \@ " . time() . "\n");

$_ = shift(@_);

if (!/\@.+/) { $_ .= "\@localhost"; }

s/\@+/@/g;

($debug) && (print STDERR "fakeEmail returns $_\n");

return $_;

}

############################################################################

# Subroutine: mailResults ()

# Mail the results to the people in $mailto and also send back a mail to the

# form's sender using the sendertemplate config field.

############################################################################

sub mailResults {

($debug) && (print STDERR "mailResults (@_) \@ " . time() . "\n");

my ($outstring, $messageBuffer, $value, $tmpfile, $mailbuffer) = "";

my ($mailto, $email, $tmp, $theirMail);

my $t = time();

if ($CONFIG{'encodesubjects'} && $CONFIG{'charset'} !~ /^us-ascii$/i) {

foreach ('subject', 'sendersubject') {

my $s = substr(MIME::Lite::encode_base64($CONFIG{$_}), 0, -2);

$CONFIG{$_} = "=?" . $CONFIG{'charset'} . "?B?" . $s . "?=";

}

}

checkEmail($email) if ($email = $query->param('Email'));

$mailto = $CONFIG{'mailto'};

$mailto = $email if (!$mailto && $CONFIG{'returntosender'} && $email);

### Handle a sendertemplate setting.

if ($email && ($CONFIG{'sendertemplate'} || $CONFIG{'htmlsendertemplate'} ||

$CONFIG{'pdfsendertemplate'})

&& ($mailto || $CONFIG{'replyto'} || $CONFIG{'senderreplyto'} ||

$CONFIG{'senderfrom'} || $email)) {

print STDERR "Should be sending a mail to the sender\n" if ($debug);

my $theirTemplate = "";

my $theirHtmlTemplate = "";

my $theirPdfTemplate = "";

my $hasBody = 0;

my $senderFrom = $CONFIG{'senderfrom'} ? $CONFIG{'senderfrom'} :

($CONFIG{'senderreplyto'} ? $CONFIG{'senderreplyto'} :

($mailto ? $mailto :

($CONFIG{'replyto'} ? $CONFIG{'replyto'} :

$email)));

my $senderMsg = MIME::Lite->build(

'From' => $senderFrom,

'To' => $email,

'Subject' => ($CONFIG{'sendersubject'} ?

$CONFIG{'sendersubject'} :

$CONFIG{'subject'}),

'Reply-To' => ($CONFIG{'senderreplyto'} ?

$CONFIG{'senderreplyto'} :

($CONFIG{'replyto'} ?

$CONFIG{'replyto'} :

$mailto)),

'Bcc' => $CONFIG{'senderbcc'},

'Encoding' => $CONFIG{'encoding'},

);

if ($CONFIG{'sendertemplate'}) {

grabFile($CONFIG{'sendertemplate'}, \$theirTemplate);

substOutput(\$theirTemplate, '0', 1);

}

if ($CONFIG{'htmlsendertemplate'}) {

grabFile($CONFIG{'htmlsendertemplate'}, \$theirHtmlTemplate);

substOutput(\$theirHtmlTemplate, '0', 1);

}

if ($CONFIG{'pdfsendertemplate'}) {

($debug) && print STDERR "Translating pdf sender template\n";

grabFile($CONFIG{'pdfsendertemplate'}, \$theirPdfTemplate);

substOutput(\$theirPdfTemplate, '4', 1);

my $pdfFile = makePdf(\$theirPdfTemplate,

$CONFIG{'pdfsendertemplate'});

if ($pdfFile) {

($debug) && print STDERR "Marking sender pdf as attachment\n";

$CONFIG{"attachments"}->{"${attachCount}file"} = $pdfFile;

$CONFIG{"attachments"}->{ $attachCount++ . "mime" } =

"application/pdf";

}

}

if ($CONFIG{'wrap'} && $theirTemplate) {

wrapText($CONFIG{'wrap'}, \$theirTemplate);

}

if ($theirTemplate && $theirHtmlTemplate) {

$hasBody = 1;

($debug) && print STDERR "Making alt sender email\n";

$senderMsg->attr("content-type" => 'multipart/alternative');

$senderMsg->attr("content-type.boundary" => 'eskjdlj239w09epaods' . $$);

my $m1 = $senderMsg->attach(

Data => "$theirTemplate",

);

$m1->attr("content-type" => "text/plain; charset=$CONFIG{charset}");

my $m2 = $senderMsg->attach(

Data => "$theirHtmlTemplate",

);

$m2->attr("content-type" => "text/html; charset=$CONFIG{charset}");

$m2->attr("content-location"

Compartilhar este post


Link para o post
Compartilhar em outros sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Visitante
Responder

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Processando...

×
×
  • Criar Novo...