home *** CD-ROM | disk | FTP | other *** search
/ Internet 1996 World Exposition / park.org.s3.amazonaws.com.7z / park.org.s3.amazonaws.com / Guests / GreekMarble / scripts / sendcgi.cgi < prev   
Text File  |  2017-09-21  |  10KB  |  344 lines
  1. #! /usr/local/bin/perl
  2. ##############################################################################
  3. # FormMail            Version 1.5                     #
  4. # Copyright 1996 Matt Wright    mattw@misha.net                     #
  5. # Created 6/9/95                Last Modified 2/5/96                 #
  6. # Scripts Archive at:        http://www.worldwidemart.com/scripts/         #
  7. ##############################################################################
  8. # COPYRIGHT NOTICE                                                           #
  9. # Copyright 1996 Matthew M. Wright  All Rights Reserved.                     #
  10. #                                                                            #
  11. # FormMail may be used and modified free of charge by anyone so long as this #
  12. # copyright notice and the comments above remain intact.  By using this      #
  13. # code you agree to indemnify Matthew M. Wright from any liability that      #  
  14. # might arise from it's use.                                                 #  
  15. #                                         #
  16. # Selling the code for this program without prior written consent is         #
  17. # expressly forbidden.  In other words, please ask first before you try and  #
  18. # make money off of my program.                             #
  19. ##############################################################################
  20. # Define Variables 
  21.  
  22. $mailprog = '/usr/sbin/sendmail';
  23. $newurl = 'http://www.igs.net/~hooper/cgi-bin/send/filesent.htm';
  24. $fromaddr = 'hooper@igs.net';
  25. $organization = 'SMH Software';
  26. $fromname = 'SMH Software';
  27. $filename = '/drive2/usr/home/hooper/.public_html/cgi-bin/send.cgi';
  28.  
  29. # @referers allows forms to be located only on servers which are defined 
  30. # in this field.  This fixes a security hole in the last version which 
  31. # allowed anyone on any server to use your FormMail script.
  32.  
  33. @referers = ('www.igs.net','host.igs.net', "igs.net");
  34.  
  35. # Done
  36. #############################################################################
  37.  
  38. # Check Referring URL
  39. &check_url;
  40.  
  41. # Retrieve Date
  42. &get_date;
  43.  
  44. # Parse Form Contents
  45. &parse_form;
  46.  
  47. # Check Required Fields
  48. &check_required;
  49.  
  50. # Return HTML Page or Redirect User
  51. &return_html;
  52.  
  53. # Send E-Mail
  54. &send_mail;
  55.  
  56. sub check_url {
  57.  
  58.    if ($ENV{'HTTP_REFERER'}) {
  59.       foreach $referer (@referers) {
  60.          if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
  61.             $check_referer = '1';
  62.         last;
  63.          }
  64.       }
  65.    }
  66.    else {
  67.       $check_referer = '1';
  68.    }
  69.  
  70.    if ($check_referer != 1) {
  71.       &error('bad_referer');
  72.    }
  73.  
  74. }
  75.  
  76. sub get_date {
  77.  
  78.    @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  79.    @months = ('January','February','March','April','May','June','July',
  80.           'August','September','October','November','December');
  81.  
  82.    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  83.    if ($hour < 10) { $hour = "0$hour"; }
  84.    if ($min < 10) { $min = "0$min"; }
  85.    if ($sec < 10) { $sec = "0$sec"; }
  86.  
  87.    $date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";
  88.  
  89. }
  90.  
  91. sub parse_form {
  92.  
  93.    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
  94.       # Split the name-value pairs
  95.       @pairs = split(/&/, $ENV{'QUERY_STRING'});
  96.    }
  97.    elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
  98.       # Get the input
  99.       read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  100.  
  101.       # Split the name-value pairs
  102.       @pairs = split(/&/, $buffer);
  103.    }
  104.    else {
  105.       &error('request_method');
  106.    }
  107.  
  108.    foreach $pair (@pairs) {
  109.       ($name, $value) = split(/=/, $pair);
  110.  
  111.       $name =~ tr/+/ /;
  112.       $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  113.  
  114.       $value =~ tr/+/ /;
  115.       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  116.  
  117.       # If they try to include server side includes, erase them, so they
  118.       # arent a security risk if the html gets returned.  Another 
  119.       # security hole plugged up.
  120.  
  121.       $value =~ s/<!--(.|\n)*-->//g;
  122.  
  123.       # Create two associative arrays here.  One is a configuration array
  124.       # which includes all fields that this form recognizes.  The other
  125.       # is for fields which the form does not recognize and will report 
  126.       # back to the user in the html return page and the e-mail message.
  127.       # Also determine required fields.
  128.  
  129.       if ($name eq 'recipient' ||
  130.       $name eq 'subject' ||
  131.       $name eq 'email' ||
  132.       $name eq 'realname' ||
  133.       $name eq 'redirect' ||
  134.       $name eq 'bgcolor' ||
  135.       $name eq 'background' ||
  136.       $name eq 'link_color' ||
  137.       $name eq 'vlink_color' ||
  138.           $name eq 'text_color' ||
  139.          $name eq 'alink_color' ||
  140.       $name eq 'title' ||
  141.       $name eq 'sort' ||
  142.       $name eq 'print_config' ||
  143.       $name eq 'return_link_title' ||
  144.       $name eq 'return_link_url' && ($value)) {
  145.          
  146.      $CONFIG{$name} = $value;
  147.       }
  148.       elsif ($name eq 'required') {
  149.          @required = split(/,/,$value);
  150.       }
  151.       elsif ($name eq 'env_report') {
  152.          @env_report = split(/,/,$value);
  153.       }
  154.       else {
  155.          if ($FORM{$name} && ($value)) {
  156.         $FORM{$name} = "$FORM{$name}, $value";
  157.      }
  158.          elsif ($value) {
  159.             $FORM{$name} = $value;
  160.          }
  161.       }
  162.    }
  163. }
  164.  
  165. sub check_required {
  166.  
  167.    foreach $require (@required) {
  168.       if ($require eq 'recipient' ||
  169.           $require eq 'subject' ||
  170.           $require eq 'email' ||
  171.           $require eq 'realname' ||
  172.           $require eq 'redirect' ||
  173.           $require eq 'bgcolor' ||
  174.           $require eq 'background' ||
  175.           $require eq 'link_color' ||
  176.           $require eq 'vlink_color' ||
  177.           $require eq 'alink_color' ||
  178.           $require eq 'text_color' ||
  179.       $require eq 'sort' ||
  180.           $require eq 'title' ||
  181.           $require eq 'print_config' ||
  182.           $require eq 'return_link_title' ||
  183.           $require eq 'return_link_url') {
  184.  
  185.          if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') {
  186.             push(@ERROR,$require);
  187.          }
  188.       }
  189.       elsif (!($FORM{$require}) || $FORM{$require} eq ' ') {
  190.          push(@ERROR,$require);
  191.       }
  192.    }
  193.  
  194.    if (@ERROR) {
  195.       &error('missing_fields', @ERROR);
  196.    }
  197.  
  198. }
  199.  
  200. sub return_html {
  201.  
  202.    if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) {
  203.  
  204.       # If the redirect option of the form contains a valid url,
  205.       # print the redirectional location header.
  206.  
  207.       print "Location: $newurl\n\n";
  208.    }
  209.    else {
  210.  
  211.       print "Location: $newurl\n\n";
  212.    }
  213. }
  214.  
  215. sub send_mail {
  216.    # Open The Mail Program
  217.  
  218.    open(MAIL,"|$mailprog -t");
  219.  
  220.    print MAIL "To: $CONFIG{'email'} ($CONFIG{'realname'})\n";
  221.    print MAIL "From: $fromaddr ($fromname)\n";
  222.    if ($organization) {
  223.       print MAIL "Organization: $organization\n";
  224.    }
  225.    else {
  226.       print MAIL "Organization: Auto Sent File\n";
  227.    }
  228.    # Check for Message Subject
  229.    if ($CONFIG{'subject'}) {
  230.       print MAIL "Subject: $CONFIG{'subject'}\n";
  231.    }
  232.    else {
  233.       print MAIL "Subject: Auto Sent File\n";
  234.    }
  235.    print MAIL "X-Courtesy-Of: SendIt! 1.0\n\n";
  236.    open(INPUT,$filename);
  237.     while (<INPUT>) {
  238.         chop $_;
  239.         print MAIL $_,"\n";
  240.     }
  241.  
  242.    close (MAIL);
  243. }
  244.  
  245. sub error {
  246.  
  247.    ($error,@error_fields) = @_;
  248.  
  249.    print "Content-type: text/html\n\n";
  250.  
  251.    if ($error eq 'bad_referer') {
  252.       print "<html>\n <head>\n  <title>Bad Referrer - Access Denied</title>\n </head>\n";
  253.       print " <body>\n  <center>\n   <h1>Bad Referrer - Access Denied</h1>\n  </center>\n";
  254.       print "The form that is trying to use this <a href=\"http://www.worldwidemart.com/scripts/\">FormMail Program</a>\n";
  255.       print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.<p>\n";
  256.       print "Sorry!\n";
  257.       print "</body></html>\n";
  258.    }
  259.  
  260.    elsif ($error eq 'request_method') {
  261.       print "<html>\n <head>\n  <title>Error: Request Method</title>\n </head>\n";
  262.       print "</head>\n <body";
  263.  
  264.       # Get Body Tag Attributes
  265.       &body_attributes;
  266.  
  267.       # Close Body Tag
  268.       print ">\n <center>\n\n";
  269.  
  270.       print "   <h1>Error: Request Method</h1>\n  </center>\n\n";
  271.       print "The Request Method of the Form you submitted did not match\n";
  272.       print "either GET or POST.  Please check the form, and make sure the\n";
  273.       print "method= statement is in upper case and matches GET or POST.\n";
  274.       print "<p><hr size=7 width=75%><p>\n";
  275.       print "<ul>\n";
  276.       print "<li><a href=\"$ENV{'HTTP_REFERER'}\">Back to the Submission Form</a>\n";
  277.       print "</ul>\n";
  278.       print "</body></html>\n";
  279.    }
  280.  
  281.    elsif ($error eq 'missing_fields') {
  282.  
  283.       print "<html>\n <head>\n  <title>Error: Blank Fields</title>\n </head>\n";
  284.       print " </head>\n <body";
  285.       
  286.       # Get Body Tag Attributes
  287.       &body_attributes;
  288.          
  289.       # Close Body Tag
  290.       print ">\n  <center>\n";
  291.  
  292.       print "   <h1>Error: Blank Fields</h1>\n\n";
  293.       print "The following fields were left blank in your submission form:<p>\n";
  294.  
  295.       # Print Out Missing Fields in a List.
  296.       print "<ul>\n";
  297.       foreach $missing_field (@error_fields) {
  298.          print "<li>$missing_field\n";
  299.       }
  300.       print "</ul>\n";
  301.  
  302.       # Provide Explanation for Error and Offer Link Back to Form.
  303.       print "<p><hr size=7 width=75\%><p>\n";
  304.       print "These fields must be filled out before you can successfully submit\n";
  305.       print "the form.  Please return to the <a href=\"$ENV{'HTTP_REFERER'}\">Fill Out Form</a> and try again.\n";
  306.       print "</body></html>\n";
  307.    }
  308.    exit;
  309. }
  310.  
  311. sub body_attributes {
  312.    # Check for Background Color
  313.    if ($CONFIG{'bgcolor'}) {
  314.       print " bgcolor=\"$CONFIG{'bgcolor'}\"";
  315.    }
  316.  
  317.    # Check for Background Image
  318.    if ($CONFIG{'background'} =~ /http\:\/\/.*\..*/) {
  319.       print " background=\"$CONFIG{'background'}\"";
  320.    }
  321.  
  322.    # Check for Link Color
  323.    if ($CONFIG{'link_color'}) {
  324.       print " link=\"$CONFIG{'link_color'}\"";
  325.    }
  326.  
  327.    # Check for Visited Link Color
  328.    if ($CONFIG{'vlink_color'}) {   
  329.       print " vlink=\"$CONFIG{'vlink_color'}\"";
  330.    }
  331.  
  332.    # Check for Active Link Color
  333.    if ($CONFIG{'alink_color'}) {
  334.       print " alink=\"$CONFIG{'alink_color'}\"";
  335.    }
  336.  
  337.    # Check for Body Text Color
  338.    if ($CONFIG{'text_color'}) {
  339.       print " text=\"$CONFIG{'text_color'}\"";
  340.    }
  341. }
  342.  
  343. exit;
  344.