home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 18 / amigaformatcd18.iso / +look_here_1st!+ / af_on_the_web / websites / weirdscience / weird-cgi / mailfile.pl < prev    next >
Perl Script  |  1997-06-16  |  10KB  |  278 lines
  1. #! /usr/local/bin/perl
  2. ##############################################################################
  3. # FileMail                                                                   #
  4. # By Mike Wheeler, mwheeler@gladstone.uoregon.edu                            #
  5. # Archiving routine by Jim Martin, writeway@c2.org                           #
  6. #                                                                            #
  7. # Available from http://gladstone.uoregon.edu/~mwheeler/cgi                  #
  8. # Based on:                                                                  #
  9. # FormMail                      Version 1.5                                  #
  10. # Copyright 1996 Matt Wright    mattw@misha.net                              #
  11. # Created 6/9/95                Last Modified 2/5/96                         #
  12. # Scripts Archive at:           http://www.worldwidemart.com/scripts/        #
  13. ##############################################################################
  14. # COPYRIGHT NOTICE                                                           #
  15. # Copyright 1996 Matthew M. Wright  All Rights Reserved.                     #
  16. #                                                                            #
  17. # FormMail may be used and modified free of charge by anyone so long as this #
  18. # copyright notice and the comments above remain intact.  By using this      #
  19. # code you agree to indemnify Matthew M. Wright from any liability that      #
  20. # might arise from it's use.                                                 #
  21. #                                                                            #
  22. # Selling the code for this program without prior written consent is         #
  23. # expressly forbidden.  In other words, please ask first before you try and  #
  24. # make money off of my program.                                              #
  25. ##############################################################################
  26. # Define Variables
  27.  
  28. $mailprog = '/usr/lib/sendmail';
  29. # The location of your sendmail program
  30.  
  31. $newurl = 'http://www.cabinessence.com/cgi';
  32. # Where you send people after running the script
  33.  
  34. $fromaddr = 'mwheeler@cabinessence.com';
  35. # The e-mail address from which the files are sent
  36.  
  37. $organization = 'Cabinessence';
  38. # Your organization
  39.  
  40. $fromname = 'Mike Wheeler';
  41. # The name from which the files are sent
  42.  
  43. $filebase = '/usr/home/cabiness/usr/local/etc/httpd/htdocs/cgi';
  44. # The base path to all files you want sent. If the files are coming from
  45. # multiple directories you must show this in the filename part of the
  46. # form such as chat/chat.cgi. If you use the archiving feature all files in
  47. # this directory (and only this directory) will be listed.
  48.  
  49. $form_letter = '';
  50. # The file you want sent out with every request for files (it will be 
  51. # sent as a seperate message. Leave blank if you don't want one. This
  52. # must follow the same rules set by $filebase
  53.  
  54. @referers = ("www.cabinessence.com");
  55. # @referers allows forms to be located only on servers which are defined
  56. # in this field.  This fixes a security hole in the last version which
  57. # allowed anyone on any server to use your FormMail script.
  58. #
  59. # Done
  60. ##########################
  61. # Check Referring URL
  62. &check_url;
  63.  
  64. #Make archive page if needed
  65. if ($ENV{'QUERY_STRING'} eq "archive") {
  66. &archive;
  67. }
  68.  
  69. # Retrieve Date
  70. &get_date;
  71.  
  72. # Parse Form Contents
  73. &parse_form;
  74.  
  75. # Get Variables
  76. &get_variables;
  77.  
  78. # Send E-Mail
  79. &send_mail;
  80.  
  81. # Return HTML Page or Redirect User
  82. &return_html;
  83.  
  84. exit;
  85.  
  86. sub check_url {
  87.  
  88.    if ($ENV{'HTTP_REFERER'}) {
  89.       foreach $referer (@referers) {
  90.          if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
  91.             $check_referer = '1';
  92.             last;
  93.          }
  94.       }
  95.    }
  96.    else {
  97.       $check_referer = '1';
  98.    }
  99.  
  100.    if ($check_referer != 1) {
  101.       &error('bad_referer');
  102.    }
  103. }
  104.  
  105. sub get_date {
  106.  
  107.    @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  108.    @months = ('January','February','March','April','May','June','July',
  109.               'August','September','October','November','December');
  110.  
  111.    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  112.    if ($hour < 10) { $hour = "0$hour"; }
  113.    if ($min < 10) { $min = "0$min"; }
  114.    if ($sec < 10) { $sec = "0$sec"; }
  115.  
  116.    $date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";
  117.  
  118. }
  119.  
  120. sub parse_form {
  121.    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  122.  
  123.    # Split the name-value pairs
  124.    @pairs = split(/&/, $buffer);
  125.  
  126.    foreach $pair (@pairs) {
  127.       ($name, $value) = split(/=/, $pair);
  128.  
  129.       # Un-Webify plus signs and %-encoding
  130.       $value =~ tr/+/ /;
  131.       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  132.       $value =~ s/<!--(.|\n)*-->//g;
  133.       $value =~ s/<([^>]|\n)*>//g;
  134.  
  135.       if ($name eq "filename") {
  136.          push (@files,$value);
  137.       }
  138.       else {
  139.          $FORM{$name} = $value;
  140.       }
  141.    }
  142. }
  143.  
  144. sub get_variables {
  145.    if ($FORM{'realname'}) {
  146.       $realname = $FORM{'realname'};
  147.    }
  148.    if ($FORM{'email'} =~ /.*\@.*\..*/) {
  149.       $email = $FORM{'email'};
  150.    }
  151.    if ($FORM{'comments'}) {
  152.       $comments = $FORM{'comments'};
  153.    }
  154. }
  155.  
  156. sub return_html {
  157.    if ($email eq "" || $files[0] eq "") {
  158.       print "Content-type: text/html\n\n";
  159.       print "<html><head><title>Sorry</title></head>\n";
  160.       print "<body bgcolor=ffffff><center><h1>Sorry</h1></center>\n";
  161.       print "Sorry, you provided insufficient information. Either you\n"; 
  162.       print "didn't include an acceptable e-mail address or you didn't\n";
  163.       print "select any files to be mailed to you. Please go back\n";
  164.       print "and try again.</body></html>\n";
  165.       exit;
  166.    }
  167.    else {
  168.       print "Location: $newurl\n\n";
  169.    }
  170. }
  171.  
  172. sub send_mail {
  173.    if ($form_letter ne "") {
  174.       push (@files,$form_letter);
  175.    }
  176.    foreach $file (@files) {
  177.       if (-e "$filebase/$file") {
  178.          open(MAIL,"|$mailprog -t");
  179.  
  180.          print MAIL "To: $email ($realname)\n";
  181.          print MAIL "From: $fromaddr ($fromname)\n";
  182.          if ($organization) {
  183.             print MAIL "Organization: $organization\n";
  184.          }
  185.          else {
  186.             print MAIL "Organization: Auto Sent File\n";
  187.          }
  188.          print MAIL "Subject: $file\n";
  189.          print MAIL "X-Courtesy-Of: SendIt! 1.0\n\n";
  190.          open(INPUT,"$filebase/$file")||&error;
  191.          while (<INPUT>) {
  192.             chop $_;
  193.             print MAIL $_,"\n";
  194.          }
  195.          close (INPUT);
  196.          close (MAIL);
  197.       }
  198.       else {
  199.          print "Content-type: text/html\n\n";
  200.          print "<head><title>Sorry</title></head>\n";
  201.          print "<body bgcolor=ffffff><center><h1>Sorry</h1></center>\n";
  202.          print "Sorry, your request for files could not be completed\n";
  203.          print "because at least one of the files was not available.<p>\n";
  204.          print "This file: $file could not be found.</body></html>\n";
  205.          open(REMAIL,"|$mailprog -t");
  206.          print REMAIL "To: $fromaddr\n";
  207.          print REMAIL "From: $email ($realname)\n";
  208.          if ($organization) {
  209.             print REMAIL "Organization: $organization\n";
  210.          }
  211.          else {
  212.             print REMAIL "Organization: Auto Sent File\n";
  213.          }
  214.          print REMAIL "Subject: File Unavailable\n";
  215.          print REMAIL "X-Courtesy-Of: SendIt!\n\n";
  216.          print REMAIL "$email ($realname)\n";
  217.          print REMAIL "requested the file(s) @files\n";
  218.          print REMAIL "but the file: $file could not be found\n";
  219.          print REMAIL "so their request could not be fulfilled.\n\n";
  220.          print REMAIL "$comments\n";
  221.          close (REMAIL);
  222.          exit;
  223.       }
  224.    }
  225.    &mail_owner;
  226. }
  227.  
  228. sub mail_owner {
  229.    if($files[0] ne "") {
  230.       open(REMAIL,"|$mailprog -t");
  231.  
  232.       print REMAIL "To: $fromaddr\n";
  233.       print REMAIL "From: $email ($realname)\n";
  234.       if ($organization) {
  235.          print REMAIL "Organization: $organization\n";
  236.       }
  237.       else {
  238.          print REMAIL "Organization: Auto Sent File\n";
  239.       }
  240.       if ($CONFIG{'subject'}) {
  241.          print REMAIL "Subject: $subject\n";
  242.       }
  243.       else {
  244.          print REMAIL "Subject: Auto Sent File\n";
  245.       }
  246.       print REMAIL "X-Courtesy-Of: SendIt!\n\n";
  247.       print REMAIL "$email ($realname)\n";
  248.       print REMAIL " requested the file(s) @files\n";
  249.       print REMAIL "$comments";
  250.       close (REMAIL);
  251.    }
  252. }
  253.  
  254. ##################
  255. # Print archive page
  256. sub archive {
  257.    print "Content-type: text/html\n\n";
  258.    print "<html><head><title>File Archive</title></head>\n";
  259.    print "<body bgcolor=ffffff><center><h1>File Archive</h1></center>\n";
  260.    print "<form method=\"post\" action=\"$ENV{'SCRIPT_NAME'}\">\n";
  261.    print "<table><tr valign=top><Td>Files:</td><td>\n";
  262.    opendir(FILES,"$filebase");
  263.    @allfiles = sort(grep(!/^\.\.?$/,readdir(FILES)));
  264.    closedir(FILES);
  265.    foreach$file(@allfiles) {
  266.       print "<input type=checkbox name=\"filename\" value=\"$file\">$file<br>\n";
  267.    }
  268.    print "</td></tr><tr valign=top><td>Comments:</td><td>\n";
  269.    print "<textarea wrap name=\"comments\" rows=5 cols=36></textarea><br>\n";
  270.    print "</td></tr><tr><td>Name:</td><td>\n";
  271.    print "<input type=text size=40 name=\"realname\"><br>\n";
  272.    print "</td></tr><tr><td>E-mail:</td><td>\n";
  273.    print "<input type=text size=40 name=\"email\"><br>\n";
  274.    print "</td></tr><tr><td></td><td>\n";
  275.    print "<input type=submit value=\"Send Files\">\n";
  276.    print "</td></tr></table></form></body></html>\n";
  277.    exit;
  278. }