
callyvan
New User
Nov 10, 2010, 10:07 AM
Post #1 of 1
(3081 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
|