callyvan
New User
Nov 10, 2010, 10:07 AM
Post #1 of 1
(3409 views)
|
|
Desperate for help with deciphering Perl script
|
Can't Post
|
|
I am hurting here, been tasked with trying to add a bunch of new content to this script, but since it was written 10 years ago and continuously patched up badly since then, I have no clue what does what anymore..can someone comment in text that will at least explain what the different routines do?
____________________________________________________
#!/opt/common/perl/bin/perl
##############################################################################
# Form Mail: eMail Form Processor Pro #
# Version 4.0.7 - local copy #
##############################################################################
# Developer: MitriDAT #
# Modified: Scrotum Taint #
# info@email-form.com #
# http://www.email-form.com #
# Last Modified 14-10-2010 #
##############################################################################
# Copyright 2000-2010, MitriDAT. All Rights Reserved. #
##############################################################################
# init default values (array @, variable $)
@Months=qw(January February March April May June July August September October November December);
#above is an array which stores values using qw function which ends up like this: ("January", "February", "March", "April", "May", "June", "July", "August",
"September etc...
unshift @Months, "";
#this array now has 13 elements since an empty quote was added to the start
#why not just combine both together into 1 statement?
@Weekdays= qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
#used in ## DATE FORMATTING section
$error_loop = 0;
$browser_out = 0;
$content_type = "Content-Type: text/html\n\n";
#above only used once, not useful as variable.
$cfg_file = "formprocessorpro.cfg";
#FIX 24/07/2003 - explanation underneath
if (!(-e $cfg_file)) { #Test if the file contained in the variable "$cfg_file" exists, if it does
if ($ENV{'WINDIR'}) { #If the system environment has a variable called "WINDIR"
$pt = $ENV{'SCRIPT_FILENAME'}; #Put the contents of the system environment variable "SCRIPT_FILENAME" into the perl var "$pt"
$pt = $ENV{'PATH_TRANSLATED'} if $ENV{'PATH_TRANSLATED'}; #Put the contents of the system environment variable PATH_TRANSLATED into the pel var "$pt"
only if the variable exists in the #system environment.
$pt =~ s/\\/\//g; #Change all the backslashes (\) into forward slashses in the variable "$pt"
@m = split(/\//,$pt); pop @m; #6) Split up the path contained in the perl variable "$pt" into parts and put them in the array "@m", then remove the
last path #part on the right, for eg, "/one/two/three" would remove the "three".
$cfg_file = join("\x2F",@m).'/formprocessorpro.cfg'; #Join up the paths again, putting a forward slash in between (0x2f is a forward slash
character) and append the string #'/formprocessorpro.cfg', and put the result into the perl var "$cfg_file"
}
$cfg_file =~ s/\/\//\//g; #Replace "//" for "/" (in case there are any double slashes in the string) and put into "$cfg_file"
}
#/FIX 24/07/2003
$mail_format = "plain";
$cfg_form = "form.cfg";
$multi_separator = ", ";
##############################################################################
use CGI::Carp qw (fatalsToBrowser);
#above may no longer be needed depending on Perl version on server
use CGI qw/:cgi/;
$ENV{'UPDATED'}= ' ';
$query = new CGI;
# default message
if ($ENV{'REQUEST_METHOD'} eq 'GET' and $ENV{'QUERY_STRING'} eq "login") {
&StartPage;
exit(0);
}elsif($ENV{'REQUEST_METHOD'} eq 'GET'){
Error('Request method error.',"Request method error.");
}
@lines = ReadFile2('Configuration File', $cfg_file);
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "push \@$1, \"$2\";";}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$$1 = \"$2\";"; }
}
######whether we shall administrate or not##### the heck does this mean?
if ($query->param('pass09123')) {
$pass09123=$query->param('pass09123');
if ($managing_password eq $pass09123) {
if (defined($query->param('_saveChanges'))) {# we save edited fields
&SavePage;
$ENV{'UPDATED'} = "<p align=center><strong><font color=red>Configuration script was updated</font></strong></p>\n";
&StartPage;
}
else {#we only start editing
&ManagePage;
}
} else {#we entered incorrect pwd or didn't enter it at all
&StartPage;
}
exit(0);
}
######end of administrating####################
# we can inherit base path if drawn through several pages in page sequence
$stem_base_path = "/sites/webpwtra/data/rh-hr/";
$base_path = $stem_base_path.$query->param('base_path').'/' if defined(($query->param('base_path')));
$base_path = $query->param('_base_path').'/' if defined(($query->param('_base_path')));
@lines=ReadFile2('Form Configuration File', $base_path . $cfg_form);
foreach $line (@lines) {
if ($line =~ /^(attachments_path|mail_format)\s*=\s*(.+?)\s*(\x23|$)/)
{eval "\$$1 = \"$2\";";}
if ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$FORM{$1} = \"$2\";";}
}
$attachments_path=$base_path . $attachments_path;
&ParseForm;
&CheckRef;
# change Branch e-mail addresses to actual branch or host branch names and insert new key-value into %FORM
############################## change this to case instead of elsif (much cleaner) - Yvan edit ############################
my $branch_email_e = $FORM{r_Branch};
my $hostbranch_email_e = $FORM{r_Host_Branch};
my $branch_email_f = $FORM{r_Direction_generale};
my $hostbranch_email_f = $FORM{r_Direction_generale_daccueil};
my $branch_realname_e = '';
my $branch_realname_f = '';
if (($branch_email_e eq 'Dot.exp.rh-exp.staf.hr@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq 'Dot.exp.rh-exp.staf.hr@tpsgc-pwgsc.gc.ca')) {
$branch_realname_e = 'Human Resources'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.fin-exp.staf.fin@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.fin-exp.staf.fin@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Finance'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.min-exp.staf.min@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.min-exp.staf.min@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Minister’s Office'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.sm-exp.staf.dm@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.sm-exp.staf.dm@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Deputy Minister’s Office'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.bapgr-exp.staf.ocro@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.bapgr-exp.staf.ocro@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Office of the Chief Risk Officer'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dga-exp.staf.ab@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dga-exp.staf.ab@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Acquisitions'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgbi-exp.staf.rpb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgbi-exp.staf.rpb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Real Property'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgcisp-exp.staf.cissb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgcisp-exp.staf.cissb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Consulting, Information, and Shared Services'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgcgbr-exp.staf.abcb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgcgbr-exp.staf.abcb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Accounting, Banking and Compensation'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgsmpc-exp.staf.cspcb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgsmpc-exp.staf.cspcb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Corporate Services, Policy and Communications'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgsit-exp.staf.itsb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgsit-exp.staf.itsb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Information Technology Services'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgve-exp.staf.aeb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgve-exp.staf.aeb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Audit and Evaluation'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.bt-exp.staf.tb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.bt-exp.staf.tb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Translation Bureau'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.atl-exp.staf.atl@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.atl-exp.staf.atl@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Atlantic Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.que-exp.staf.que@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.que-exp.staf.que@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Quebec Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.ont-exp.staf.ont@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.ont-exp.staf.ont@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Ontario Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.oue-exp.staf.wes@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.oue-exp.staf.wes@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Western Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.pac-exp.staf.pac@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.pac-exp.staf.pac@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Pacific Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.boa-exp.staf.opo@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.boa-exp.staf.opo@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Office of the Procurement Ombudsman'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.dgcp-exp.staf.ppb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.dgcp-exp.staf.ppb@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Parliamentary Precinct'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.mat-exp.staf.mat@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.mat-exp.staf.mat@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Matane Site'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.she-exp.staf.she@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.she-exp.staf.she@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Shediac Site'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
elsif (($branch_email_e eq 'Dot.exp.surveillance-exp.staf.oversight@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_e eq
'Dot.exp.surveillance-exp.staf.oversight@tpsgc-pwgsc.gc.ca')) { $branch_realname_e = 'Departmental Oversight'; $FORM{'branch_in_emailsubject'} =
$branch_realname_e; }
############################# missing else statement ################################
if (($branch_email_f eq 'Dot.exp.rh-exp.staf.hr@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq 'Dot.exp.rh-exp.staf.hr@tpsgc-pwgsc.gc.ca')) {
$branch_realname_f = 'Ressources humaines'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.fin-exp.staf.fin@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.fin-exp.staf.fin@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Finances'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.min-exp.staf.min@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.min-exp.staf.min@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Bureau du ministre'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.sm-exp.staf.dm@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.sm-exp.staf.dm@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Bureau du sous-ministre'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.bapgr-exp.staf.ocro@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.bapgr-exp.staf.ocro@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Agent principal de gestion des risques'; $FORM{'branch_in_emailsubject'} =
$branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dga-exp.staf.ab@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dga-exp.staf.ab@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Approvisionnements'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dgbi-exp.staf.rpb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgbi-exp.staf.rpb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Biens immobiliers'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dgcisp-exp.staf.cissb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgcisp-exp.staf.cissb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Conseils, Information et Services Partagés'; $FORM{'branch_in_emailsubject'} =
$branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dgcgbr-exp.staf.abcb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgcgbr-exp.staf.abcb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Comptabilité, Gestion bancaire et Rémunération'; $FORM{'branch_in_emailsubject'} =
$branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dgsmpc-exp.staf.cspcb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgsmpc-exp.staf.cspcb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Services ministériels, politiques et communications';
$FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dgsit-exp.staf.itsb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgsit-exp.staf.itsb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Services d’infotechnologie'; $FORM{'branch_in_emailsubject'} = $branch_realname_f;
}
elsif (($branch_email_f eq 'Dot.exp.dgve-exp.staf.aeb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgve-exp.staf.aeb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Vérification et l’évaluation'; $FORM{'branch_in_emailsubject'} = $branch_realname_f;
}
elsif (($branch_email_f eq 'Dot.exp.bt-exp.staf.tb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.bt-exp.staf.tb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Bureau de la traduction'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.atl-exp.staf.atl@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.atl-exp.staf.atl@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Région de l’Atlantique'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.que-exp.staf.que@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.que-exp.staf.que@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Région du Québec'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.ont-exp.staf.ont@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.ont-exp.staf.ont@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Région de l’Ontario'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.oue-exp.staf.wes@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.oue-exp.staf.wes@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Région de l’Ouest'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.pac-exp.staf.pac@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.pac-exp.staf.pac@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Région du Pacifique'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.boa-exp.staf.opo@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.boa-exp.staf.opo@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Bureau de l’ombudsman de l’approvisionnement'; $FORM{'branch_in_emailsubject'} =
$branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.dgcp-exp.staf.ppb@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.dgcp-exp.staf.ppb@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Cité Parlementaire'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.mat-exp.staf.mat@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.mat-exp.staf.mat@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Site de Matane'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.she-exp.staf.she@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.she-exp.staf.she@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Site de Shediac'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
elsif (($branch_email_f eq 'Dot.exp.surveillance-exp.staf.oversight@tpsgc-pwgsc.gc.ca') or ($hostbranch_email_f eq
'Dot.exp.surveillance-exp.staf.oversight@tpsgc-pwgsc.gc.ca')) { $branch_realname_f = 'Surveillance ministérielle'; $FORM{'branch_in_emailsubject'} =
$branch_realname_f; }
############################# missing else statement ################################
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/\/|\.)aol\.com/);
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/|\.)not/);
#above = not sure, can combine, or omit?
$FORM{'_format_decimals'} = "0" unless ($FORM{'_format_decimals'});
$FORM{'GMT_OFFSET'} = "0" unless ($FORM{'GMT_OFFSET'});
## DATE FORMATTING
$date_format = 'dd.mm.yyyy' unless defined($date_format);
$date = $date_format;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $FORM{'GMT_OFFSET'}*3600);
$mon++; $year+=1900; $syear="0".($year-2000);
$mday="0".$mday if length($mday)<2 ;
$date=~s/weekday/$Weekdays[$wday]/i;
$date=~s/wee/substr($Weekdays[$wday],0,3)/ei;
$date=~s/Month/$Months[$mon]/i;
$date=~s/mmm/substr($Months[$mon],0,3)/ei;
$mon=(length($mon)<2?"0":"").$mon; # "0" schreiben oder nicht?
$date=~s/yyyy/$year/i;
$date=~s/yy/$syear/io;
$date=~s/dd/$mday/io;
$date=~s/mm/$mon/eio;
$ENV{'DATE_GMT'} = sprintf("%02d:%02d:%02d %s GMT%+d",$hour,$min,$sec,$date,$FORM{'GMT_OFFSET'});
## END DATE FORMATTING
srand(time ^ $$);
$rnd1 = sprintf("%04d", int(rand 10000));
$rnd2 = sprintf("%04d", int(rand 10000));
$FORM{'unique_reference_number'} = "$year$mon$mday-$rnd1-$rnd2" unless ($FORM{'unique_reference_number'});
if (@missing_values or @bad_emails or @only_digits or @only_words) { Error('evil values') }
foreach $key (keys %FORM)
{
$FORM{$key} =~s/\0//g;
$FORM{$key} =~s/\"(\s|\.|\)|\Z)/©$1/g;
$FORM{$key} =~s/(\A|\s|\.|\()\"/$1½/g;
#Page number
$pn=$FORM{'page_no'}; $pn++;
# start_email is hidden field in the form which email has to been sent after
if ($key =~ /^_send_email/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Email Template',$FORM{$key});
@lines = ParseText(@lines);
@lines = ParseEmail(@lines);
if ($mailserver ne '') {SendMailBySmtp(@lines);} else {SendMail(@lines);}
}
}
elsif ($key =~ /^_send_html_email/)#HTML email template
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Email Template',$FORM{$key});
@lines = ParseTextMail(@lines);
@lines = ParseHtmlEmail(@lines);
if ($mailserver ne '') {SendMailBySmtp(@lines);} else {SendMail(@lines);}
}
}
elsif ($key =~ /^_out_file/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Log File',$FORM{$key});
@lines = ParseText(@lines);
LogFile('LogFile Template',@lines);
}
}
elsif ($key =~ /^_browser_out$FORM{page_no}$/ and $browser_out < 2)
{
$browser_out++;
@lines = ReadFile('Browser Template', $FORM{$key});
@lines = ParseText(@lines);
foreach $line (@lines) {
if ($line=~/(<\/form>)/i) {
$hfields="";
foreach $k (keys %FORM) {
$v=$FORM{$k};
if ($k =~ /^page_no/) {$v++;}
$hfields .= '<input type="hidden" name="'.$k.'" value="'.$v.'">'."\n";
}
if (!defined($FORM{page_no})) {$hfields .= '<input type="hidden" name="page_no" value="1">'."\n";}
$line=$`.$hfields.$1.$';
}
}
BrowserOut(@lines);
}
elsif ($key =~ /^_redirect/ and $browser_out < 2)
{
$browser_out++;
print "Location: $FORM{$key}\n\n";
}
}
unless ($browser_out) {
@msg = (<DATA>);
$ENV{'OUT_TITLE'} = "Submission Successful / Transmission de la demande r‰ussie";
$ENV{'OUT_MSG'} = "Your submission was successful. Thank you. / La transmission de votre demande est r‰ussie. Merci.";
@msg = ParseText(@msg);
BrowserOut(@msg);
}
opendir(DIR, $attachments_path) || exit(0);
@files_list = grep { /^\d{8}_(.*)_\._file$/ && -f "$attachments_path$_" } readdir(DIR);
closedir DIR;
foreach $attachment_file (@files_list) {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($attachments_path.$attachment_file);
if (time() >= $mtime + $attachments_ttl) {
unlink($attachments_path.$attachment_file);
}
}
exit(0);
### Subroutines ###
sub round
{
$value = shift @_;
$round_dec = shift @_;
$round_dec = $FORM{'_format_decimals'} if ($round_dec eq "");
return sprintf("%.".$round_dec."f", $value);
}#round
sub BrowserOut
{
print "$content_type@_\n";
}#BrowserOut
sub CheckRef
{
my ($valid_referer, @terms);
if ((@Referers) and ($ENV{'HTTP_REFERER'})) {
foreach $referer (@Referers) {
if ($ENV{'HTTP_REFERER'} =~ m|http.*?://$referer|i) {
$valid_referer++;
last;
}
}
} else {
$valid_referer++;
}
unless ($valid_referer) {
@terms = split(/\//,$ENV{'HTTP_REFERER'});
Error ('Bad Referer',
"'$ENV{'HTTP_REFERER'}' is not authorised to use this script. If you want them to be able to,
you should add '$terms[2]' to the referer list."
);
}
}#CheckRef
sub Error
{
++$error_loop;
my $title = shift @_;
my $msg = shift @_;
my @error;
# french stuff below, can and should be updated.
if ($title eq 'evil values') {
my $val;
if (@missing_values) {
$msg = qq|<p></p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@missing_values) {
if ($val eq 'Direction_generale_daccueil') {
$msg .= "<li>Direction générale d'accueil\n";
}
elsif ($val eq 'Direction_generale') {
$msg .= "<li>Direction générale\n"; }
elsif ($val eq 'Premiere_entente_daffectation_OU') {
$msg .= "<li>Première entente d'affectation OU Prolongation d'entente d'affectation\n"; }
elsif ($val eq 'Laffectation_comblera_un_poste_existant') {
$msg .= "<li>L'affectation comblera un poste existant OU L'affectation ne comblera pas un poste existant\n"; }
elsif ($val eq 'Secteur_daccueil') {
$msg .= "<li>Secteur d'accueil\n"; }
elsif ($val eq 'Lieu_geographique') {
$msg .= "<li>Lieu géographique\n"; }
elsif ($val eq 'Numero_du_poste') {
$msg .= "<li>Numéro du poste\n"; }
elsif ($val eq 'Titre_daffectation') {
$msg .= "<li>Titre d'affectation\n"; }
elsif ($val eq 'Exigences_linguistiques') {
$msg .= "<li>Exigences linguistiques\n"; }
elsif ($val eq 'Est-ce_que_lemploye_satisfait_aux_exigences_linguistiques') {
$msg .= "<li>Est-ce que l'employé(e) satisfait aux exigences linguistiques de l'affectation?\n"; }
elsif ($val eq 'Exigences_en_matiere_de_securite') {
$msg .= "<li>Exigences en matière de sécurité\n"; }
elsif ($val eq 'Date_dentree_en_vigueur') {
$msg .= "<li>Date d'entrée en vigueur\n"; }
elsif ($val eq 'Date_dexpiration') {
$msg .= "<li>Date d'expiration\n"; }
elsif ($val eq 'Nom_du_gestionnaire_dattache') {
$msg .= "<li>Nom du gestionnaire d'attache\n"; }
elsif ($val eq 'Horaire_de_travail') {
$msg .= "<li>Horaire de travail\n"; }
elsif ($val eq 'Objectifs_et_fonctions_de_laffectation') {
$msg .= "<li>Objectifs et fonctions de l'affectation\n"; }
elsif ($val eq 'Numero_de_liste_de_paye') {
$msg .= "<li>Numéro de liste de paye\n"; }
elsif ($val eq 'Niveau_de_securite_de_lemploye') {
$msg .= "<li>Niveau de sécurité de l'employé\n"; }
elsif ($val eq 'Date_dexpiration_de_la_cote_de_securite') {
$msg .= "<li>Date d'expiration de la cote de sécurité\n"; }
elsif ($val eq 'Nom_de_lagent_de_securite_de_service') {
$msg .= "<li>Nom de l'agent de sécurité de service qui a confirmé la cote de sécurité de
l'employé(e)\n"; }
elsif ($val eq 'Premiere_entente_detachement_OU') {
$msg .= "<li>Première entente de détachement OU Prolongation d'entente de détachement\n"; }
elsif ($val eq 'Le_detachement_comblera_un_poste_existant') {
$msg .= "<li>Le détachement comblera un poste existant OU Le détachement ne comblera pas un poste existant\n"; }
elsif ($val eq 'Titre_en_detachement') {
$msg .= "<li>Titre en détachement\n"; }
elsif ($val eq 'Est-ce_que_lemploye_satisfait_aux_exigences_linguistiques') {
$msg .= "<li>Est-ce que l'employé(e) satisfait aux exigences linguistiques du détachement?\n"; }
elsif ($val eq 'Objectifs_et_fonctions_du_detachement') {
$msg .= "<li>Objectifs et fonctions du détachement\n"; }
elsif ($val eq 'Premiere_langue_officielle') {
$msg .= "<li>Première langue officielle\n"; }
elsif ($val eq 'Langue_officielle_preferee') {
$msg .= "<li>Langue officielle préférée\n"; }
elsif ($val eq 'Preferred_langue_officielle') {
$msg .= "<li>Langue officielle préférée\n"; }
elsif ($val eq 'Ministere_dattache') {
$msg .= "<li>Ministère d'attache\n"; }
elsif ($val eq 'Numero_de_poste_dattache') {
$msg .= "<li>Numéro de poste d'attache\n"; }
elsif ($val eq 'Nom_et_coordonnees_du_Conseiller') {
$msg .= "<li>Nom et coordonnées du Conseiller en rémunération au ministère d'attache\n"; }
elsif ($val eq 'Groupe_et_niveau') {
$msg .= "<li>Groupe et niveau\n"; }
elsif ($val eq 'Emploi_occasionnel_initial') {
$msg .= "<li>Emploi occasionnel initial ou prolongation d'emploi occasionnel\n"; }
elsif ($val eq 'Date_dentree_en_vigueur_proposee') {
$msg .= "<li>Date d'entrée en vigueur proposée\n"; }
elsif ($val eq 'Prenom') {
$msg .= "<li>Prénom\n"; }
elsif ($val eq 'CIDP_numero') {
$msg .= "<li>Numéro de CIDP\n"; }
elsif ($val eq 'Est-ce_que_la_personne_satisfait_aux_exigences_linguistiques') {
$msg .= "<li>Est-ce que la personne satisfait aux exigences linguistiques?\n"; }
elsif ($val eq 'Date_dentree_en_vigueur_de_la_cote_de_securite') {
$msg .= "<li>Date d'entrée en vigueur de la cote de sécurité\n"; }
elsif ($val eq 'Curriculum_vitae') {
$msg .= "<li>Curriculum vitae\n"; }
elsif ($val eq 'Nom_du_gestionnaire_titulaire_des_pouvoirs_subdelegues_en_matiere_de_dotation') {
$msg .= "<li>Nom du gestionnaire titulaire des pouvoirs subdélégués en matière de dotation\n"; }
elsif ($val eq 'Nom_du_gestionnaire_titulaire_des_pouvoirs_financiers_subdelegues') {
$msg .= "<li>Nom du gestionnaire titulaire des pouvoirs financiers subdélégués\n"; }
elsif ($val eq 'Unite_organisationnelle') {
$msg .= "<li>Unité organisationnelle\n"; }
elsif ($val eq 'Ministere_expediteur') {
$msg .= "<li>Ministère expéditeur\n"; }
elsif ($val eq 'Nom_et_coordonnees_du_la_Conseiller') {
$msg .= "<li>Nom et coordonnées du (de la) Conseiller(ère) en rémunération au ministère
expéditeur\n"; }
elsif ($val eq 'Est-ce_que_la_personne_proposee_pour_mutation_satisfait_A_la_norme') {
$msg .= "<li>Est-ce que la personne proposée pour mutation satisfait à la norme de qualification pour le groupe professionnel
du poste à combler?\n"; }
elsif ($val eq 'Groupe_professionnel_pertinent') {
$msg .= "<li>Groupe professionnel pertinent\n"; }
elsif ($val eq 'Numero_de_poste_du_superviseur_immediate') {
$msg .= "<li>Numéro de poste du superviseur immédiat\n"; }
elsif ($val eq 'Premiere_demande_en_vertu_dun_programme_etudiant_ou_reemploi_dun_etudiant_une_etudiante') {
$msg .= "<li>Première demande en vertu d'un programme étudiant ou réemploi d'un étudiant/une étudiante\n";
}
elsif ($val eq 'Groupe_professionnel_pertinent') {
$msg .= "<li>Groupe professionnel pertinent\n"; }
elsif ($val eq 'Numero_de_poste_du_superviseur_immediat') {
$msg .= "<li>Numéro de poste du superviseur immédiat\n"; }
elsif ($val eq 'Code_de_centre_de_responsabilite') {
$msg .= "<li>Code de centre de responsabilité\n"; }
elsif ($val eq 'Codage_financier') {
$msg .= "<li>Codage financier\n"; }
elsif ($val eq 'Code_organisationnel') {
$msg .= "<li>Code organisationnel\n"; }
elsif ($val eq 'Code_de_reference') {
$msg .= "<li>Code de référence\n"; }
elsif ($val eq 'Codage_financier_dattache') {
$msg .= "<li>Codage financier de l'organisme d'attache\n"; }
elsif ($val eq 'Code_organisationnel_dattache') {
$msg .= "<li>Code organisationnel de l'organisme d'attache\n"; }
elsif ($val eq 'Code_de_reference_dattache') {
$msg .= "<li>Code de référence de l'organisme d'attache\n"; }
elsif ($val eq 'Codage_financier_daccueil') {
$msg .= "<li>Codage financier de l'organisme d'accueil\n"; }
elsif ($val eq 'Code_organisationnel_daccueil') {
$msg .= "<li>Code organisationnel de l'organisme d'accueil\n"; }
elsif ($val eq 'Code_de_reference_daccueil') {
$msg .= "<li>Code de référence de l'organisme d'accueil\n"; }
elsif ($val eq 'Code_dadresse_postale') {
$msg .= "<li>Code d'adresse postale\n"; }
elsif ($val eq 'Clauses_speciales') {
$msg .= "<li>Clauses spéciales\n"; }
elsif ($val eq 'Nom_de_la_personne_qui_soumet_la_demande') {
$msg .= "<li>Nom de la personne qui soumet la demande\n"; }
elsif ($val eq 'Adresse_de_courriel_de_la_personne_qui_soumet_la_demande') {
$msg .= "<li>Adresse de courriel de la personne qui soumet la demande\n"; }
elsif ($val eq 'Nom_du_gestionnaire_qui_est_subdelegue_en_matiere_de_dotation') {
$msg .= "<li>Nom du gestionnaire qui est subdélégué en matière de dotation\n"; }
elsif ($val eq 'Nom_du_gestionnaire_qui_est_subdelegue_en_matiere_financiere') {
$msg .= "<li>Nom de gestionnaire qui est subdélégué en matière financière\n"; }
else {
$msg .= "<li>$val\n"; }
}
$msg .= "</ol></td></tr></table>\n";
}
if (@bad_emails) {
$msg .= qq|<p></p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@bad_emails) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_digits) {
$msg .= qq|<p></p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_digits) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_dig_and_dolar) {
$msg .= qq|<p></p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_dig_and_dolar) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_words) {
$msg .= qq|<p></p>\n<ol type="i">\n|;
foreach $val (@only_words) { $msg .= "<li>$val\n" }
$msg .= "</ol>\n";
}
$title = '';
$msg .= qq|<p></p>\n|;
}
if ($FORM{'_error_url'}) {
print "Location: $FORM{'_error_url'}\n\n"
} elsif ($FORM{'_error_path'} and $error_loop < 2) {
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ReadFile('Error Template',$FORM{'_error_path'});
@error = ParseText(@error);
BrowserOut(@error);
} else {
@error = (<DATA>);
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ParseText(@error);
BrowserOut(@error);
}
exit(0);
}#Error
sub LogFile
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
my $file_secure = $base_path . $file;
unless ($file_secure =~ m#^(.+)$#) { # $1 is untainted
Error('File Name Error', "filename '$file_secure' has invalid characters / Caractères invalides dans le nom de fichier.");
}
$file_secure = $1;
open(FILE,">>$file_secure") or Error('File Access Error',"An error occurred when trying to append to the $msg ($file): $!");
if (!defined($ENV{'COMSPEC'})) { # flock ain't needed on Windows !NT based systems
flock(FILE,2) or Error('File Lock Error',"An error occured when locking the $msg ($file): $!.");
}
print FILE @_;
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!.");
}#LogFile
sub ReadFile
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
$file = $base_path . $file;
open(FILE, "$file") or Error('File Access Error',"An error occurred when opening the $msg ($file): $!.");
my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when closing the $msg ($file): $!.");
return @lines;
}#ReadFile
sub ReadFile2
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
open(FILE, "$file") or Error('File Access Error',"An error occurred when opening the $msg ($file): $!.");
my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when closing the $msg ($file): $!.");
return @lines;
}#ReadFile2
sub ParseForm
{
my ($key, $prefs, $buffer, $file, $local_file, $value, $name, $file_name);
@names = $query->param;
foreach $name (@names)
{
$value = $query->param($name);
#FIX 07.07.2003
if ($mail_format eq 'html') {
$value =~s/\n/\<br\>/ig;
}
$FORM{$name} = $value;
if ($bytesread = read($value, $buffer, 1024)) {
$file_name = $value;
if ($file_name =~ /([^\/\\:]*)$/) {
$file_name = $1;
}
my $t_size = 0;
srand(time ^ $$);
my $rnd = sprintf("%08d", int(rand 100000000));
$local_file = $attachments_path . $rnd . "_" . $file_name . "_._file";
$FORM{$name."_uploaded"} = $rnd . "_" . $file_name . "_._file";
open (OUTFILE,">$local_file") or Error('File Access Error',"An error occurred when trying to save attachments / Une erreur s'est
produite au moment d'enregistrer les pièces jointes ($local_file): $!");
binmode OUTFILE;
$t_size = length($buffer);
print OUTFILE $buffer;
while ($bytesread = read($value, $buffer, 1024)) {
$t_size += length($buffer);
print OUTFILE $buffer;
}
close OUTFILE;
my $f_size = 1024 * $max_file_size;
$lang_id = $query->param('lang_id');
if($t_size > $f_size && $f_size != 0) {
unlink($local_file);
if ($lang_id eq 'form-e') {
Error("Uploading file is too large. It must to be less than $max_file_size KB.");
}
else {
Error("Le fichier à télécharger est trop volumineux. Il ne doit pas excéder $max_file_size Ko.");
}
}
} else {
if ($name =~ /^([rs]*[edwmcn]?[rs]*)_/) {
($prefs, $key) = split /_/, $name, 2;
if ($prefs =~ /s/i and $value) {
$value =~ s/^(\s)*//;
$value =~ s/(\s)*$//;
$FORM{$name} = $value;
}
if ($prefs =~ /m/i and $value) {
$multi_separator = $FORM{'_multi_separator'} if defined($FORM{'_multi_separator'});
@value = $query->param($name);
$value = join($multi_separator,@value);
$value =~ s/^default$multi_separator|^default//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /n/i and $value) {
$value =~ s/\n//ig;
$value =~ s/\r//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /r/i and $value eq "")
{ push @missing_values, $key }
if ($prefs =~ /e/i and $value and isEmailBad($value))
{ push @bad_emails, $key }
if ($prefs =~ /d/i and $value and !($value =~ /^(\d+|\d+\.\d+)$/))
{ push @only_digits, $key }
if ($prefs =~ /c/i and $value and !($value =~ /^(\$?\d+\$?|\$?\d+\.\d+\$?)$/))
{ push @only_dig_and_dolar, $key }
if ($prefs =~ /w/i and $value and $value =~ /\W/)
{ push @only_words, $key }
}
}
}
}#ParseForm
sub ParseText
{
my ($line, $key, $value, $sub, $script);
foreach $line (@_) {
while (($key => $value) = each %FORM)
{ $line =~ s/\[$key\]/$value/ig }
while (($key => $value) = each %ENV)
{ $line =~ s/\[\%$key\]/$value/ig }
if ($line =~ /<script/) {$script = 1;}
if ($script != 1) {
$line =~ s/\[[^<](.)*?[^>]\]//g;
} else {
$line =~ s/([^A-Za-z0-9\-_,])\[[^<](.)*?[^>]\]/$1/g;
}
if ($line =~ /<\/script/) {$script = 0;}
}
foreach $line (@_) {
while ($line =~ /\[<((.)*?)>\]/) {
$sub = $1;
if ($sub !~ /^([\d\+\*\/\-%\.,x<>\(\)\s]|round|ifcond)*$/s) {
#Error("Error in expression", $sub);
}
$sub = eval $sub;
$line =~ s/\[<(.)*?>\]/$sub/s;
}
}
return @_;
}#ParseText
sub ParseTextMail
{
my ($line, $key, $value, $sub, $script);
foreach $line (@_) {
while (($key => $value) = each %FORM)
{
$value =~ s/\n/\<br\>/g;
$line =~ s/\[$key\]/$value/ig
}
while (($key => $value) = each %ENV)
{ $line =~ s/\[\%$key\]/$value/ig }
$line =~ s/\x7e(\w+)((\[)(\d)(\]))?/eval "\$$1$3$4$5"/e;
}
return @_;
}#ParseTextMail
sub ifcond
{
$cond = shift @_;
$res1 = shift @_;
$res2 = shift @_;
if($cond) {
return sprintf("%s", $res1);
} else {
return sprintf("%s", $res2);
}
}#ifcond
sub ParseEmail
{
my ($line, $attachment_file, $add2email, $real_name, @email);
$add2email = "";
foreach $line (@_)
{
if (($line =~ /^Subject: (.+)\n$/i) and ($mail_format eq 'html')) {
$sline = $line."Content-Type: text\/html; charset=ISO-8859-1\n";
$line =~ s/^Subject: (.+)\n$/$sline/i;
}
if ($line =~ /^Attachment: (.+)$/i)
{
my @files = split (/,/, $1);
foreach $attachment_file (@files)
{
$attachment_file =~ s/(^\s*|\s*$)//g;
if (length($attachment_file)>0) {
if ($attachment_file =~ /([^\/\\:]*)$/)
{
$attachment_file = $1;
}
if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
{$real_name = $1;}
else {$real_name = $attachment_file;}
#FIX
if (-e $attachments_path . $attachment_file)
{
$add2email .= "---2099962873-1165733044-991133573=:5283\n";
$add2email .= "Content-Transfer-Encoding: BASE64\n";
$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";
open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attachment file / Une erreur s'est
produite au moment d'ouvrir la pièce jointe.", "\'$attachments_path$attachment_file\', $!");
binmode FILE;
while (read(FILE, my $buf, 60*57))
{
$add2email .= encode_base64($buf);
}
close FILE;
}
}
}
push @email, "MIME-Version: 1.0\n";
push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
push @email, " This message is in MIME format. The first part should be readable text,\n";
push @email, " while the remaining parts are likely unreadable without MIME-aware tools.\n";
push @email, " Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
push @email, "---2099962873-1165733044-991133573=:5283\n";
} else {
# Strip tags if mail format is plain, skipping service info lines
#$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
push @email, $line;
}
}
if ($add2email)
{
push @email, "\n$add2email";
push @email, "---2099962873-1165733044-991133573=:5283--\n";
}
return @email;
}#ParseEmail
sub ParseHtmlEmail
{
my ($line, $attachment_file, $add2email, $real_name, @email);
$add2email = "";
foreach $line (@_)
{
if ($line =~ /^Subject: (.+)\n$/i) {
$sline = $line."Content-Type: text\/html; charset=ISO-8859-1\n";
$line =~ s/^Subject: (.+)\n$/$sline/i;
}
if ($line =~ /^Attachment: (.+)$/i)
{
my @files = split (/,/, $1);
foreach $attachment_file (@files)
{
$attachment_file =~ s/(^\s*|\s*$)//g;
if (length($attachment_file)>0) {
if ($attachment_file =~ /([^\/\\:]*)$/)
{
$attachment_file = $1;
}
if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
{$real_name = $1;}
else {$real_name = $attachment_file;}
if (-e $attachments_path . $attachment_file)
{
$add2email .= "---2099962873-1165733044-991133573=:5283\n";
$add2email .= "Content-Transfer-Encoding: BASE64\n";
$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";
open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attachment file / Une erreur s'est
produite au moment d'ouvrir la pièce jointe", "\'$attachments_path$attachment_file\', $!");
binmode FILE;
while (read(FILE, my $buf, 60*57))
{
$add2email .= encode_base64($buf);
}
close FILE;
}
}
}
push @email, "MIME-Version: 1.0\n";
push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
push @email, " This message is in MIME format. The first part should be readable text,\n";
push @email, " while the remaining parts are likely unreadable without MIME-aware tools.\n";
push @email, " Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
push @email, "---2099962873-1165733044-991133573=:5283\n";
} else {
# Strip tags if mail format is plain, skipping service info lines
#$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
push @email, $line;
}
}
if ($add2email)
{
push @email, "\n$add2email";
push @email, "---2099962873-1165733044-991133573=:5283--\n";
}
return @email;
}#ParseHtmlEmail
sub isEmailBad
{
$value = shift @_;
return (($value =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/) or
($value !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})(\]?)$/));
}#isEmailBad
sub SendMailBySmtp
{
my($line, $var_name, @message);
unless ($smtp_used) {
eval "use Net::SMTP";
if ($@) {
Error('Net::SMTP init error', "Can't load Net::SMTP module");
return 0;
}
$smtp_used = 1;
}
@message = @_;
foreach $line (@message)
{
if ($line =~ /^(to|from|b?cc): (.+)$/i)
{
$mail_param = $1;
$mail_val = $2;
if ($mail_val =~ /<(.+)>/)
{
$mail_val = $1;
}
$var_name = "mail_".lc($mail_param);
@$var_name = split(/\x2c(\s*)?/,$mail_val);
}
}
$smtp = Net::SMTP->new($mailserver);
$smtp->mail($mail_from);
foreach $mt (@mail_to) {$smtp->recipient($mt);}
foreach $mt (@mail_cc) {$smtp->recipient($mt);}
foreach $mt (@mail_bcc) {$smtp->recipient($mt);}
$smtp->data();
$smtp->datasend(@_);
$smtp->dataend();
$smtp->quit;
undef $smtp;
undef @mail_to;
undef @mail_cc;
undef @mail_bcc;
}#SendMailBySmtp
sub SendMail
{
if ($mail_cmd ne "") {
open(MAIL,"|$mail_cmd") or Error('Mailer Open Error',"An error occurred when trying to open the mailer ($mail_cmd): $!.");
print MAIL @_;
print MAIL "\n.\n";
close(MAIL) or Error('Mail Send Error',"An error occurred when sending the email: $?. Please check the email's headers.");
}
}#SendMail
sub encode_base64
{
my $res = "";
pos($_[0]) = 0;
while ($_[0] =~ /(.{1,45})/gs) {
$res .= substr(pack('u', $1), 1);
chop($res);
}
$res =~ tr|` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
$res =~ s/(.{1,76})/$1\n/g;
return $res;
}#encode_base64
sub ManagePage
{
$ENV{'OUT_TITLE'} = "eMail Form Processor Pro Script Administrative Section";
$ENV{'OUT_MSG'} = "";
#auto set base_path as path to this file
my($server,$platform) = $ENV{'SERVER_SOFTWARE'} =~ /([A-Za-z0-9\.\/]{1,})\s\(([A-Za-z0-9\s]{1,})\)/;
$unix=1 if !($platform =~ /Win32/i);
my(@path) = split(/\//,$ENV{'SCRIPT_FILENAME'});
pop(@path);
if(defined($unix)){ $ret='/'; } else { $ret = ''; }
foreach (@path){ $ret.=$_.'/'; }
$ENV{'MYPLATFORM'} = $platform;
$ENV{'MYPATH'} = $ret;
open (CFILE, "<cform.html") or Error('Config Form Open Error',"An error occurred when opening config form (cform.html): $!. Please check paths and
file.");
@msg = <CFILE>;
close (CFILE) or Error('Config Form Close Error','An error occured while closing the file (cform.html): $!.');
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#ManagePage
sub SavePage {
&ParseForm;
$mas=0;
@lines = ReadFile2('Configuration File', $cfg_file);
open (FILE, ">$cfg_file") or Error('Config Form Open Error',"An error occurred when opening config file($cfg_file): $!. Please check paths and file
permissions (Must be 766).");
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name.$mas}/ if defined($FORM{$var_name.$mas});
#print "$var_name === $FORM{$var_name.$mas}<br>";
$mas++;
}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name}/ if defined($FORM{$var_name});
}
print FILE $line;
}
close (FILE) or Error('Config Form Close Error','An error occured while closing the file ($cfg_file): $!.');
1;
}#SavePage
sub StartPage {
$ENV{'UPDATED'} = "" unless ($ENV{'UPDATED'});
$ENV{'OUT_TITLE'} = "Form Mail: eMail Form Processor Pro Script";
$ENV{'OUT_MSG'} = qq~The latest version of this script and documentation is available from <a href="http://www.email-form.com/">Email-Form</a>.
<form action=$ENV{'SCRIPT_NAME'} method="POST"><p class="alignCenter">To access configuration, please enter password: <br>
<input type="password" name="pass09123" value="" />
<input type="Submit" value=" ..:: OK ::.. " /></form></p>
~;
@msg = (<DATA>);
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#StartPage
|
MAIN
SEARCH
WHO'S 
LOG 