Advertisement

06.07.2008 at 05:33AM PDT, ID: 23465968
[x]
Attachment Details

Matt's formmail V1.92 will not send Checkbox form elements

Asked by paul_lcs in Perl Programming Language, CGI Scripting, Hypertext Markup Language (HTML)

I've been using Bformmail, a modified version of Matt Wright's Formmail for some time. (see code attached for details and urls) Works great. I have recently tried to implement a checkbox in a form and the checkbox element is not included. I could use Radio buttons, but then the phrasing of the question in the form becomes a Yes or No instead of Check if interested.

Can anyone confirm that formmail.pl does not support checkboxes?

Thanks,

PaulStart Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:

#!/usr/bin/perl
 
##############################################################################
#                                                                            #
# BFormMail                        Version 2.2.192                           #
#                                                                            #
# Copyright 1997-2004 Brian Sietz  bsietz@infosheet.com                      #
# The Byte Shop - Small Business Solutions for Internet Web Development      #
# http://www.infosheet.com                                                   #
# Created:  8/14/1997                                                        #
# Modified: 11/27/2004                                                       #
#                                                                            #
# Based on FormMail by Matt Wright - mattw@scriptarchive.com                 #
# Modifications Copyright (c) 1997-2004 Brian S. Sietz, All Rights Reserved. #
# This version of FormMail may be used and modified free of charge by anyone #
# so long as this copyright notice and the one below by Matthew Wright remain#
# intact. By using this code you agree to indemnify Brian Sietz from any     #
# liability arising from it's use. You also agree that this code cannot be   #
# sold to any third party without prior written consent of both Brian Sietz  #
# and Matthew M. Wright.						     #
#                                                                            #
##############################################################################
# FormMail                        Version 1.92                               #
# Copyright 1995-2002 Matt Wright mattw@scriptarchive.com                    #
# Created 06/09/95                Last Modified 04/21/02                     #
# Matt's Script Archive, Inc.:    http://www.scriptarchive.com/              #
##############################################################################
# COPYRIGHT NOTICE                                                           #
# Copyright 1995-2002 Matthew M. Wright  All Rights Reserved.                #
#                                                                            #
# FormMail may be used and modified free of charge by anyone so long as this #
# copyright notice and the comments above remain intact.  By using this      #
# code you agree to indemnify Matthew M. Wright from any liability that      #
# might arise from its use.                                                  #
#                                                                            #
# Selling the code for this program without prior written consent is         #
# expressly forbidden.  In other words, please ask first before you try and  #
# make money off of my program.                                              #
#                                                                            #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact. #
##############################################################################
# ACCESS CONTROL FIX: Peter D. Thompson Yezek                                #
#                     http://www.securityfocus.com/archive/1/62033           #
##############################################################################
#                                                                            #
#                                                                            #
# BFormMail                                                                  #
#                                                                            #
#      Took Matt's original 1.6 script and made some mods...                 #
#      Then took Matt's 1.92 and added the security features here            #
#                                                                            #
#      Mods made were mostly from features in yForm                          #
#      which was Matt's original FormMail 1.5 with changes by:               #
#      Donald E. Killen 10/2/96 and                                          #
#      Ashley Bass 1/29/97                                                   #
#                                                                            #
# History:                                                                   #
#                                                                            #
#   Added 6/29/97:                                                           #
#      - Added table output to HTML (orig by Don Killen in yForm)            #
#      - Added printing of realname & email in HTML output (orig Ashley Bass)#
#      - Added misc form fields:                                             #
#          cc  - if present, a Cc: is added to the e-mail when sent          #
#          bcc - if present, a Bcc: is added to the e-mail when sent         #
#      - Added courtesy reply (based on code from yForm)                     #
#        Changed field names; a bit longer, but easier to understand:        #
#          courtesy_reply - if present and email also present, reply sent    #
#          courtesy_reply_texta, First line of courtesy reply text           #
#          courtesy_reply_textb, Second line of courtesy reply text          #
#          courtesy_who_we_are, Name or company underneath the "Regards"     #
#          courtesy_our_url, URL to print after "Regards"                    #
#          courtesy_our_email, e-mail to print after "Regards"               #
#      - Added database option (based on code from yForm)                    #
#          append_db, if present, value is the data file to append to        #
#          db_delimiter, delimiter between fields                            #
#      - Removed FormMail display in HTML output (except error output)       #
#          Nobody should care about who wrote the script, if they really     #
#          want to know, they should send e-mail to the webmaster...         #
#                                                                            #
#   Added 8/14/97:                                                           #
#      - Added support for e-mail to fax services by adding two form fields: #
#          faxto, if specified is the e-mail address of the fax service.     #
#                 for Faxaway, it would be a phone number@faxaway.com, i.e.  #
#                 16097951994@faxaway.com                                    #
#          faxfrom, specifies the From: field for the fax.  Faxaway requires #
#                 field to be a valid Faxaway customer.                      #
#        More information can be found in the BFormMail.readme file or       #
#        at http://www/faxaway.com                                           #
#      - Added db_fields config field to control which fields are appended   #
#        to the database.                                                    #
#      - All form fields appended to database are stripped of newlines so    #
#        that all outputted fields will be on a single record                #
#                                                                            #
#   Added 1/27/98:                                                           #
#      - Added courtesy_who_we_are2 - same as courtesy_who_we_are but an     #
#        extra line of text if needed.                                       #
#      - Added support for another e-mail to fax service.  Fax service is    #
#        selected by the faxservice field.  Currently, the faxservice field  #
#        can specify 'faxaway' or 'faxsav' or 'netmoves'. Each service       #
#        requires a slightly (faxsav & netmoves are the same)                #
#        different header. The following fields fully control the form-fax   #
#        gateway:                                                            #
#          faxservice, if specified enables the form-to-fax gateway and will #
#             specify the desired service.  The current services supported   #
#             are 'faxsav', 'netmoves' and 'faxaway'.                        # 
#             For more information on these                                  #
#             services visit http://www.netmoves.com or                      #
#             http://www.faxaway.com                                         #
#             Please note, faxsav  requires the variable $faxstamp           #
#             to be set - see below.                                         #
#          faxnum, specifies the telephone number to send the fax.  For      #
#             security, the full e-mail address is assembled in the script.  #
#             Both faxsav & faxaway require the format as follows:           #
#             16095551212                                                    #
#          faxfrom, specifies the From: field for the fax.  Must be from an  #
#             authorized account from both services.   For example:          #
#             bsietz@infosheet.com                                           #
#        More information can be found in the BFormMail.readme file.         #
#                                                                            #
#   Added 7/16/98:                                                           #
#      - Added check for valid e-mail address, if specified for cc: & bcc:   #
#                                                                            #
#   Added 12/9/98:                                                           #
#      - Fixed bug in print_blank_fields                                     #
#                                                                            #
#   Added 8/15/99:                                                           #
#      - Y2K fix provided by Karl Bogott                                     #
#                                                                            #
#   Added 10/10/99:                                                          #
#      - In routine check_url, if HTTP_REFERER not available, no longer      #
#        return true.                                                        #
#                                                                            #
#   Added 3/12/2000:                                                         #
#      - Fixed ?? bug in redirect tag                                        #
#                                                                            #
#   Added 4/18/2000:                                                         #
#      - Added cc_visitor tag - send copy of form results to visitor         #
#                                                                            #
#   Added 1/22/2001:                                                         #
#      - Modified fax to support netmoves (formerly faxsav)                  #
#                                                                            #
#   Added 9/16/2001:                                                         #
#      - Added EasyLink to list of fax services (formerly netmoves or faxsav #
#                                                                            #
#   Added 12/2001:                                                           #
#      - Added security fixes from FormMail Version 1.9                      #
#                                                                            #
#   Added 8/16/2002:                                                         #
#      - Added -f parameter to sendmail                                      #
#                                                                            #
#   Added 10/08/2003:                                                        #
#      - Added $xrealsender variable which adds the X-Actual-From:           #
#        header to all outbound email to assist email server software to     #
#        parse the header                                                    #
#                                                                            #
#   Added 11/20/2004:                                                        #
#      - Added log routine to help debug script actions                      #
#      - Incorporated Matt's security fixes from FormMail v1.92              #
#      - Added anti-SPAM harvesting of email addresses from HTML forms       #
#   Added 11/25/2004:                                                        #
#      - Added checks of email all email addresses used in headers           #
#        (recipient, cc, bcc) to be specified in the @recipients array.      #
#                                                                            #
##############################################################################
# Define Variables                                                           #
#	 Detailed Information Found In README File.                          #
#                                                                            #
# $mailprog defines the location of your sendmail program on your unix       #
# system. The flags -i and -t should be passed to sendmail in order to       #
# have it ignore single dots on a line and to read message for recipients    #
 
#$mailprog = '/usr/lib/sendmail -i -t';
$mailprog = '/usr/sbin/sendmail -t -i';
 
# @referers allows forms to be located only on servers which are defined     #
# in this field.  This security fix from the last version which allowed      #
# anyone on any server to use your FormMail script on their web site.        #
#**PFL**
@referers = ('laflammeconsulting.com','centrend.com','uplandpreserve.com');
 
# @recipients defines the e-mail addresses or domain names that e-mail can   #
# be sent to.  This must be filled in correctly to prevent SPAM and allow    #
# valid addresses to receive e-mail.  Read the documentation to find out how #
# this variable works!!!  It is EXTREMELY IMPORTANT.                         #
 
@recipients = &fill_recipients(@referers);
 
# ACCESS CONTROL FIX: Peter D. Thompson Yezek                                #
# @valid_ENV allows the sysadmin to define what environment variables can    #
# be reported via the env_report directive.  This was implemented to fix     #
# the problem reported at http://www.securityfocus.com/bid/1187              #
 
@valid_ENV = ('REMOTE_HOST','REMOTE_ADDR','REMOTE_USER','HTTP_USER_AGENT');
 
# BSS
# $xrealsender: defines an optional X-Actual-From: field in the outbound
# email to assist parsing for script generated messages                 
 
$xrealsender = '';                                                      
 
# The EasyLink service requires a special stamp as part of the e-mail header #
# for additional security.  This stamp, along with the appropriate 'from'    #
# field are required in order to send a fax.                                 #
#                                                                            #
# Replace passwd in the line below with the stamp issued from EasyLink.      #
# visit http://www.EasyLink.com for more information.                        #
 
$faxstamp = 'passwd';
 
#enable program debugging
$enable_debug = 0;
 
# Done                                                                       #
##############################################################################
 
&debug_log("\n-----> Start of script:");
 
# Check Referring URL
&check_url;
 
# Retrieve Date
&get_date;
 
&debug_log("$date2|$time"); 
 
&debug_log("\nREMOTE_ADDR:$ENV{'REMOTE_ADDR'}|HTTP_REFERER:$ENV{'HTTP_REFERER'}|REMOTE_HOST:$ENV{'REMOTE_HOST'}|REMOTE_USER:$ENV{'REMOTE_USER'}|");
 
# Parse Form Contents
&parse_form;
 
# Check Required Fields
&check_required;
 
&debug_log("\nRecipients:$Config{'recipient'}/$recipient2|");
 
&debug_log("\nEmails:$Config{'email'}|$Config{'cc'}|$Config{'bcc'}|");
#&debug_log("\nBuffer:$buffer|");
 
# Send E-Mail
&send_mail;
 
#BSS
# Courtesy E-Mail to Visitor
&send_courtesy;
 
#Append Database
&append_database;
 
#BSS
# Send E-Fax
if ($Config{'faxservice'}) {
    &send_mail($Config{'faxservice'})
};
 
# Return HTML Page or Redirect User
&return_html;
 
# Main ends here - only subroutines follow                                   #
##############################################################################
 
# NOTE rev1.91: This function is no longer intended to stop abuse, that      #
#    functionality is now embedded in the checks made on @recipients and the #
#    recipient form field.                                                   #
 
sub check_url {
 
    # Localize the check_referer flag which determines if user is valid.     #
    local($check_referer) = 0;
 
    # If a referring URL was specified, for each valid referer, make sure    #
    # that a valid referring URL was passed to FormMail.                     #
 
    if ($ENV{'HTTP_REFERER'}) {
        foreach $referer (@referers) {
            if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$referer|i) {
                $check_referer = 1;
                last;
            }
        }
    }
    else {
        $check_referer = 1;
    }
 
    # If the HTTP_REFERER was invalid, send back an error.                   #
    if ($check_referer != 1) { &error('bad_referer') }
 
}
 
sub get_date {
 
    # Define arrays for the day of the week and month of the year.           #
    @days   = ('Sunday','Monday','Tuesday','Wednesday',
               'Thursday','Friday','Saturday');
    @months = ('January','February','March','April','May','June','July',
	         'August','September','October','November','December');
 
    # Get the current time and format the hour, minutes and seconds.  Add    #
    # 1900 to the year to get the full 4 digit year.                         #
    ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
    $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
 
    # $year += 1900;
    # Y2K fix provided by Karl Bogott 8/1999
    if ($year < 50){
	$year += 2000;
    }
    else {
	$year += 1900;
    }
 
    # Format the date.                                                       #
    $date = "$days[$wday], $months[$mon] $mday, $year at $time";
    $mon2 = $mon + 1;
    $date2 = "$mon2/$mday/$year";
}
 
sub parse_form {
 
    # Define the configuration associative array.                            #
    %Config = ('recipient','',          'subject','',
               'email','',              'realname','',
               'redirect','',           'bgcolor','',
               'background','',         'link_color','',
               'vlink_color','',        'text_color','',
               'alink_color','',        'title','',
               'sort','',               'print_config','',
               'required','',           'env_report','',
               'return_link_title','',  'return_link_url','',
               'print_blank_fields','', 'missing_fields_redirect','',
#BSS
               'cc','',	                'bcc','',
	       'courtesy_reply','',
	       'courtesy_our_url','',   'courtesy_our_email','',
	       'courtesy_reply_texta','',
	       'courtesy_reply_textb','',
	       'courtesy_who_we_are','','courtesy_who_we_are2','',
	       'append_db','',          'db_delimiter','',
	       'db_fields','',
	       'faxservice','',
	       'faxnum','',              'faxfrom','',
	       'cc_visitor',''
#BSS
	   );
 
    # Determine the form's REQUEST_METHOD (GET or POST) and split the form   #
    # fields up into their name-value pairs.  If the REQUEST_METHOD was      #
    # not GET or POST, send an error.                                        #
    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        # Split the name-value pairs
        @pairs = split(/&/, $ENV{'QUERY_STRING'});
	$buffer = $ENV{'QUERY_STRING'};
    }
    elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
        # Get the input
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 
        # Split the name-value pairs
        @pairs = split(/&/, $buffer);
    }
    else {
        &error('request_method');
    }
 
    # For each name-value pair:                                              #
    foreach $pair (@pairs) {
 
        # Split the pair up into individual variables.                       #
        local($name, $value) = split(/=/, $pair);
 
        # Decode the form encoding on the name and value variables.          #
        # v1.92: remove null bytes                                           #
        $name =~ tr/+/ /;
        $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $name =~ tr/\0//d;
 
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $value =~ tr/\0//d;
 
        # If the field name has been specified in the %Config array, it will #
        # return a 1 for defined($Config{$name}}) and we should associate    #
        # this value with the appropriate configuration variable.  If this   #
        # is not a configuration form field, put it into the associative     #
        # array %Form, appending the value with a ', ' if there is already a #
        # value present.  We also save the order of the form fields in the   #
        # @Field_Order array so we can use this order for the generic sort.  #
        if (defined($Config{$name})) {
            $Config{$name} = $value;
        }
        else {
            if ($Form{$name} ne '') {
                $Form{$name} = "$Form{$name}, $value";
            }
            else {
                push(@Field_Order,$name);
                $Form{$name} = $value;
            }
        }
    }
 
    # The next six lines remove any extra spaces or new lines from the       #
    # configuration variables, which may have been caused if your editor     #
    # wraps lines after a certain length or if you used spaces between field #
    # names or environment variables.                                        #
    $Config{'required'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
    $Config{'required'} =~ s/(\s+)?\n+(\s+)?//g;
    $Config{'env_report'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
    $Config{'env_report'} =~ s/(\s+)?\n+(\s+)?//g;
    $Config{'print_config'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
    $Config{'print_config'} =~ s/(\s+)?\n+(\s+)?//g;
    $Config{'db_fields'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
    $Config{'db_fields'} =~ s/(\s+)?\n+(\s+)?//g;
 
    # Split the configuration variables into individual field names.         #
    @Required = split(/,/,$Config{'required'});
    @Env_Report = split(/,/,$Config{'env_report'});
    @Print_Config = split(/,/,$Config{'print_config'});
    @Print_DB = split(/,/,"$Config{'db_fields'},$Form{'db_fields'}");
 
    # ACCESS CONTROL FIX: Only allow ENV variables in @valid_ENV in          #
    # @Env_Report for security reasons.                                      #
    foreach $env_item (@Env_Report) {
        foreach $valid_item (@valid_ENV) {
            if ( $env_item eq $valid_item ) { push(@temp_array, $env_item) }
        }
    } 
    @Env_Report = @temp_array;
 
#BSS
# This block of code strips out intentionally inserted illegal characters 
# in the various email addresses fields found in the HTML form. To help 
# prevent Spammers from harvesting email addresses in HTML forms, you can
# insert any number of exclaimation point, or asterisk characters within the
# email address, for example b!siet!z@in!fo*she!et!.c!om which will translate
# to bsietz@infosheet.com. 
#
# Also if cc or bcc are present, separate possible multiple addresses and 
# check syntax & check against recipients array
 
    $Config{'recipient'} =~ y/[!*]//d;
    if ($Config{'cc'}) {
	$Config{'cc'} =~ y/[!*]//d; 
	@ccs = split(/,/, $Config{'cc'});
	foreach $cc (@ccs) { 
	    if (!check_email($cc,"header")) {push(@error,$cc)};
	};
	if (@error) { &error('no_recipient', @error) };
    };
    if ($Config{'bcc'}) {
	$Config{'bcc'} =~ y/[!*]//d; 
	@bccs = split(/,/, $Config{'bcc'});
	foreach $bcc (@bccs) { 
	    if (!check_email($bcc,"header")) {push(@error,$bcc)};
	};
	if (@error) { &error('no_recipient', @error) };
    };
    if ($Config{'courtesy_our_email'}) {
	$Config{'courtesy_our_email'} =~ y/[!*]//d; }
    if ($Config{'faxfrom'}) {
	$Config{'faxfrom'} =~ y/[!*]//d; };
    if ($Config{'faxnum'}) {
	$Config{'faxnum'} =~ y/[!*]//d; };
}
 
sub check_required {
 
    # Localize the variables used in this subroutine.                        #
    local($require, @error );
 
#BSS
# FormMail & BFormMail allows for a recipient email address in the form:
# "bsietz@infosheet.com (Brian Sietz)" so that any email received by sendmail
# would have in the header:    To: Brian Sietz (bsietz@infosheet.com).  
# Until Matt Wright added his security enhancements in FormMail v1.9, this
# worked ok, however the recipient check below would fail with the added
# name in parenthesis.  The following two lines below remove any spaces at
# the beginning of the string, and delete all characters following a space
# if it exists.  The recipient is then check against the valid recipients.
# The original recipient string remains unchanged for use in the email routines
 
    $recipient2 = $Config{'recipient'};
    $recipient2 =~ s/^\s+|\s+$//g;	# remove leading & trailing spaces
    $recipient2 =~ s/\(.*?\)//g;	# remove (realname) 
    $recipient2 =~ s/(\s+|\n)?,(\s+|\n)?/,/g; 
    $recipient2 =~ s/^\s+|\s+$//g;
 
    # The following insures that there were no newlines in any fields which  #
    # will be used in the header.                                            #
    if ($Config{'subject'} =~ /(\n|\r)/m || $Config{'email'} =~ /(\n|\r|%)/m ||
	$Config{'cc'} =~ /(\n|\r)/m || $Config{'bcc'} =~ /(\n|\r|%)/m ||
        $Config{'realname'} =~ /(\n|\r)/m || $recipient2 =~ /(\n|\r)/m) {
        &error('invalid_headers');
    }
 
    if (!$recipient2) {
        if (!defined(%Form)) { &error('bad_referer') }
        else                 { &error('no_recipient') }
    }
    else {
 
        # This block of code requires that the recipient address end with    #
        # a valid domain or e-mail address as defined in @recipients.        #
        $valid_recipient = 0;
 
	@recipient2 = split(/,/,$recipient2);
	foreach $r2 (@recipient2) {
	    if (!check_email($r2,"header")) { &error('no_recipient') };
	};
    }
 
    # For each require field defined in the form:                            #
    foreach $require (@Required) {
 
        # If the required field is the email field, the syntax of the email  #
        # address if checked to make sure it passes a valid syntax.          #
        if ($require eq 'email' && !&check_email($Config{$require},"body")) {
            push(@error,$require);
        }
 
        # Otherwise, if the required field is a configuration field and it   #
        # has no value or has been filled in with a space, send an error.    #
        elsif (defined($Config{$require})) {
             if ($Config{$require} eq '') { push(@error,$require); }
        }
 
        # If it is a regular form field which has not been filled in or      #
        # filled in with a space, flag it as an error field.                 #
        elsif (!defined($Form{$require}) || $Form{$require} eq '') {
            push(@error,$require);
        }
    }
 
    # If any error fields have been found, send error message to the user.   #
    if (@error) { &error('missing_fields', @error) }
}
 
sub return_html {
    # Local variables used in this subroutine initialized.                   #
    local($key,$sort_order,$sorted_field);
 
    # Now that we have finished using form values for any e-mail related     #
    # reasons, we will convert all of the form fields and config values      #
    # to remove any cross-site scripting security holes.                     #
    local($field);
    foreach $field (keys %Config) {
        $safeConfig{$field} = &clean_html($Config{$field});
    }
 
    foreach $field (keys %Form) {
        $Form{$field} = &clean_html($Form{$field});
    }
 
    # If redirect option is used, print the redirectional location header.   #
    if ($Config{'redirect'}) {
        print "Location: $safeConfig{'redirect'}\n\n";
    }
 
    # Otherwise, begin printing the response page.                           #
    else {
 
        # Print HTTP header and opening HTML tags.                           #
        print "Content-type: text/html\n\n";
        print "<html>\n <head>\n";
 
        # Print out title of page                                            #
        if ($Config{'title'}) { print "  <title>$safeConfig{'title'}</title>\n" }
        else                  { print "  <title>Thank You</title>\n"        }
 
        print " </head>\n <body";
 
        # Get Body Tag Attributes                                            #
        &body_attributes;
 
        # Close Body Tag                                                     #
        print ">\n  <center>\n";
 
        # Print custom or generic title.                                     #
        if ($Config{'title'}) { print "   <h1>$safeConfig{'title'}</h1>\n" }
        else { print "   <h1>Thank You For Filling Out This Form</h1>\n" }
 
        print "</center>\n";
 
        print "Below is what you submitted to $safeConfig{'recipient'} ";
        print "<br>on $date<p><hr size=1 width=75\%><p>\n";
 
        #BSS Table output for HTML (orig Don Killen) 
        #    Also realname and email fields (orig Ashley Bass)
        print "<table cellspacing=2 cellpadding=1>";
	if ($Config{'realname'}) {
            print "<tr><td align=right><b>Name:</b></td>";
	    print "<td align=left>$Config{'realname'}</td></tr>\n"
        }
        
        if ($Config{'email'}) {
            print "<tr><td align=right><b>E-mail:</b></td>";
	    print "<td align=left>$Config{'email'}</td></tr>\n\n"
        }
        #BSS
 
        # Sort alphabetically if specified:                                  #
        if ($Config{'sort'} eq 'alphabetic') {
            foreach $field (sort keys %Form) {
 
                # If the field has a value or the print blank fields option  #
                # is turned on, print out the form field and value.          #
                if ($Config{'print_blank_fields'} || $Form{$field}) {
                    #BSS - table output
                    #print "<b>$field:</b> $Form{$field}<p>\n";
                    print "<tr><td align=right>$field:</td>";
		    print "<td align=left>$Form{$field}</td></tr>\n";
		    #BSS
                }
            }
        }
 
        # If a sort order is specified, sort the form fields based on that.  #
        elsif ($Config{'sort'} =~ /^order:.*,.*/) {
 
            # Set the temporary $sort_order variable to the sorting order,   #
            # remove extraneous line breaks and spaces, remove the order:    #
            # directive and split the sort fields into an array.             #
            $sort_order = $Config{'sort'};
            $sort_order =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
            $sort_order =~ s/(\s+)?\n+(\s+)?//g;
            $sort_order =~ s/order://;
            @sorted_fields = split(/,/, $sort_order);
 
            # For each sorted field, if it has a value or the print blank    #
            # fields option is turned on print the form field and value.     #
            foreach $sorted_field (@sorted_fields) {
                if ($Config{'print_blank_fields'} || $Form{$sorted_field}) {
                    #BSS - table output
                    #print "<b>$sorted_field:</b> $Form{$sorted_field}<p>\n";
                    print "<tr><td align=right>$sorted_field:</td>";
		    print "<td align=left>$Form{$sorted_field}</td></tr>\n";
		    #BSS
                }
            }
        }
 
        # Otherwise, default to the order in which the fields were sent.     #
        else {
 
            # For each form field, if it has a value or the print blank      #
            # fields option is turned on print the form field and value.     #
            foreach $field (@Field_Order) {
                if ($Config{'print_blank_fields'} || $Form{$field}) {
                    #BSS - table output
                    #print "<b>$field:</b> $Form{$field}<p>\n";
                    print "<tr><td align=right><b>$field:</b></td>";
		    print "<td align=left>$Form{$field}</td></tr>\n";
		    #BSS
                }
            }
        }
 
#BSS
        print "</table><br clear=all>\n";
#BSS
 
 
        print "<p><hr size=1 width=75%><p>\n";
 
        # Check for a Return Link and print one if found.                    #
        if ($Config{'return_link_url'} && $Config{'return_link_title'}) {
            print "<ul>\n";
            print "<li><a href=\"$safeConfig{'return_link_url'}\">$safeConfig{'return_link_title'}</a>\n";
            print "</ul>\n";
        }
 
        # Print the page footer.                                             #
        print <<"(END HTML FOOTER)";
        <hr size=1 width=75%><p> 
        </body>
       </html>
(END HTML FOOTER)
    }
}
 
sub send_mail {
    # Localize variables used in this subroutine.                            #
 
#BSS
    local ($faxservice) = @_;
 
    local($print_config,$key,$sort_order,$sorted_field,$env_report);
 
    # Open The Mail Program
    open(MAIL,"|$mailprog -f $recipient2");
 
    if ($faxservice)  {
	if ($faxservice eq 'faxaway') {
        print MAIL "To: $Config{'faxnum'}\@faxaway.com\n";
	print MAIL "From: $Config{'faxfrom'}\n";
        }
 
	if ( ($faxservice eq 'faxsav') || 
	     ($faxservice eq 'netmoves') || 
	     ($faxservice eq 'easylink') ) {
	print MAIL "To: $Config{'faxnum'}\@faxmail.com\n";
	print MAIL "X-STAMP: $faxstamp\n";
	print MAIL "X-FAXSENDER: $Config{'faxfrom'}\n";
        }
    }
    else {
        print MAIL "To: $Config{'recipient'}\n";
        print MAIL "From: $Config{'email'} ($Config{'realname'})\n";
#BSS
	if ($Config{'cc'}) { print MAIL "Cc: $Config{'cc'}\n" };
 
	if ($Config{'cc_visitor'})
	    { print MAIL "Cc: $Config{'email'} ($Config{'realname'})\n"};
	if ($Config{'bcc'}) { print MAIL "Bcc: $Config{'bcc'}\n" };
    }
 
    print MAIL "X-Actual-From: $xrealsender\n";   #BSS 10/08/03
 
    # Check for Message Subject
    if ($Config{'subject'}) { print MAIL "Subject: $Config{'subject'}\n\n" }
    else                    { print MAIL "Subject: WWW Form Submission\n\n" }
 
    print MAIL "Below is the result of your feedback form:\n";
    print MAIL "    It was submitted by: $Config{'realname'} ($Config{'email'})\n    on $date\n";
 
#BSS
    if ($Config{'faxservice'}) {
    print MAIL "Feedback results were also faxed to: $Config{'faxnum'}\n";
    }
#BSS
 
    print MAIL "-" x 75 . "\n\n";
 
    if (@Print_Config) {
        foreach $print_config (@Print_Config) {
            if ($Config{$print_config}) {
                print MAIL "$print_config: $Config{$print_config}\n\n";
            }
        }
    }
 
    # Sort alphabetically if specified:                                      #
    if ($Config{'sort'} eq 'alphabetic') {
        foreach $field (sort keys %Form) {
 
            # If the field has a value or the print blank fields option      #
            # is turned on, print out the form field and value.              #
            if ($Config{'print_blank_fields'} || $Form{$field} ||
                $Form{$field} eq '0') {
                print MAIL "$field: $Form{$field}\n\n";
            }
        }
    }
 
    # If a sort order is specified, sort the form fields based on that.      #
    elsif ($Config{'sort'} =~ /^order:.*,.*/) {
 
        # Remove extraneous line breaks and spaces, remove the order:        #
        # directive and split the sort fields into an array.                 #
        $Config{'sort'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
        $Config{'sort'} =~ s/(\s+)?\n+(\s+)?//g;
        $Config{'sort'} =~ s/order://;
        @sorted_fields = split(/,/, $Config{'sort'});
 
        # For each sorted field, if it has a value or the print blank        #
        # fields option is turned on print the form field and value.         #
        foreach $sorted_field (@sorted_fields) {
            if ($Config{'print_blank_fields'} || $Form{$sorted_field} ||
                $Form{$sorted_field} eq '0') {
                print MAIL "$sorted_field: $Form{$sorted_field}\n\n";
            }
        }
    }
 
    # Otherwise, default to the order in which the fields were sent.         #
    else {
 
        # For each form field, if it has a value or the print blank          #
        # fields option is turned on print the form field and value.         #
        foreach $field (@Field_Order) {
            if ($Config{'print_blank_fields'} || $Form{$field} ||
                $Form{$field} eq '0') {
                print MAIL "$field: $Form{$field}\n\n";
            }
        }
    }
 
    print MAIL "-" x 75 . "\n\n";
 
    # Send any specified Environment Variables to recipient.                 #
    foreach $env_report (@Env_Report) {
        if ($ENV{$env_report}) {
            print MAIL "$env_report: $ENV{$env_report}\n";
        }
    }
 
    close (MAIL);
}
 
sub check_email {
    # Check both syntax of the email as well as valid recipient
 
    # Initialize local email variable with input to subroutine.              #
    $email = $_[0];
    $check_type = $_[1];						#BSS
    local($valid_recipient,$send_to,@send_to);				#BSS
 
    &debug_log("\nChecking:$email");
 
    $email =~ s/^\s+|\s+$//g;	# remove leading & trailing spaces
    $email =~ s/\(.*?\)//g;	# remove (realname) 
    $email =~ s/(\s+|\n)?,(\s+|\n)?/,/g; 
    $email =~ s/^\s+|\s+$//g;
 
    &debug_log("[$email]");
 
    # If the e-mail address contains:                                        #
    if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
 
        # the e-mail address contains an invalid syntax.  Or, if the         #
        # syntax does not match the following regular expression pattern     #
        # it fails basic syntax verification.                                #
 
        $email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z0-9]+)(\]?)$/) {
 
        # Basic syntax requires:  one or more characters before the @ sign,  #
        # followed by an optional '[', then any number of letters, numbers,  #
        # dashes or periods (valid domain/IP characters) ending in a period  #
        # and then 2 or 3 letters (for domain suffixes) or 1 to 3 numbers    #
        # (for IP addresses).  An ending bracket is also allowed as it is    #
        # valid syntax to have an email address like: user@[255.255.255.0]   #
 
        # Return a false value, since the e-mail address did not pass valid  #
        # syntax.                                                            #
 
	&debug_log("-fail");
        return 0;
    }
 
    else {
 
	# This block of code requires that the any email address used in the
	# header (recipient, email, cc or bcc) end with a valid domain or
	# e-mail address as defined in @recipients.
 
	if ($check_type eq 'header') {
	    foreach $send_to (split(/,/,$email)) {
		foreach $recipient (@recipients) {
		    if ($send_to =~ /$recipient$/i) {
			push(@send_to,$send_to); last;
		    }
		}
	    }
	    if ($#send_to < 0) {
		&debug_log("-fail");
		return 0;
	    }
	}
	
        # Return a true value, e-mail verification passed.                   #
	&debug_log("-ok");
        return 1;
    }
 
}
 
# This was added into v1.91 to further secure the recipients array.  Now, by #
# default it will assume that valid recipients include only users with       #
# usernames A-Z, a-z, 0-9, _ and - that match your domain exactly.  If this  #
# is not what you want, you should read more detailed instructions regarding #
# the configuration of the @recipients variable in the documentation.        #
sub fill_recipients {
    local(@domains) = @_;
    local($domain,@return_recips);
 
    foreach $domain (@domains) {
        if ($domain =~ /^\d+\.\d+\.\d+\.\d+$/) {
            $domain =~ s/\./\\\./g;
            push(@return_recips,'^[\w\-\.]+\@\[' . $domain . '\]');
        }
        else {
            $domain =~ s/\./\\\./g;
            $domain =~ s/\-/\\\-/g;
            push(@return_recips,'^[\w\-\.]+\@' . $domain);
        }
    }
 
    return @return_recips;
}
 
# This function will convert <, >, & and " to their HTML equivalents.        #
sub clean_html {
    local $value = $_[0];
    $value =~ s/\&/\&amp;/g;
    $value =~ s/</\&lt;/g;
    $value =~ s/>/\&gt;/g;
    $value =~ s/"/\&quot;/g;
    return $value;
}
 
sub body_attributes {
    # Check for Background Color
    if ($Config{'bgcolor'}) { print " bgcolor=\"$safeConfig{'bgcolor'}\"" }
 
    # Check for Background Image
    if ($Config{'background'}) { print " background=\"$safeConfig{'background'}\"" }
 
    # Check for Link Color
    if ($Config{'link_color'}) { print " link=\"$safeConfig{'link_color'}\"" }
 
    # Check for Visited Link Color
    if ($Config{'vlink_color'}) { print " vlink=\"$safeConfig{'vlink_color'}\"" }
 
    # Check for Active Link Color
    if ($Config{'alink_color'}) { print " alink=\"$safeConfig{'alink_color'}\"" }
 
    # Check for Body Text Color
    if ($Config{'text_color'}) { print " text=\"$safeConfig{'text_color'}\"" }
}
 
#############################################################################
#                                                                           #
# BSS: Send courtesy email to the visitor thanking him, etc.                #
#                                                                           #
#      Not sure if this portion of code was written by Ashley Bass or by    #
#      Donald Killen, but was taken from yForm                              #
#                                                                           #
#      Code is basically the same, just some variable name changes to be    #
#      more self explainatory.                                              #
#                                                                           #
 
sub send_courtesy {
  if ($Config{'courtesy_reply'} && $Config{'email'})
 { 
   open (MAIL,"|$mailprog -t -f $recipient2");
   print MAIL "To: $Config{'email'} ($Config{'realname'})\n";
   print MAIL "From: $Config{'courtesy_our_email'}\n";
 
   if ($Config{'subject'}) {
      print MAIL "Subject: Thanks for your $Config{'subject'}\n\n";
      $subjflag = 1;
   }
   else {
      print MAIL "Subject: Thank you - $date\n\n";
      $subjflag = 0;
   }
   print MAIL "On $date you responded to ";
   if ( $subjflag ) {
      print MAIL "our\n    `$Config{'subject'}` form.\n\n";
   }
   else {
      print MAIL "a WWW  form.\n\n";
   }
   if ($Config{'courtesy_reply_texta'}) {
      print MAIL "$Config{'courtesy_reply_texta'}\n";
   }
   if ($Config{'courtesy_reply_textb'}) {
      print MAIL "$Config{'courtesy_reply_textb'}\n\n";
   }
   print MAIL "Regards,\n";
   print MAIL "$Config{'courtesy_who_we_are'}\n";
   print MAIL "$Config{'courtesy_who_we_are2'}\n";
   print MAIL "$Config{'courtesy_our_email'}\n";
   print MAIL "$Config{'courtesy_our_url'}\n";
   close (MAIL);
}
}
 
 
#############################################################################
#                                                                           #
# BSS: append debug info to a Log file                                      #
# This routine is helpful for finding errors, especially when altering the  #
# script. Simply place a call to debug_log("xyzzy") to help trace program   #
# execution.                                                                #
#                                                                           #
 
sub debug_log {
 
    if ($enable_debug) {
	$info = $_[0];
 
	&lockit ("BFormMail_log.lock");
 
	open (LOGFILE, ">>BFormMail.log");
	print LOGFILE "$info";
	close (LOGFILE);
 
	&unlockit ("BFormMail_log.lock");
    }
}
 
#############################################################################
#                                                                           #
# BSS: Append to a Database file                                            #
#                                                                           #
#      Originally appeared in yForm written by Ashley Bass 1/29/97          #
#                                                                           #
 
sub append_database {
 
    local($print_db,$field);
 
 if ($Config{'append_db'})
  {
    if (-w $Config{'append_db'})
    {
 
        &lockit ("$Config{'append_db'}.lock");
 
	open (DATABASE, ">>$Config{'append_db'}");
	print DATABASE "$Config{'db_delimiter'}";
	print DATABASE "$date2$Config{'db_delimiter'}";
        print DATABASE "$time$Config{'db_delimiter'}";
 
        foreach $print_db (@Print_DB) {
            if ($Config{$print_db}) {
	        $field = $Config{$print_db};
		$field =~ s/\r\n/ /gs;
	        print DATABASE "$field";
	    }
	    if ($Form{$print_db}) {
	        $field = $Form{$print_db};
		$field =~ s/\r\n/ /gs;
	        print DATABASE "$field";
	    };
 
	print DATABASE "$Config{'db_delimiter'}";
 
        };
 
        print DATABASE "\n"; 
    close (DATABASE);
 
    &unlockit ("$Config{'append_db'}.lock");
 
   }
 }
}
 
sub lockit
  {
  local ($lock_file) = @_;
  local ($endtime);
  $endtime = 20;
  $endtime = time + $endtime;
 
  while (-e $lock_file && time < $endtime)
    {
    sleep(1);
    }           
 
  open(LOCK_FILE, ">$lock_file") || &file_open_error ("$lock_file", 
						      "Lock File Routine",
						      __FILE__, __LINE__);
 
# flock(LOCK_FILE, 2); # 2 exclusively locks the file
  }
 
#######################################################################
sub unlockit
  {
  local ($lock_file) = @_;
 
# flock(LOCK_FILE, 8); # 8 unlocks the file
 
  close(LOCK_FILE);
  unlink($lock_file);
  } 
 
#######################################################################
sub file_open_error
  {
  local ($bad_file, $script_section, $this_file, $line_number) = @_;
  print "Content-type: text/html\n\n";
  &CgiDie ("I am sorry, but I was not able to access $bad_file.")
  }     
 
 
 
sub error { 
    # Localize variables and assign subroutine input.                        #
    local($error,@error_fields) = @_;
    local($host,$missing_field,$missing_field_list);
 
    &debug_log("\nError:$error");
    &debug_log("\nBuffer:$buffer");
 
    if ($error eq 'bad_referer') {
        if ($ENV{'HTTP_REFERER'} =~ m|^https?://([\w\.]+)|i) {
            $host = $1;
            my $referer = &clean_html($ENV{'HTTP_REFERER'});
            print <<"(END ERROR HTML)";
Content-type: text/html
 
<html>
 <head>
  <title>Bad Referrer - Access Denied</title>
 </head>
 <body bgcolor=#FFFFFF text=#000000>
  <center>
   <table border=0 width=600 bgcolor=#9C9C9C>
    <tr><th><font size=+2>Bad Referrer - Access Denied</font></th></tr>
   </table>
   <table border=0 width=600 bgcolor=#CFCFCF>
    <tr><td>The form attempting to use
     <a href="http://www.infosheet.com/iScripts.html">BFormMail</a>
     resides at <tt>$referer</tt>, which is not allowed to access
     this cgi script.<p>
 
     If you are attempting to configure BFormMail to run with this form, you need
     to add the following to \@referers, explained in detail in the 
     <a href="http://www.scriptarchive.com/readme/formmail.html">README</a> file.<p>
 
     Add <tt>'$host'</tt> to your <tt><b>\@referers</b></tt> array.<hr size=1>
     <center><font size=-1>
      <a href="http://www.scriptarchive.com/formmail.html">FormMail</a> V1.92 &copy; 1995 - 2002  Matt Wright<br>
      A Free Product of <a href="http://www.scriptarchive.com/">Matt's Script Archive, Inc.</a>
     </font></center>
    </td></tr>
   </table>
  </center>
 </body>
</html>
(END ERROR HTML)
        }
        else {
            print <<"(END ERROR HTML)";
Content-type: text/html
 
<html>
 <head>
  <title>BFormMail v2.2.192</title>
 </head>
 <body bgcolor=#FFFFFF text=#000000>
  <center>
   <table border=0 width=600 bgcolor=#9C9C9C>
    <tr><th><font size=+2>FormMail -- BFormMail</font></th></tr>
   </table>
   <table border=0 width=600 bgcolor=#CFCFCF>
    <tr><th><tt><font size=+1>Copyright 1995 - 2002 Matt Wright<br>
        Version 1.92 - Released April 21, 2002<br>
        A Free Product of <a href="http://www.scriptarchive.com/">Matt's Script Archive,
        Inc.</a></font></tt></th></tr>
   </table>
  </center>
 </body>
</html>
(END ERROR HTML)
        }
    }
 
    elsif ($error eq 'request_method') {
            print <<"(END ERROR HTML)";
Content-type: text/html
 
<html>
 <head>
  <title>Error: Request Method</title>
 </head>
 <body bgcolor=#FFFFFF text=#000000>
  <center>
   <table border=0 width=600 bgcolor=#9C9C9C>
    <tr><th><font size=+2>Error: Request Method</font></th></tr>
   </table>
   <table border=0 width=600 bgcolor=#CFCFCF>
    <tr><td>The Request Method of the Form you submitted did not match
     either <tt>GET</tt> or <tt>POST</tt>.  Please check the form and make sure the
     <tt>method=</tt> statement is in upper case and matches <tt>GET</tt> or <tt>POST</tt>.<p>
 
     <center><font size=-1>
      <a href="http://www.scriptarchive.com/formmail.html">FormMail</a> V1.92 &copy; 1995 - 2001  Matt Wright<br>
      A Free Product of <a href="http://www.scriptarchive.com/">Matt's Script Archive, Inc.</a>
     </font></center>
    </td></tr>
   </table>
  </center>
 </body>
</html>
(END ERROR HTML)
    }
 
    elsif ($error eq 'no_recipient') {
            print <<"(END ERROR HTML)";
Content-type: text/html
 
<html>
 <head>
  <title>Error: Bad/No Recipient</title>
 </head>
 <body bgcolor=#FFFFFF text=#000000>
  <center>
   <table border=0 width=600 bgcolor=#9C9C9C>
    <tr><th><font size=+2>Error: Bad/No Recipient, cc or bcc</font></th></tr>
   </table>
   <table border=0 width=600 bgcolor=#CFCFCF>
    <tr><td>There was no recipient or an invalid recipient, cc or bcc specified in the data sent to BFormMail.  Please
     make sure you have filled in the <tt>recipient</tt>, <tt>cc</tt>, or <tt>bcc</tt> form field with an e-mail
     address that has been configured in <tt>\@recipients</tt>.  More information on filling in <tt>recipient</tt> form fields and variables can be
     found in the README file.<hr size=1>
 
     <center><font size=-1>
      <a href="http://www.scriptarchive.com/formmail.html">FormMail</a> V1.92 &copy; 1995 - 2002  Matt Wright<br>
      A Free Product of <a href="http://www.scriptarchive.com/">Matt's Script Archive, Inc.</a>
     </font></center>
    </td></tr>
   </table>
  </center>
 </body>
</html>
(END ERROR HTML)
    }
 
    elsif ($error eq 'missing_fields') {
        if ($Config{'missing_fields_redirect'}) {
            print "Location: $Config{'missing_fields_redirect'}\n\n";
        }
        else {
            foreach $missing_field (@error_fields) {
                $missing_field_list .= "      <li>$missing_field\n";
            }
 
            print <<"(END ERROR HTML)";
Content-type: text/html
 
<html>
 <head>
  <title>Error: Blank Fields</title>
 </head>
  <center>
   <table border=0 width=600 bgcolor=#9C9C9C>
    <tr><th><font size=+2>Error: Blank Fields</font></th></tr>
   </table>
   <table border=0 width=600 bgcolor=#CFCFCF>
    <tr><td>The following fields were left blank in your submission form:<p>
     <ul>
$missing_field_list
     </ul><br>
 
     These fields must be filled in before you can successfully submit the form.<p>
     Please use your browser's back button to return to the form and try again.<hr size=1>
     <center><font size=-1>
     </font></center>
    </td></tr>
   </table>
  </center>
 </body>
</html>
(END ERROR HTML)
        }
    }
    exit;
}
[+][-]06.07.2008 at 09:51AM PDT, ID: 21736122

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.14.2008 at 06:40AM PDT, ID: 21785353

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.14.2008 at 09:16AM PDT, ID: 21785853

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Perl Programming Language, CGI Scripting, Hypertext Markup Language (HTML)
Sign Up Now!
Solution Provided By: FishMonger
Participating Experts: 1
Solution Grade: A
 
 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628